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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
--------------------------------------------------------------------------------
module Xanthous.Entities.RawTypes
(
EntityRaw(..)
, _Creature
, _Item
-- * Creatures
, CreatureType(..)
, hostile
-- * Items
, ItemType(..)
-- ** Item sub-types
-- *** Edible
, EdibleItem(..)
, isEdible
-- *** Wieldable
, WieldableItem(..)
, isWieldable
-- * Lens classes
, HasAttackMessage(..)
, HasChar(..)
, HasDamage(..)
, HasDescription(..)
, HasEatMessage(..)
, HasEdible(..)
, HasFriendly(..)
, HasHitpointsHealed(..)
, 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
--------------------------------------------------------------------------------
data CreatureType = CreatureType
{ _name :: !Text
, _description :: !Text
, _char :: !EntityChar
, _maxHitpoints :: !Hitpoints
, _friendly :: !Bool
, _speed :: !TicksPerTile
}
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
deriving Arbitrary via GenericArbitrary CreatureType
deriving (ToJSON, FromJSON)
via WithOptions '[ FieldLabelModifier '[Drop 1] ]
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
|
