path: root/users/aspen/xanthous/src/Xanthous/Entities/RawTypes.hs

{-# 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