1 files changed, 133 insertions, 0 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
new file mode 100644
index 0000000000..30039662f0
--- /dev/null
+++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+--------------------------------------------------------------------------------
+module Xanthous.Entities.RawTypes
+  (
+    EntityRaw(..)
+  , _Creature
+  , _Item
+
+    -- * Creatures
+  , CreatureType(..)
+  , hostile
+
+    -- * Items
+  , ItemType(..)
+    -- ** Item sub-types
+    -- *** Edible
+  , EdibleItem(..)
+  , isEdible
+    -- *** Wieldable
+  , WieldableItem(..)
+  , isWieldable
+
+    -- * Lens classes
+  , HasAttackMessage(..)
+  , HasChar(..)
+  , HasDamage(..)
+  , HasDescription(..)
+  , HasEatMessage(..)
+  , HasEdible(..)
+  , HasFriendly(..)
+  , HasHitpointsHealed(..)
+  , HasLongDescription(..)
+  , HasMaxHitpoints(..)
+  , HasName(..)
+  , HasSpeed(..)
+  , HasWieldable(..)
+  ) where
+--------------------------------------------------------------------------------
+import Xanthous.Prelude
+import Test.QuickCheck
+import Data.Aeson.Generic.DerivingVia
+import Data.Aeson (ToJSON, FromJSON)
+--------------------------------------------------------------------------------
+import Xanthous.Messages (Message(..))
+import Xanthous.Data (TicksPerTile, Hitpoints)
+import Xanthous.Data.EntityChar
+import Xanthous.Util.QuickCheck
+--------------------------------------------------------------------------------
+
+data CreatureType = CreatureType
+  { _name         :: !Text
+  , _description  :: !Text
+  , _char         :: !EntityChar
+  , _maxHitpoints :: !Hitpoints
+  , _friendly     :: !Bool
+  , _speed        :: !TicksPerTile
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary CreatureType
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       CreatureType
+makeFieldsNoPrefix ''CreatureType
+
+hostile :: Lens' CreatureType Bool
+hostile = friendly . involuted not
+
+--------------------------------------------------------------------------------
+
+data EdibleItem = EdibleItem
+  { _hitpointsHealed :: Int
+  , _eatMessage :: Maybe Message
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary EdibleItem
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       EdibleItem
+makeFieldsNoPrefix ''EdibleItem
+
+data WieldableItem = WieldableItem
+  { _damage :: !Hitpoints
+  , _attackMessage :: !(Maybe Message)
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary WieldableItem
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       WieldableItem
+makeFieldsNoPrefix ''WieldableItem
+
+--------------------------------------------------------------------------------
+
+data ItemType = ItemType
+  { _name            :: Text
+  , _description     :: Text
+  , _longDescription :: Text
+  , _char            :: EntityChar
+  , _edible          :: Maybe EdibleItem
+  , _wieldable       :: Maybe WieldableItem
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary ItemType
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       ItemType
+makeFieldsNoPrefix ''ItemType
+
+-- | Can this item be eaten?
+isEdible :: ItemType -> Bool
+isEdible = has $ edible . _Just
+
+-- | Can this item be used as a weapon?
+isWieldable :: ItemType -> Bool
+isWieldable = has $ wieldable . _Just
+
+--------------------------------------------------------------------------------
+
+data EntityRaw
+  = Creature CreatureType
+  | Item ItemType
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NFData)
+  deriving Arbitrary via GenericArbitrary EntityRaw
+  deriving (FromJSON)
+       via WithOptions '[ SumEnc ObjWithSingleField ]
+                       EntityRaw
+makePrisms ''EntityRaw