about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/Entities
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities')
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Character.hs241
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Common.hs290
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Creature.hs88
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs71
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs31
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Entities.hs63
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot14
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Environment.hs160
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Item.hs76
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Marker.hs41
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs286
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws.hs49
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml24
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml20
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml26
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml14
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml15
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml10
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml22
19 files changed, 0 insertions, 1541 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs
deleted file mode 100644
index c8153086f1ac..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs
+++ /dev/null
@@ -1,241 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Character
-
-  ( -- * Character datatype
-    Character(..)
-  , characterName
-  , HasInventory(..)
-  , characterDamage
-  , characterHitpoints'
-  , characterHitpoints
-  , hitpointRecoveryRate
-  , speed
-  , body
-
-    -- *** Body
-  , Body(..)
-  , initialBody
-  , knuckles
-  , Knuckles(..)
-  , fistDamageChance
-  , damageKnuckles
-  , fistfightingDamage
-
-    -- * Character functions
-  , mkCharacter
-  , pickUpItem
-  , isDead
-  , isFullyHealed
-  , damage
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Brick
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Coerce (coerce)
-import           Test.QuickCheck
-import           Test.QuickCheck.Instances.Vector ()
-import           Test.QuickCheck.Arbitrary.Generic
-import           Test.QuickCheck.Gen (chooseUpTo)
-import           Test.QuickCheck.Checkers (EqProp)
-import           Control.Monad.State.Lazy (execState)
-import           Control.Monad.Trans.State.Lazy (execStateT)
---------------------------------------------------------------------------------
-import           Xanthous.Game.State
-import           Xanthous.Entities.Item
-import           Xanthous.Entities.Common
-import           Xanthous.Data
-                 ( TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned )
-import qualified Xanthous.Entities.RawTypes as Raw
-import           Xanthous.Util (EqEqProp(EqEqProp), modifyKL)
-import           Xanthous.Monad (say_)
---------------------------------------------------------------------------------
-
--- | The status of the character's knuckles
---
--- This struct is used to track the damage and then eventual build-up of
--- calluses when the character is fighting with their fists
-data Knuckles = Knuckles
-  { -- | How damaged are the knuckles currently, from 0 to 5?
-    --
-    -- At 0, no calluses will form
-    -- At 1 and up, the character will form calluses after a while
-    -- At 5, continuing to fistfight will deal the character even more damage
-    _knuckleDamage   :: !Word
-    -- | How built-up are the character's calluses, from 0 to 5?
-    --
-    -- Each level of calluses decreases the likelihood of being damaged when
-    -- fistfighting by 1%, up to 5 where the character will never be damaged
-    -- fistfighting
-  , _knuckleCalluses :: !Word
-
-    -- | Number of turns that have passed since the last time the knuckles were
-    -- damaged
-  , _ticksSinceDamaged :: Ticks
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving EqProp via EqEqProp Knuckles
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Knuckles
-makeLenses ''Knuckles
-
-instance Semigroup Knuckles where
-  (Knuckles d₁ c₁ t₁) <> (Knuckles d₂ c₂ t₂) = Knuckles
-    (min (d₁ + d₂) 5)
-    (min (c₁ + c₂) 5)
-    (max t₁ t₂)
-
-instance Monoid Knuckles where
-  mempty = Knuckles 0 0 0
-
-instance Arbitrary Knuckles where
-  arbitrary = do
-    _knuckleDamage <- fromIntegral <$> chooseUpTo 5
-    _knuckleCalluses <- fromIntegral <$> chooseUpTo 5
-    _ticksSinceDamaged <- arbitrary
-    pure Knuckles{..}
-
--- | Likelihood that the character fighting with their fists will damage
--- themselves
-fistDamageChance :: Knuckles -> Float
-fistDamageChance knuckles
-  | calluses == 5 = 0
-  | otherwise = baseChance - (0.01 * fromIntegral calluses)
-  where
-    baseChance = 0.08
-    calluses = knuckles ^. knuckleCalluses
-
--- | Damage the knuckles by a level (capping at the max knuckle damage)
-damageKnuckles :: Knuckles -> Knuckles
-damageKnuckles = execState $ do
-  knuckleDamage %= min 5 . succ
-  ticksSinceDamaged .= 0
-
--- | Damage taken when fistfighting and 'fistDamageChance' has occurred
-fistfightingDamage :: Knuckles -> Hitpoints
-fistfightingDamage knuckles
-  | knuckles ^. knuckleDamage == 5 = 2
-  | otherwise = 1
-
-stepKnuckles :: Ticks -> Knuckles -> AppM Knuckles
-stepKnuckles ticks = execStateT . whenM (uses knuckleDamage (> 0)) $ do
-  ticksSinceDamaged += ticks
-  whenM (uses ticksSinceDamaged (>= 2000)) $ do
-    dam <- knuckleDamage <<.= 0
-    knuckleCalluses %= min 5 . (+ dam)
-    ticksSinceDamaged .= 0
-    lift $ say_ ["character", "body", "knuckles", "calluses"]
-
-
--- | Status of the character's body
-data Body = Body
-  { _knuckles :: !Knuckles
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Body
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Body
-makeLenses ''Body
-
-initialBody :: Body
-initialBody = Body { _knuckles = mempty }
-
---------------------------------------------------------------------------------
-
-data Character = Character
-  { _inventory           :: !Inventory
-  , _characterName       :: !(Maybe Text)
-  , _characterHitpoints' :: !Double
-  , _speed               :: !TicksPerTile
-  , _body                :: !Body
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Character
-makeFieldsNoPrefix ''Character
-
-characterHitpoints :: Character -> Hitpoints
-characterHitpoints = views characterHitpoints' floor
-
-scrollOffset :: Int
-scrollOffset = 5
-
-instance Draw Character where
-  draw _ = visibleRegion rloc rreg $ str "@"
-    where
-      rloc = Location (negate scrollOffset, negate scrollOffset)
-      rreg = (2 * scrollOffset, 2 * scrollOffset)
-  drawPriority = const maxBound -- Character should always be on top, for now
-
-instance Brain Character where
-  step ticks = execStateT $ do
-    positioned . characterHitpoints' %= \hp ->
-      if hp > fromIntegral initialHitpoints
-      then hp
-      else hp + hitpointRecoveryRate |*| ticks
-    modifyKL (positioned . body . knuckles) $ lift . stepKnuckles ticks
-
-instance Entity Character where
-  description _ = "yourself"
-  entityChar _ = "@"
-
-instance Arbitrary Character where
-  arbitrary = genericArbitrary
-
-initialHitpoints :: Hitpoints
-initialHitpoints = 10
-
-hitpointRecoveryRate :: Double `Per` Ticks
-hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed)
-
-defaultSpeed :: TicksPerTile
-defaultSpeed = 100
-
-mkCharacter :: Character
-mkCharacter = Character
-  { _inventory           = mempty
-  , _characterName       = Nothing
-  , _characterHitpoints' = fromIntegral initialHitpoints
-  , _speed               = defaultSpeed
-  , _body                = initialBody
-  }
-
-defaultCharacterDamage :: Hitpoints
-defaultCharacterDamage = 1
-
--- | Returns the damage that the character currently does with an attack
--- TODO use double-handed/left-hand/right-hand here
-characterDamage :: Character -> Hitpoints
-characterDamage
-  = fromMaybe defaultCharacterDamage
-  . filter (/= 0)
-  . Just
-  . sumOf (inventory . wielded . wieldedItems . wieldableItem . Raw.damage)
-
--- | Is the character fully healed up to or past their initial hitpoints?
-isFullyHealed :: Character -> Bool
-isFullyHealed = (>= initialHitpoints) . characterHitpoints
-
--- | Is the character dead?
-isDead :: Character -> Bool
-isDead = (== 0) . characterHitpoints
-
-pickUpItem :: Item -> Character -> Character
-pickUpItem it = inventory . backpack %~ (it <|)
-
-damage :: Hitpoints -> Character -> Character
-damage (fromIntegral -> amount) = characterHitpoints' %~ \case
-  n | n <= amount -> 0
-    | otherwise  -> n - amount
-
-{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
deleted file mode 100644
index 368b03f25bed..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
+++ /dev/null
@@ -1,290 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      : Xanthous.Entities.Common
--- Description : Common data type definitions and utilities for entities
---
---------------------------------------------------------------------------------
-module Xanthous.Entities.Common
-  ( -- * Inventory
-    Inventory(..)
-  , HasInventory(..)
-  , backpack
-  , wielded
-  , items
-  , InventoryPosition(..)
-  , describeInventoryPosition
-  , inventoryPosition
-  , itemsWithPosition
-  , removeItemFromPosition
-
-    -- ** Wielded items
-  , Wielded(..)
-  , nothingWielded
-  , hands
-  , leftHand
-  , rightHand
-  , inLeftHand
-  , inRightHand
-  , doubleHanded
-  , Hand(..)
-  , itemsInHand
-  , inHand
-  , wieldInHand
-  , describeHand
-  , wieldedItems
-  , WieldedItem(..)
-  , wieldedItem
-  , wieldableItem
-  , asWieldedItem
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Aeson.Generic.DerivingVia
-import           Test.QuickCheck
-import           Test.QuickCheck.Checkers (EqProp)
---------------------------------------------------------------------------------
-import           Xanthous.Data (Positioned(..), positioned)
-import           Xanthous.Util.QuickCheck
-import           Xanthous.Game.State
-import           Xanthous.Entities.Item
-import           Xanthous.Entities.RawTypes (WieldableItem, wieldable)
-import           Xanthous.Util (removeFirst, EqEqProp(..))
---------------------------------------------------------------------------------
-
-data WieldedItem = WieldedItem
-  { _wieldedItem :: Item
-  , _wieldableItem :: WieldableItem
-    -- ^ Invariant: item ^. itemType . wieldable ≡ Just wieldableItem
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           WieldedItem
-makeFieldsNoPrefix ''WieldedItem
-
-asWieldedItem :: Prism' Item WieldedItem
-asWieldedItem = prism' hither yon
- where
-   yon item = WieldedItem item <$> item ^. itemType . wieldable
-   hither (WieldedItem item _) = item
-
-instance Brain WieldedItem where
-  step ticks (Positioned p wi) =
-    over positioned (\i -> WieldedItem i $ wi ^. wieldableItem)
-    <$> step ticks (Positioned p $ wi ^. wieldedItem)
-
-instance Draw WieldedItem where
-  draw = draw . view wieldedItem
-
-instance Entity WieldedItem where
-  entityAttributes = entityAttributes . view wieldedItem
-  description = description . view wieldedItem
-  entityChar = entityChar . view wieldedItem
-
-instance Arbitrary WieldedItem where
-  arbitrary = genericArbitrary <&> \wi ->
-    wi & wieldedItem . itemType . wieldable ?~ wi ^. wieldableItem
-
-data Wielded
-  = DoubleHanded WieldedItem
-  | Hands { _leftHand :: !(Maybe WieldedItem)
-          , _rightHand :: !(Maybe WieldedItem)
-          }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Wielded
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ 'SumEnc 'ObjWithSingleField ]
-           Wielded
-
-
-nothingWielded :: Wielded
-nothingWielded = Hands Nothing Nothing
-
-hands :: Prism' Wielded (Maybe WieldedItem, Maybe WieldedItem)
-hands = prism' (uncurry Hands) $ \case
-  Hands l r -> Just (l, r)
-  _ -> Nothing
-
-leftHand :: Traversal' Wielded (Maybe WieldedItem)
-leftHand = hands . _1
-
-inLeftHand :: WieldedItem -> Wielded
-inLeftHand wi = Hands (Just wi) Nothing
-
-rightHand :: Traversal' Wielded (Maybe WieldedItem)
-rightHand = hands . _2
-
-inRightHand :: WieldedItem -> Wielded
-inRightHand wi = Hands Nothing (Just wi)
-
-doubleHanded :: Prism' Wielded WieldedItem
-doubleHanded = prism' DoubleHanded $ \case
-  DoubleHanded i -> Just i
-  _ -> Nothing
-
-wieldedItems :: Traversal' Wielded WieldedItem
-wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> k wielded
-wieldedItems k (Hands l r) = Hands <$> _Just k l <*> _Just k r
-
-
-data Hand
-  = LeftHand
-  | RightHand
-  | BothHands
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Hand
-
-itemsInHand :: Hand -> Wielded -> [WieldedItem]
-itemsInHand LeftHand (DoubleHanded wi) = [wi]
-itemsInHand LeftHand (Hands lh _) = toList lh
-itemsInHand RightHand (DoubleHanded wi) = [wi]
-itemsInHand RightHand (Hands _ rh) = toList rh
-itemsInHand BothHands (DoubleHanded wi) = [wi]
-itemsInHand BothHands (Hands lh rh) = toList lh <> toList rh
-
-inHand :: Hand -> WieldedItem -> Wielded
-inHand LeftHand = inLeftHand
-inHand RightHand = inRightHand
-inHand BothHands = review doubleHanded
-
-wieldInHand :: Hand -> WieldedItem -> Wielded -> ([WieldedItem], Wielded)
-wieldInHand hand item w = (itemsInHand hand w, doWield)
-  where
-    doWield = case (hand, w) of
-      (LeftHand, Hands _ r) -> Hands (Just item) r
-      (LeftHand, DoubleHanded _) -> inLeftHand item
-      (RightHand, Hands l _) -> Hands l (Just item)
-      (RightHand, DoubleHanded _) -> inRightHand item
-      (BothHands, _) -> DoubleHanded item
-
-describeHand :: Hand -> Text
-describeHand LeftHand = "your left hand"
-describeHand RightHand = "your right hand"
-describeHand BothHands = "both hands"
-
-data Inventory = Inventory
-  { _backpack :: Vector Item
-  , _wielded :: Wielded
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Inventory
-  deriving EqProp via EqEqProp Inventory
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Inventory
-makeFieldsNoPrefix ''Inventory
-
-items :: Traversal' Inventory Item
-items k (Inventory bp w) = Inventory
-  <$> traversed k bp
-  <*> (wieldedItems . wieldedItem) k w
-
-type instance Element Inventory = Item
-
-instance MonoFunctor Inventory where
-  omap = over items
-
-instance MonoFoldable Inventory where
-  ofoldMap = foldMapOf items
-  ofoldr = foldrOf items
-  ofoldl' = foldlOf' items
-  otoList = toListOf items
-  oall = allOf items
-  oany = anyOf items
-  onull = nullOf items
-  ofoldr1Ex = foldr1Of items
-  ofoldl1Ex' = foldl1Of' items
-  headEx = headEx . toListOf items
-  lastEx = lastEx . toListOf items
-
-instance MonoTraversable Inventory where
-  otraverse = traverseOf items
-
-instance Semigroup Inventory where
-  inv₁ <> inv₂ =
-    let backpack' = inv₁ ^. backpack <> inv₂ ^. backpack
-        (wielded', backpack'') = case (inv₁ ^. wielded, inv₂ ^. wielded) of
-          (wielded₁, wielded₂@(DoubleHanded _)) ->
-            (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem))
-          (wielded₁, wielded₂@(Hands (Just _) (Just _))) ->
-            (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem))
-          (wielded₁, Hands Nothing Nothing) -> (wielded₁, backpack')
-          (Hands Nothing Nothing, wielded₂) -> (wielded₂, backpack')
-          (Hands (Just l₁) Nothing, Hands Nothing (Just r₂)) ->
-            (Hands (Just l₁) (Just r₂), backpack')
-          (wielded₁@(DoubleHanded _), wielded₂) ->
-            (wielded₁, backpack' <> fromList (wielded₂ ^.. wieldedItems . wieldedItem))
-          (Hands Nothing (Just r₁), Hands Nothing (Just r₂)) ->
-            (Hands Nothing (Just r₂), r₁ ^. wieldedItem <| backpack')
-          (Hands Nothing r₁, Hands (Just l₂) Nothing) ->
-            (Hands (Just l₂) r₁, backpack')
-          (Hands (Just l₁) Nothing, Hands (Just l₂) Nothing) ->
-            (Hands (Just l₂) Nothing, l₁ ^. wieldedItem <| backpack')
-          (Hands (Just l₁) (Just r₁), Hands Nothing (Just r₂)) ->
-            (Hands (Just l₁) (Just r₂), r₁ ^. wieldedItem <| backpack')
-          (Hands (Just l₁) (Just r₁), Hands (Just l₂) Nothing) ->
-            (Hands (Just l₂) (Just r₁), l₁ ^. wieldedItem <| backpack')
-    in Inventory backpack'' wielded'
-
-instance Monoid Inventory where
-  mempty = Inventory mempty $ Hands Nothing Nothing
-
-class HasInventory s a | s -> a where
-  inventory :: Lens' s a
-  {-# MINIMAL inventory #-}
-
--- | Representation for where in the inventory an item might be
-data InventoryPosition
-  = Backpack
-  | InHand Hand
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary InventoryPosition
-
--- | Return a human-readable description of the given 'InventoryPosition'
-describeInventoryPosition :: InventoryPosition -> Text
-describeInventoryPosition Backpack       = "In backpack"
-describeInventoryPosition (InHand hand)  = "Wielded, in " <> describeHand hand
-
--- | Given a position in the inventory, return a traversal on the inventory over
--- all the items in that position
-inventoryPosition :: InventoryPosition -> Traversal' Inventory Item
-inventoryPosition Backpack = backpack . traversed
-inventoryPosition (InHand LeftHand) = wielded . leftHand . _Just . wieldedItem
-inventoryPosition (InHand RightHand) = wielded . leftHand . _Just . wieldedItem
-inventoryPosition (InHand BothHands) = wielded . doubleHanded . wieldedItem
-
--- | A fold over all the items in the inventory accompanied by their position in
--- the inventory
---
--- Invariant: This will return items in the same order as 'items'
-itemsWithPosition :: Fold Inventory (InventoryPosition, Item)
-itemsWithPosition = folding $ (<>) <$> backpackItems <*> handItems
-  where
-    backpackItems = toListOf $ backpack . folded . to (Backpack ,)
-    handItems inv = case inv ^. wielded of
-       DoubleHanded i -> pure (InHand BothHands, i ^. wieldedItem)
-       Hands l r -> (l ^.. folded . wieldedItem . to (InHand LeftHand ,))
-                 <> (r ^.. folded . wieldedItem . to (InHand RightHand ,))
-
--- | Remove the first item equal to 'Item' from the given position in the
--- inventory
-removeItemFromPosition :: InventoryPosition -> Item -> Inventory -> Inventory
-removeItemFromPosition Backpack item inv
-  = inv & backpack %~ removeFirst (== item)
-removeItemFromPosition (InHand LeftHand) item inv
-  = inv & wielded . leftHand %~ filter ((/= item) . view wieldedItem)
-removeItemFromPosition (InHand RightHand) item inv
-  = inv & wielded . rightHand %~ filter ((/= item) . view wieldedItem)
-removeItemFromPosition (InHand BothHands) item inv
-  | has (wielded . doubleHanded . wieldedItem . filtered (== item)) inv
-  = inv & wielded .~ nothingWielded
-  | otherwise
-  = inv
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs
deleted file mode 100644
index 3ea610795e98..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Creature
-  ( -- * Creature
-    Creature(..)
-    -- ** Lenses
-  , creatureType
-  , hitpoints
-  , hippocampus
-  , inventory
-
-    -- ** Creature functions
-  , damage
-  , isDead
-  , visionRadius
-
-    -- * Hippocampus
-  , Hippocampus(..)
-    -- ** Lenses
-  , destination
-    -- ** Destination
-  , Destination(..)
-  , destinationFromPos
-    -- *** Lenses
-  , destinationPosition
-  , destinationProgress
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Test.QuickCheck
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson (ToJSON, FromJSON)
---------------------------------------------------------------------------------
-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
-import           Xanthous.Data.Entities
-import           Xanthous.Entities.Creature.Hippocampus
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
-import           Xanthous.Entities.Common (Inventory, HasInventory(..))
---------------------------------------------------------------------------------
-
-data Creature = Creature
-  { _creatureType   :: !CreatureType
-  , _hitpoints      :: !Hitpoints
-  , _hippocampus    :: !Hippocampus
-  , _inventory      :: !Inventory
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature
-  deriving Arbitrary via GenericArbitrary Creature
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       Creature
-makeFieldsNoPrefix ''Creature
-
-instance HasVisionRadius Creature where
-  visionRadius = const 50 -- TODO
-
-instance Brain Creature where
-  step = brainVia GormlakBrain
-  entityCanMove = const True
-
-instance Entity Creature where
-  entityAttributes _ = defaultEntityAttributes
-    & blocksObject .~ True
-  description = view $ creatureType . Raw.description
-  entityChar = view $ creatureType . char
-  entityCollision = const $ Just Combat
-
---------------------------------------------------------------------------------
-
-damage :: Hitpoints -> Creature -> Creature
-damage amount = hitpoints %~ \hp ->
-  if hp <= amount
-  then 0
-  else hp - amount
-
-isDead :: Creature -> Bool
-isDead = views hitpoints (== 0)
-
-{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs
deleted file mode 100644
index d13ea8055c2b..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Creature.Hippocampus
-  (-- * Hippocampus
-    Hippocampus(..)
-  , initialHippocampus
-    -- ** Lenses
-  , destination
-  , greetedCharacter
-    -- ** 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
---------------------------------------------------------------------------------
-
-
-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)
-  , -- | Has this creature greeted the character in any way yet?
-    --
-    -- Some creature types ignore this field
-    _greetedCharacter :: !Bool
-  }
-  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
-  { _destination      = Nothing
-  , _greetedCharacter = False
-  }
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs b/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs
deleted file mode 100644
index aa6c5fa4fc47..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-module Xanthous.Entities.Draw.Util where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Brick.Widgets.Border.Style
-import Brick.Types (Edges(..))
---------------------------------------------------------------------------------
-
-borderFromEdges :: BorderStyle -> Edges Bool -> Char
-borderFromEdges bstyle edges = ($ bstyle) $ case edges of
-  Edges False False  False False -> const '☐'
-
-  Edges True  False  False False -> bsVertical
-  Edges False True   False False -> bsVertical
-  Edges False False  True  False -> bsHorizontal
-  Edges False False  False True  -> bsHorizontal
-
-  Edges True  True   False False -> bsVertical
-  Edges True  False  True  False -> bsCornerBR
-  Edges True  False  False True  -> bsCornerBL
-
-  Edges False True   True  False -> bsCornerTR
-  Edges False True   False True  -> bsCornerTL
-  Edges False False  True  True  -> bsHorizontal
-
-  Edges False True   True  True  -> bsIntersectT
-  Edges True  False  True  True  -> bsIntersectB
-  Edges True  True   False True  -> bsIntersectL
-  Edges True  True   True  False -> bsIntersectR
-
-  Edges True  True   True  True  -> bsIntersectFull
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs
deleted file mode 100644
index a0c037a1b4ed..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Entities () where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Test.QuickCheck
-import qualified Test.QuickCheck.Gen as Gen
-import           Data.Aeson
---------------------------------------------------------------------------------
-import           Xanthous.Entities.Character
-import           Xanthous.Entities.Item
-import           Xanthous.Entities.Creature
-import           Xanthous.Entities.Environment
-import           Xanthous.Entities.Marker
-import           Xanthous.Game.State
-import           Xanthous.Util.QuickCheck
-import           Data.Aeson.Generic.DerivingVia
---------------------------------------------------------------------------------
-
-instance Arbitrary SomeEntity where
-  arbitrary = Gen.oneof
-    [ SomeEntity <$> arbitrary @Character
-    , SomeEntity <$> arbitrary @Item
-    , SomeEntity <$> arbitrary @Creature
-    , SomeEntity <$> arbitrary @Wall
-    , SomeEntity <$> arbitrary @Door
-    , SomeEntity <$> arbitrary @GroundMessage
-    , SomeEntity <$> arbitrary @Staircase
-    , SomeEntity <$> arbitrary @Marker
-    ]
-
-instance FromJSON SomeEntity where
-  parseJSON = withObject "Entity" $ \obj -> do
-    (entityType :: Text) <- obj .: "type"
-    case entityType of
-      "Character" -> SomeEntity @Character <$> obj .: "data"
-      "Item" -> SomeEntity @Item <$> obj .: "data"
-      "Creature" -> SomeEntity @Creature <$> obj .: "data"
-      "Wall" -> SomeEntity @Wall <$> obj .: "data"
-      "Door" -> SomeEntity @Door <$> obj .: "data"
-      "GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data"
-      "Staircase" -> SomeEntity @Staircase <$> obj .: "data"
-      "Marker" -> SomeEntity @Marker <$> obj .: "data"
-      _ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\""
-
-deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel
-  instance FromJSON GameLevel
-deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState
-  instance FromJSON GameState
-
-instance Entity SomeEntity where
-  entityAttributes (SomeEntity ent) = entityAttributes ent
-  description (SomeEntity ent) = description ent
-  entityChar (SomeEntity ent) = entityChar ent
-  entityCollision (SomeEntity ent) = entityCollision ent
-
-instance Function SomeEntity where
-  function = functionJSON
-
-instance CoArbitrary SomeEntity where
-  coarbitrary = coarbitrary . encode
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot
deleted file mode 100644
index 519a862c6a5a..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# 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
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs b/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs
deleted file mode 100644
index b45a91eabed2..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs
+++ /dev/null
@@ -1,160 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Xanthous.Entities.Environment
-  (
-    -- * Walls
-    Wall(..)
-
-    -- * Doors
-  , Door(..)
-  , open
-  , closed
-  , locked
-  , unlockedDoor
-
-    -- * Messages
-  , GroundMessage(..)
-
-    -- * Stairs
-  , Staircase(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Test.QuickCheck
-import Brick (str)
-import Brick.Widgets.Border.Style (unicode)
-import Brick.Types (Edges(..))
-import Data.Aeson
-import Data.Aeson.Generic.DerivingVia
---------------------------------------------------------------------------------
-import Xanthous.Entities.Draw.Util
-import Xanthous.Data
-import Xanthous.Data.Entities
-import Xanthous.Game.State
-import Xanthous.Util.QuickCheck
---------------------------------------------------------------------------------
-
-data Wall = Wall
-  deriving stock (Show, Eq, Ord, Generic, Enum)
-  deriving anyclass (NFData, CoArbitrary, Function)
-
-instance ToJSON Wall where
-  toJSON = const $ String "Wall"
-
-instance FromJSON Wall where
-  parseJSON = withText "Wall" $ \case
-    "Wall" -> pure Wall
-    _      -> fail "Invalid Wall: expected Wall"
-
-instance Brain Wall where step = brainVia Brainless
-
-instance Entity Wall where
-  entityAttributes _ = defaultEntityAttributes
-    & blocksVision .~ True
-    & blocksObject .~ True
-  description _ = "a wall"
-  entityChar _ = "┼"
-
-instance Arbitrary Wall where
-  arbitrary = pure Wall
-
-wallEdges :: (MonoFoldable mono, Element mono ~ SomeEntity)
-          => Neighbors mono -> Edges Bool
-wallEdges neighs = any (entityIs @Wall) <$> edges neighs
-
-instance Draw Wall where
-  drawWithNeighbors neighs _wall =
-    str . pure . borderFromEdges unicode $ wallEdges neighs
-
-data Door = Door
-  { _open   :: Bool
-  , _locked :: Bool
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary Door
-makeLenses ''Door
-
-instance Draw Door where
-  drawWithNeighbors neighs door
-    = str . pure . ($ door ^. open) $ case wallEdges neighs of
-        Edges True  False  False False -> vertDoor
-        Edges False True   False False -> vertDoor
-        Edges True  True   False False -> vertDoor
-        Edges False False  True  False -> horizDoor
-        Edges False False  False True  -> horizDoor
-        Edges False False  True  True  -> horizDoor
-        _                              -> allsidesDoor
-    where
-      horizDoor True = '␣'
-      horizDoor False = 'ᚔ'
-      vertDoor True = '['
-      vertDoor False = 'ǂ'
-      allsidesDoor True = '+'
-      allsidesDoor False = '▥'
-
-instance Brain Door where step = brainVia Brainless
-
-instance Entity Door where
-  entityAttributes door = defaultEntityAttributes
-    & blocksVision .~ not (door ^. open)
-  description door | door ^. open = "an open door"
-                   | otherwise    = "a closed door"
-  entityChar _ = "d"
-  entityCollision door | door ^. open = Nothing
-                       | otherwise = Just Stop
-
-closed :: Lens' Door Bool
-closed = open . involuted not
-
--- | A closed, unlocked door
-unlockedDoor :: Door
-unlockedDoor = Door
-  { _open = False
-  , _locked = False
-  }
-
---------------------------------------------------------------------------------
-
-newtype GroundMessage = GroundMessage Text
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary GroundMessage
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ 'TagSingleConstructors 'True
-                        , 'SumEnc 'ObjWithSingleField
-                        ]
-           GroundMessage
-  deriving Draw
-       via DrawStyledCharacter ('Just 'Yellow) 'Nothing "≈"
-           GroundMessage
-instance Brain GroundMessage where step = brainVia Brainless
-
-instance Entity GroundMessage where
-  description = const "a message on the ground. Press r. to read it."
-  entityChar = const "≈"
-  entityCollision = const Nothing
-
---------------------------------------------------------------------------------
-
-data Staircase = UpStaircase | DownStaircase
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Staircase
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ 'TagSingleConstructors 'True
-                        , 'SumEnc 'ObjWithSingleField
-                        ]
-           Staircase
-instance Brain Staircase where step = brainVia Brainless
-
-instance Draw Staircase where
-  draw UpStaircase = str "<"
-  draw DownStaircase = str ">"
-
-instance Entity Staircase where
-  description UpStaircase = "a staircase leading upwards"
-  description DownStaircase = "a staircase leading downwards"
-  entityChar UpStaircase = "<"
-  entityChar DownStaircase = ">"
-  entityCollision = const Nothing
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Item.hs b/users/grfn/xanthous/src/Xanthous/Entities/Item.hs
deleted file mode 100644
index eadd62569663..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Item.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Item
-  ( Item(..)
-  , itemType
-  , density
-  , volume
-  , newWithType
-  , isEdible
-  , weight
-  , fullDescription
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Test.QuickCheck (Arbitrary, CoArbitrary, Function)
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Aeson.Generic.DerivingVia
-import           Control.Monad.Random (MonadRandom)
---------------------------------------------------------------------------------
-import           Xanthous.Entities.RawTypes (ItemType)
-import qualified Xanthous.Entities.RawTypes as Raw
-import           Xanthous.Game.State
-import           Xanthous.Data (Grams, Per, Cubic, Meters, (|*|))
-import           Xanthous.Util.QuickCheck (GenericArbitrary(GenericArbitrary))
-import           Xanthous.Random (choose, FiniteInterval(..))
---------------------------------------------------------------------------------
-
-data Item = Item
-  { _itemType :: ItemType
-  , _density  :: Grams `Per` Cubic Meters
-  , _volume   :: Cubic Meters
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Draw via DrawRawChar "_itemType" Item
-  deriving Arbitrary via GenericArbitrary Item
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       Item
-makeLenses ''Item
-
--- deriving via (Brainless Item) instance Brain Item
-instance Brain Item where step = brainVia Brainless
-
-instance Entity Item where
-  description = view $ itemType . Raw.description
-  entityChar = view $ itemType . Raw.char
-  entityCollision = const Nothing
-
-newWithType :: MonadRandom m => ItemType -> m Item
-newWithType _itemType = do
-  _density <- choose . FiniteInterval $ _itemType ^. Raw.density
-  _volume  <- choose . FiniteInterval $ _itemType ^. Raw.volume
-  pure Item {..}
-
-isEdible :: Item -> Bool
-isEdible = Raw.isEdible . view itemType
-
--- | The weight of this item, calculated by multiplying its volume by the
--- density of its material
-weight :: Item -> Grams
-weight item = (item ^. density) |*| (item ^. volume)
-
--- | Describe the item in full detail
-fullDescription :: Item -> Text
-fullDescription item = unlines
-  [ item ^. itemType . Raw.description
-  , ""
-  , item ^. itemType . Raw.longDescription
-  , ""
-  , "volume: " <> tshow (item ^. volume)
-  , "density: " <> tshow (item ^. density)
-  , "weight: " <> tshow (weight item)
-  ]
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs b/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs
deleted file mode 100644
index 14d02872ed4e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs
+++ /dev/null
@@ -1,41 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Entities.Marker ( Marker(..) ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson
-import           Test.QuickCheck
-import qualified Graphics.Vty.Attributes as Vty
-import qualified Graphics.Vty.Image as Vty
-import           Brick.Widgets.Core (raw)
---------------------------------------------------------------------------------
-import           Xanthous.Game.State
-import           Xanthous.Data.Entities (EntityAttributes(..))
---------------------------------------------------------------------------------
-
--- | Mark on the map - for use in debugging / development only.
-newtype Marker = Marker Text
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (Semigroup, Monoid, ToJSON, FromJSON, Arbitrary) via Text
-
-instance Brain Marker where step = brainVia Brainless
-
-instance Entity Marker where
-  entityAttributes = const EntityAttributes
-    { _blocksVision = False
-    , _blocksObject = False
-    , _collision = Stop
-    }
-  description (Marker m) = "[M] " <> m
-  entityChar = const $ "X" & style .~ markerStyle
-  entityCollision = const Nothing
-
-instance Draw Marker where
-  draw = const . raw $ Vty.char markerStyle 'X'
-  drawPriority = const maxBound
-
-markerStyle :: Vty.Attr
-markerStyle = Vty.defAttr
-  `Vty.withForeColor` Vty.red
-  `Vty.withBackColor` Vty.black
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
deleted file mode 100644
index a7021d76cf65..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
+++ /dev/null
@@ -1,286 +0,0 @@
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE DuplicateRecordFields #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.RawTypes
-  (
-    EntityRaw(..)
-  , _Creature
-  , _Item
-
-    -- * Creatures
-  , CreatureType(..)
-  , hostile
-    -- ** Generation parameters
-  , CreatureGenerateParams(..)
-  , canGenerate
-    -- ** Language
-  , LanguageName(..)
-  , getLanguage
-    -- ** Attacks
-  , Attack(..)
-
-    -- * Items
-  , ItemType(..)
-    -- ** Item sub-types
-    -- *** Edible
-  , EdibleItem(..)
-  , isEdible
-    -- *** Wieldable
-  , WieldableItem(..)
-  , isWieldable
-
-    -- * Lens classes
-  , HasAttackMessage(..)
-  , HasAttacks(..)
-  , HasChance(..)
-  , HasChar(..)
-  , HasCreatureAttackMessage(..)
-  , HasDamage(..)
-  , HasDensity(..)
-  , HasDescription(..)
-  , HasEatMessage(..)
-  , HasEdible(..)
-  , HasEntityName(..)
-  , HasEquippedItem(..)
-  , HasFriendly(..)
-  , HasGenerateParams(..)
-  , HasHitpointsHealed(..)
-  , HasLanguage(..)
-  , HasLevelRange(..)
-  , HasLongDescription(..)
-  , HasMaxHitpoints(..)
-  , HasName(..)
-  , HasSayVerb(..)
-  , HasSpeed(..)
-  , HasVolume(..)
-  , HasWieldable(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Test.QuickCheck
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Interval (Interval, lowerBound', upperBound')
-import qualified Data.Interval as Interval
---------------------------------------------------------------------------------
-import           Xanthous.Messages (Message(..))
-import           Xanthous.Data (TicksPerTile, Hitpoints, Per, Grams, Cubic, Meters)
-import           Xanthous.Data.EntityChar
-import           Xanthous.Util.QuickCheck
-import           Xanthous.Generators.Speech (Language, gormlak, english)
-import           Xanthous.Orphans ()
-import           Xanthous.Util (EqProp, EqEqProp(..))
---------------------------------------------------------------------------------
-
--- | Identifiers for languages that creatures can speak.
---
--- Non-verbal or non-sentient creatures have Nothing as their language
---
--- At some point, we will likely want to make languages be defined in data files
--- somewhere, and reference them that way instead.
-data LanguageName = Gormlak | English
-  deriving stock (Show, Eq, Ord, Generic, Enum, Bounded)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary LanguageName
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ AllNullaryToStringTag 'True ]
-                       LanguageName
-
--- | Resolve a 'LanguageName' into an actual 'Language'
-getLanguage :: LanguageName -> Language
-getLanguage Gormlak = gormlak
-getLanguage English = english
-
--- | Natural attacks for creature types
-data Attack = Attack
-  { -- | the @{{creature}}@ @{{description}}@
-    _description :: !Message
-    -- | Damage dealt
-  , _damage      :: !Hitpoints
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Attack
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1]
-                        , OmitNothingFields 'True
-                        ]
-                       Attack
-makeFieldsNoPrefix ''Attack
-
--- | Description for generating an item equipped to a creature
-data CreatureEquippedItem = CreatureEquippedItem
-  { -- | Name of the entity type to generate
-    _entityName :: !Text
-    -- | Chance of generating the item when generating the creature
-    --
-    -- A chance of 1.0 will always generate the item
-  , _chance :: !Double
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary CreatureEquippedItem
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1]
-                        , OmitNothingFields 'True
-                        ]
-                       CreatureEquippedItem
-makeFieldsNoPrefix ''CreatureEquippedItem
-
-
-data CreatureGenerateParams = CreatureGenerateParams
-  { -- | Range of dungeon levels at which to generate this creature
-    _levelRange :: !(Interval Word)
-    -- | Item equipped to the creature
-  , _equippedItem :: !(Maybe CreatureEquippedItem)
-  }
-  deriving stock (Eq, Show, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary CreatureGenerateParams
-  deriving EqProp via EqEqProp CreatureGenerateParams
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       CreatureGenerateParams
-makeFieldsNoPrefix ''CreatureGenerateParams
-
-instance Ord CreatureGenerateParams where
-  compare
-    = (compare `on` lowerBound' . _levelRange)
-    <> (compare `on` upperBound' . _levelRange)
-    <> (compare `on` _equippedItem)
-
--- | Can a creature with these generate params be generated on this level?
-canGenerate
-  :: Word -- ^ Level number
-  -> CreatureGenerateParams
-  -> Bool
-canGenerate levelNumber gps = Interval.member levelNumber $ gps ^. levelRange
-
-data CreatureType = CreatureType
-  { _name           :: !Text
-  , _description    :: !Text
-  , _char           :: !EntityChar
-  , _maxHitpoints   :: !Hitpoints
-  , _friendly       :: !Bool
-  , _speed          :: !TicksPerTile
-  , _language       :: !(Maybe LanguageName)
-  , -- | The verb, in present tense, for when the creature says something
-    _sayVerb        :: !(Maybe Text)
-  , -- | The creature's natural attacks
-    _attacks        :: !(NonNull (Vector Attack))
-    -- | Parameters for generating the creature in levels
-  , _generateParams :: !(Maybe CreatureGenerateParams)
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary CreatureType
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1]
-                        , OmitNothingFields 'True
-                        ]
-                       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
-    -- | Message to use when the character is using this item to attack a
-    --  creature.
-    --
-    -- Grammatically, this should be of the form "slash at the
-    -- {{creature.creatureType.name}} with your dagger"
-    --
-    -- = Parameters
-    --
-    -- [@creature@ (type: 'Creature')] The creature being attacked
-  , _attackMessage :: !(Maybe Message)
-    -- | Message to use when a creature is using this item to attack the
-    -- character.
-    --
-    -- Grammatically, should be of the form "The creature slashes you with its
-    -- dagger".
-    --
-    -- = Parameters
-    --
-    -- [@creature@ (type: 'Creature')] The creature doing the attacking
-    -- [@item@ (type: 'Item')] The item itself
-  , _creatureAttackMessage :: !(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
-  , _density         :: !(Interval (Grams `Per` Cubic Meters))
-  , _volume          :: !(Interval (Cubic Meters))
-  , _edible          :: !(Maybe EdibleItem)
-  , _wieldable       :: !(Maybe WieldableItem)
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary ItemType
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       ItemType
-makeFieldsNoPrefix ''ItemType
-
-instance Ord ItemType where
-  compare x y
-    = compareOf name x y
-    <> compareOf description x y
-    <> compareOf longDescription x y
-    <> compareOf char x y
-    <> compareOf (density . to extractInterval) x y
-    <> compareOf (volume . to extractInterval) x y
-    <> compareOf edible x y
-    <> compareOf wieldable x y
-    where
-      compareOf l = comparing (view l)
-      extractInterval = lowerBound' &&& upperBound'
-
--- | 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
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs
deleted file mode 100644
index 10f0d831934e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Raws
-  ( raws
-  , raw
-  , RawType(..)
-  , rawsWithType
-  ) where
---------------------------------------------------------------------------------
-import           Data.FileEmbed
-import qualified Data.Yaml as Yaml
-import           Xanthous.Prelude
-import           System.FilePath.Posix
---------------------------------------------------------------------------------
-import           Xanthous.Entities.RawTypes
-import           Xanthous.AI.Gormlak ()
---------------------------------------------------------------------------------
-rawRaws :: [(FilePath, ByteString)]
-rawRaws = $(embedDir "src/Xanthous/Entities/Raws")
-
-raws :: HashMap Text EntityRaw
-raws
-  = mapFromList
-  . map (bimap
-         (pack . takeBaseName)
-         (either (error . Yaml.prettyPrintParseException) id
-          . Yaml.decodeEither'))
-  $ rawRaws
-
-raw :: Text -> Maybe EntityRaw
-raw n = raws ^. at n
-
-class RawType (a :: Type) where
-  _RawType :: Prism' EntityRaw a
-
-instance RawType CreatureType where
-  _RawType = prism' Creature $ \case
-    Creature c -> Just c
-    _ -> Nothing
-
-instance RawType ItemType where
-  _RawType = prism' Item $ \case
-    Item i -> Just i
-    _ -> Nothing
-
-rawsWithType :: forall a. RawType a => HashMap Text a
-rawsWithType = mapFromList . itoListOf (ifolded . _RawType) $ raws
-
---------------------------------------------------------------------------------
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml
deleted file mode 100644
index 12c76fc14b2e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml
+++ /dev/null
@@ -1,24 +0,0 @@
-Item:
-  name: broken dagger
-  description: a short, broken dagger
-  longDescription: A short dagger with a twisted, chipped blade
-  char:
-    char: †
-    style:
-      foreground: black
-  wieldable:
-    damage: 3
-    attackMessage:
-      - slash at the {{creature.creatureType.name}} with your dagger
-      - stab the {{creature.creatureType.name}} with your dagger
-    creatureAttackMessage:
-      - The {{creature.creatureType.name}} slashes at you with its dagger.
-      - The {{creature.creatureType.name}} stabs you with its dagger.
-  # Just the steel, not the handle, for now
-  density: [7750 , 8050000]
-  # 15cm – 45cm
-  # ×
-  # 2cm – 3cm
-  # ×
-  # .5cm – 1cm
-  volume: [0.15, 1.35]
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml
deleted file mode 100644
index ad3d9cb147da..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml
+++ /dev/null
@@ -1,20 +0,0 @@
-Creature:
-  name: gormlak
-  description: a gormlak
-  longDescription: |
-    A chittering imp-like creature with bright yellow horns and sharp claws. It
-    adores shiny objects and gathers in swarms.
-  char:
-    char: g
-    style:
-      foreground: red
-  maxHitpoints: 5
-  speed: 125
-  friendly: false
-  language: Gormlak
-  sayVerb: yells
-  attacks:
-  - description:
-      - claws you
-      - slashes you with its claws
-    damage: 1
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml
deleted file mode 100644
index cdfcde616d21..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml
+++ /dev/null
@@ -1,26 +0,0 @@
-Creature:
-  name: husk
-  description: an empty husk of some humanoid creature
-  longDescription: |
-    An empty husk of a humanoid creature. All semblance of sentience has long
-    left its eyes; instead it shambles about aimlessly, always hungering for the
-    warmth of life.
-  char:
-    char: h
-    style:
-      foreground: black
-  maxHitpoints: 6
-  speed: 110
-  friendly: false
-  attacks:
-  - description:
-      - swings its arms at you
-      - elbows you
-    damage: 1
-  - description: kicks you
-    damage: 2
-  generateParams:
-    levelRange: [1, PosInf]
-    equippedItem:
-      entityName: broken-dagger
-      chance: 0.9
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml
deleted file mode 100644
index c0501a18a8e0..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml
+++ /dev/null
@@ -1,14 +0,0 @@
-Item:
-  name: noodles
-  description: "a big bowl o' noodles"
-  longDescription: You know exactly what kind of noodles
-  char:
-    char: 'n'
-    style:
-      foreground: yellow
-  edible:
-    hitpointsHealed: 2
-    eatMessage:
-      - You slurp up the noodles. Yumm!
-  density: 500000
-  volume: 0.001
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml
deleted file mode 100644
index fe427c94abf7..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml
+++ /dev/null
@@ -1,15 +0,0 @@
-Creature:
-  name: ooze
-  description: an ooze
-  longDescription: |
-    A jiggling, amorphous, bright green caustic blob
-  char:
-    char: o
-    style:
-      foreground: green
-  maxHitpoints: 3
-  speed: 100
-  friendly: false
-  attacks:
-  - description: slams into you
-    damage: 1
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml
deleted file mode 100644
index 3f4e133fe286..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml
+++ /dev/null
@@ -1,10 +0,0 @@
-Item:
-  name: rock
-  description: a rock
-  longDescription: a medium-sized rock made out of some unknown stone
-  char: .
-  wieldable:
-    damage: 1
-    attackMessage: hit the {{creature.creatureType.name}} in the head with your rock
-  density: [ 1500000, 2500000 ]
-  volume: [ 0.000125, 0.001 ]
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml
deleted file mode 100644
index 7f9e1faffedb..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml
+++ /dev/null
@@ -1,22 +0,0 @@
-Item:
-  name: stick
-  description: a wooden stick
-  longDescription: A sturdy branch broken off from some sort of tree
-  char:
-    char: ∤
-    style:
-      foreground: yellow
-  wieldable:
-    damage: 2
-    attackMessage:
-      - bonk the {{creature.creatureType.name}} over the head with your stick
-      - bash the {{creature.creatureType.name}} on the noggin with your stick
-      - whack the {{creature.creatureType.name}} with your stick
-    creatureAttackMessage:
-      - The {{creature.creatureType.name}} bonks you over the head with its stick.
-      - The {{creature.creatureType.name}} bashes you on the noggin with its stick.
-      - The {{creature.creatureType.name}} whacks you with its stick.
-  # https://www.sciencedirect.com/topics/agricultural-and-biological-sciences/wood-density
-  # it's a hard stick. so it's dense wood.
-  density: 890000 # g/m³
-  volume: [ 0.003, 0.006 ] # ≈3.5 cm radius × ≈1m length