1 files changed, 64 insertions, 5 deletions
diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs
index f2c789d6a6a8..6ea6f93e4254 100644
--- a/src/Xanthous/Entities/Creature.hs
+++ b/src/Xanthous/Entities/Creature.hs
@@ -2,44 +2,101 @@
 {-# LANGUAGE TemplateHaskell #-}
 --------------------------------------------------------------------------------
 module Xanthous.Entities.Creature
-  ( Creature(..)
+  ( -- * Creature
+    Creature(..)
+    -- ** Lenses
   , creatureType
   , hitpoints
+  , hippocampus
+
+    -- ** Creature functions
   , newWithType
   , damage
   , isDead
   , visionRadius
+
+    -- * Hippocampus
+  , Hippocampus(..)
+    -- ** Lenses
+  , destination
+    -- ** Destination
+  , Destination(..)
+  , destinationFromPos
+    -- *** Lenses
+  , destinationPosition
+  , destinationProgress
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
 --------------------------------------------------------------------------------
+import           Test.QuickCheck
 import           Test.QuickCheck.Arbitrary.Generic
 import           Data.Aeson.Generic.DerivingVia
 import           Data.Aeson (ToJSON, FromJSON)
 --------------------------------------------------------------------------------
 import           Xanthous.Entities.RawTypes hiding (Creature, description)
 import           Xanthous.Entities (Draw(..), DrawRawChar(..))
+import           Xanthous.Data
+--------------------------------------------------------------------------------
+
+data Destination = Destination
+  { _destinationPosition :: !Position
+    -- | The progress towards the destination, tracked as an offset from the
+    -- creature's original position.
+    --
+    -- When this value reaches >= 1, the creature has reached their destination
+  , _destinationProgress :: !Tiles
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       Destination
+instance Arbitrary Destination where arbitrary = genericArbitrary
+makeLenses ''Destination
+
+destinationFromPos :: Position -> Destination
+destinationFromPos _destinationPosition =
+  let _destinationProgress = 0
+  in Destination{..}
+
+data Hippocampus = Hippocampus
+  { _destination :: !(Maybe Destination)
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       Hippocampus
+instance Arbitrary Hippocampus where arbitrary = genericArbitrary
+makeLenses ''Hippocampus
+
+initialHippocampus :: Hippocampus
+initialHippocampus = Hippocampus Nothing
+
 --------------------------------------------------------------------------------
 
 data Creature = Creature
-  { _creatureType :: CreatureType
-  , _hitpoints :: Word
+  { _creatureType :: !CreatureType
+  , _hitpoints    :: !Word
+  , _hippocampus  :: !Hippocampus
   }
   deriving stock (Eq, Show, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
   deriving Draw via DrawRawChar "_creatureType" Creature
   deriving (ToJSON, FromJSON)
        via WithOptions '[ FieldLabelModifier '[Drop 1] ]
                        Creature
+instance Arbitrary Creature where arbitrary = genericArbitrary
 makeLenses ''Creature
 
-instance Arbitrary Creature where
-  arbitrary = genericArbitrary
 
 --------------------------------------------------------------------------------
 
 newWithType :: CreatureType -> Creature
 newWithType _creatureType =
   let _hitpoints = _creatureType ^. maxHitpoints
+      _hippocampus = initialHippocampus
   in Creature {..}
 
 damage :: Word -> Creature -> Creature
@@ -53,3 +110,5 @@ isDead = views hitpoints (== 0)
 
 visionRadius :: Creature -> Word
 visionRadius = const 50 -- TODO
+
+{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}