Decouple Gormlak AI from creatures

Decouple the definition of the Gormlak AI from the creature type itself
using generic lenses and a "HasVisionRadius" typeclass, to begin to
untangle the hs-boot web of circular dependencies. This
actually *increases* the number of hs-boot files from 1 to 2, but both
of the source imports that use them are single-instance (unlike gormlak
AI which I would expect to grow linearly with the growth of the game),
plus at least one should be able to go away once we remove collision
from the game lenses module and move it into something defined in the
entity class itself.

5 files changed, 96 insertions, 43 deletions

diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs
index 19c7834228e0..6e955324a06a 100644
--- a/src/Xanthous/Entities/Creature.hs
+++ b/src/Xanthous/Entities/Creature.hs
@@ -34,47 +34,13 @@ import           Test.QuickCheck.Arbitrary.Generic
 import           Data.Aeson.Generic.DerivingVia
 import           Data.Aeson (ToJSON, FromJSON)
 --------------------------------------------------------------------------------
-import           Xanthous.Entities.RawTypes
-                 hiding (Creature, description, damage)
+import           Xanthous.AI.Gormlak
+import           Xanthous.Entities.RawTypes hiding
+                 (Creature, description, damage)
+import qualified Xanthous.Entities.RawTypes as Raw
 import           Xanthous.Game.State
 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, Ord, 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, Ord, 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
-
+import           Xanthous.Entities.Creature.Hippocampus
 --------------------------------------------------------------------------------
 
 data Creature = Creature
@@ -91,6 +57,17 @@ data Creature = Creature
 instance Arbitrary Creature where arbitrary = genericArbitrary
 makeLenses ''Creature
 
+instance HasVisionRadius Creature where
+  visionRadius = const 50 -- TODO
+
+instance Brain Creature where
+  step = brainVia GormlakBrain
+  entityCanMove = const True
+
+instance Entity Creature where
+  blocksVision _ = False
+  description = view $ creatureType . Raw.description
+  entityChar = view $ creatureType . char
 
 --------------------------------------------------------------------------------
 
@@ -109,7 +86,4 @@ damage amount = hitpoints %~ \hp ->
 isDead :: Creature -> Bool
 isDead = views hitpoints (== 0)
 
-visionRadius :: Creature -> Word
-visionRadius = const 50 -- TODO
-
 {-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
diff --git a/src/Xanthous/Entities/Creature.hs-boot b/src/Xanthous/Entities/Creature.hs-boot
new file mode 100644
index 000000000000..4c930d26426d
--- /dev/null
+++ b/src/Xanthous/Entities/Creature.hs-boot
@@ -0,0 +1,2 @@
+module Xanthous.Entities.Creature where
+data Creature
diff --git a/src/Xanthous/Entities/Creature/Hippocampus.hs b/src/Xanthous/Entities/Creature/Hippocampus.hs
new file mode 100644
index 000000000000..501a5b597221
--- /dev/null
+++ b/src/Xanthous/Entities/Creature/Hippocampus.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+--------------------------------------------------------------------------------
+module Xanthous.Entities.Creature.Hippocampus
+  (-- * Hippocampus
+    Hippocampus(..)
+  , initialHippocampus
+    -- ** Lenses
+  , destination
+    -- ** Destination
+  , Destination(..)
+  , destinationFromPos
+    -- *** Lenses
+  , destinationPosition
+  , destinationProgress
+  )
+where
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude
+--------------------------------------------------------------------------------
+import           Data.Aeson.Generic.DerivingVia
+import           Data.Aeson (ToJSON, FromJSON)
+import           Test.QuickCheck
+import           Test.QuickCheck.Arbitrary.Generic
+--------------------------------------------------------------------------------
+import           Xanthous.Data
+import           Xanthous.Util.QuickCheck
+--------------------------------------------------------------------------------
+
+
+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, Ord, 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, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary Hippocampus
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       Hippocampus
+makeLenses ''Hippocampus
+
+initialHippocampus :: Hippocampus
+initialHippocampus = Hippocampus Nothing
diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs
index 802aecddebdf..8793565a2a34 100644
--- a/src/Xanthous/Entities/Entities.hs
+++ b/src/Xanthous/Entities/Entities.hs
@@ -14,7 +14,6 @@ import           Xanthous.Entities.Item
 import           Xanthous.Entities.Creature
 import           Xanthous.Entities.Environment
 import           Xanthous.Game.State
-import           {-# SOURCE #-} Xanthous.AI.Gormlak ()
 import           Xanthous.Util.QuickCheck
 import           Data.Aeson.Generic.DerivingVia
 --------------------------------------------------------------------------------
diff --git a/src/Xanthous/Entities/Entities.hs-boot b/src/Xanthous/Entities/Entities.hs-boot
new file mode 100644
index 000000000000..519a862c6a5a
--- /dev/null
+++ b/src/Xanthous/Entities/Entities.hs-boot
@@ -0,0 +1,14 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Xanthous.Entities.Entities where
+
+import Test.QuickCheck
+import Data.Aeson
+import Xanthous.Game.State (SomeEntity, GameState, Entity)
+
+instance Arbitrary SomeEntity
+instance Function SomeEntity
+instance CoArbitrary SomeEntity
+instance FromJSON SomeEntity
+instance Entity SomeEntity
+
+instance FromJSON GameState