1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
--------------------------------------------------------------------------------
module Xanthous.Entities.RawTypes
( CreatureType(..)
, EdibleItem(..)
, ItemType(..)
, isEdible
, EntityRaw(..)
, _Creature
-- * Lens classes
, HasName(..)
, HasDescription(..)
, HasLongDescription(..)
, HasMaxHitpoints(..)
, HasFriendly(..)
, HasEatMessage(..)
, HasHitpointsHealed(..)
, HasEdible(..)
, HasSpeed(..)
) 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 (EntityChar, HasChar(..))
import Xanthous.Messages (Message(..))
import Xanthous.Data (TicksPerTile, Hitpoints)
--------------------------------------------------------------------------------
data CreatureType = CreatureType
{ _name :: !Text
, _description :: !Text
, _char :: !EntityChar
, _maxHitpoints :: !Hitpoints
, _friendly :: !Bool
, _speed :: !TicksPerTile
}
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
deriving (ToJSON, FromJSON)
via WithOptions '[ FieldLabelModifier '[Drop 1] ]
CreatureType
makeFieldsNoPrefix ''CreatureType
instance Arbitrary CreatureType where
arbitrary = genericArbitrary
--------------------------------------------------------------------------------
data EdibleItem = EdibleItem
{ _hitpointsHealed :: Int
, _eatMessage :: Maybe Message
}
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
deriving (ToJSON, FromJSON)
via WithOptions '[ FieldLabelModifier '[Drop 1] ]
EdibleItem
makeFieldsNoPrefix ''EdibleItem
instance Arbitrary EdibleItem where
arbitrary = genericArbitrary
data ItemType = ItemType
{ _name :: Text
, _description :: Text
, _longDescription :: Text
, _char :: EntityChar
, _edible :: Maybe EdibleItem
}
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
deriving (ToJSON, FromJSON)
via WithOptions '[ FieldLabelModifier '[Drop 1] ]
ItemType
makeFieldsNoPrefix ''ItemType
instance Arbitrary ItemType where
arbitrary = genericArbitrary
isEdible :: ItemType -> Bool
isEdible = has $ edible . _Just
--------------------------------------------------------------------------------
data EntityRaw
= Creature CreatureType
| Item ItemType
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData)
deriving (FromJSON)
via WithOptions '[ SumEnc ObjWithSingleField ]
EntityRaw
makePrisms ''EntityRaw
{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
|
