{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DuplicateRecordFields #-} -------------------------------------------------------------------------------- module Xanthous.Entities.RawTypes ( EntityRaw(..) , _Creature , _Item -- * Creatures , CreatureType(..) , hostile -- ** Language , LanguageName(..) , getLanguage -- * Items , ItemType(..) -- ** Item sub-types -- *** Edible , EdibleItem(..) , isEdible -- *** Wieldable , WieldableItem(..) , isWieldable -- * Lens classes , HasAttackMessage(..) , HasChar(..) , HasDamage(..) , HasDescription(..) , HasEatMessage(..) , HasEdible(..) , HasFriendly(..) , HasHitpointsHealed(..) , HasLanguage(..) , 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 import Xanthous.Generators.Speech (Language, gormlak, english) -------------------------------------------------------------------------------- -- | 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 data CreatureType = CreatureType { _name :: !Text , _description :: !Text , _char :: !EntityChar , _maxHitpoints :: !Hitpoints , _friendly :: !Bool , _speed :: !TicksPerTile , _language :: !(Maybe LanguageName) } 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 , _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