{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Swarm.Game.Entity (
EntityName,
EntityProperty (..),
GrowthTime (..),
GrowthSpread (..),
Growth (..),
defaultGrowth,
Combustibility (..),
defaultCombustibility,
Entity,
mkEntity,
entityDisplay,
entityName,
entityPlural,
entityNameFor,
entityDescription,
entityTags,
entityOrientation,
entityGrowth,
entityCombustion,
entityYields,
entityProperties,
hasProperty,
entityCapabilities,
entityBiomes,
entityInventory,
entityHash,
EntityMap (..),
buildEntityMap,
lookupEntityE,
validateEntityAttrRefs,
loadEntities,
allEntities,
lookupEntityName,
devicesForCap,
Inventory,
empty,
singleton,
fromList,
fromElems,
lookup,
lookupByName,
countByName,
contains,
contains0plus,
elems,
isSubsetOf,
isEmpty,
inventoryCapabilities,
extantElemsWithCapability,
entitiesByCapability,
insert,
insertCount,
delete,
deleteCount,
deleteAll,
union,
difference,
) where
import Control.Algebra (Has)
import Control.Applicative ((<|>))
import Control.Arrow ((&&&))
import Control.Carrier.Throw.Either (liftEither)
import Control.Effect.Lift (Lift, sendIO)
import Control.Effect.Throw (Throw, throwError)
import Control.Lens (Getter, Lens', lens, to, view, (^.))
import Control.Monad (forM_, unless, (<=<))
import Data.Bifunctor (first)
import Data.Char (toLower)
import Data.Either.Extra (maybeToEither)
import Data.Function (on)
import Data.Hashable
import Data.IntMap (IntMap)
import Data.IntMap qualified as IM
import Data.IntSet (IntSet)
import Data.IntSet qualified as IS
import Data.List (foldl')
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (isJust, listToMaybe)
import Data.Set (Set)
import Data.Set qualified as Set (fromList, member)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml
import GHC.Generics (Generic)
import Swarm.Game.Device
import Swarm.Game.Display
import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
import Swarm.Game.Entity.Cosmetic.Assignment (worldAttributes)
import Swarm.Game.Failure
import Swarm.Game.Ingredients
import Swarm.Game.Location
import Swarm.Game.ResourceLoading (getDataFileNameSafe)
import Swarm.Game.Terrain (TerrainType)
import Swarm.Language.Capability
import Swarm.Language.Syntax (Syntax)
import Swarm.Language.Text.Markdown (Document, docToText)
import Swarm.Util (binTuples, failT, findDup, plural, quote, (?))
import Swarm.Util.Effect (withThrow)
import Swarm.Util.Yaml
import Text.Read (readMaybe)
import Witch
import Prelude hiding (lookup)
type EntityName = Text
data EntityProperty
=
Unwalkable
|
Pickable
|
Pushable
|
Opaque
|
Growable
|
Combustible
|
Infinite
|
Liquid
|
Known
deriving (EntityProperty -> EntityProperty -> Bool
(EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool) -> Eq EntityProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityProperty -> EntityProperty -> Bool
== :: EntityProperty -> EntityProperty -> Bool
$c/= :: EntityProperty -> EntityProperty -> Bool
/= :: EntityProperty -> EntityProperty -> Bool
Eq, Eq EntityProperty
Eq EntityProperty =>
(EntityProperty -> EntityProperty -> Ordering)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> EntityProperty)
-> (EntityProperty -> EntityProperty -> EntityProperty)
-> Ord EntityProperty
EntityProperty -> EntityProperty -> Bool
EntityProperty -> EntityProperty -> Ordering
EntityProperty -> EntityProperty -> EntityProperty
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EntityProperty -> EntityProperty -> Ordering
compare :: EntityProperty -> EntityProperty -> Ordering
$c< :: EntityProperty -> EntityProperty -> Bool
< :: EntityProperty -> EntityProperty -> Bool
$c<= :: EntityProperty -> EntityProperty -> Bool
<= :: EntityProperty -> EntityProperty -> Bool
$c> :: EntityProperty -> EntityProperty -> Bool
> :: EntityProperty -> EntityProperty -> Bool
$c>= :: EntityProperty -> EntityProperty -> Bool
>= :: EntityProperty -> EntityProperty -> Bool
$cmax :: EntityProperty -> EntityProperty -> EntityProperty
max :: EntityProperty -> EntityProperty -> EntityProperty
$cmin :: EntityProperty -> EntityProperty -> EntityProperty
min :: EntityProperty -> EntityProperty -> EntityProperty
Ord, Int -> EntityProperty -> ShowS
[EntityProperty] -> ShowS
EntityProperty -> String
(Int -> EntityProperty -> ShowS)
-> (EntityProperty -> String)
-> ([EntityProperty] -> ShowS)
-> Show EntityProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityProperty -> ShowS
showsPrec :: Int -> EntityProperty -> ShowS
$cshow :: EntityProperty -> String
show :: EntityProperty -> String
$cshowList :: [EntityProperty] -> ShowS
showList :: [EntityProperty] -> ShowS
Show, ReadPrec [EntityProperty]
ReadPrec EntityProperty
Int -> ReadS EntityProperty
ReadS [EntityProperty]
(Int -> ReadS EntityProperty)
-> ReadS [EntityProperty]
-> ReadPrec EntityProperty
-> ReadPrec [EntityProperty]
-> Read EntityProperty
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EntityProperty
readsPrec :: Int -> ReadS EntityProperty
$creadList :: ReadS [EntityProperty]
readList :: ReadS [EntityProperty]
$creadPrec :: ReadPrec EntityProperty
readPrec :: ReadPrec EntityProperty
$creadListPrec :: ReadPrec [EntityProperty]
readListPrec :: ReadPrec [EntityProperty]
Read, Int -> EntityProperty
EntityProperty -> Int
EntityProperty -> [EntityProperty]
EntityProperty -> EntityProperty
EntityProperty -> EntityProperty -> [EntityProperty]
EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
(EntityProperty -> EntityProperty)
-> (EntityProperty -> EntityProperty)
-> (Int -> EntityProperty)
-> (EntityProperty -> Int)
-> (EntityProperty -> [EntityProperty])
-> (EntityProperty -> EntityProperty -> [EntityProperty])
-> (EntityProperty -> EntityProperty -> [EntityProperty])
-> (EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty])
-> Enum EntityProperty
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EntityProperty -> EntityProperty
succ :: EntityProperty -> EntityProperty
$cpred :: EntityProperty -> EntityProperty
pred :: EntityProperty -> EntityProperty
$ctoEnum :: Int -> EntityProperty
toEnum :: Int -> EntityProperty
$cfromEnum :: EntityProperty -> Int
fromEnum :: EntityProperty -> Int
$cenumFrom :: EntityProperty -> [EntityProperty]
enumFrom :: EntityProperty -> [EntityProperty]
$cenumFromThen :: EntityProperty -> EntityProperty -> [EntityProperty]
enumFromThen :: EntityProperty -> EntityProperty -> [EntityProperty]
$cenumFromTo :: EntityProperty -> EntityProperty -> [EntityProperty]
enumFromTo :: EntityProperty -> EntityProperty -> [EntityProperty]
$cenumFromThenTo :: EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
enumFromThenTo :: EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
Enum, EntityProperty
EntityProperty -> EntityProperty -> Bounded EntityProperty
forall a. a -> a -> Bounded a
$cminBound :: EntityProperty
minBound :: EntityProperty
$cmaxBound :: EntityProperty
maxBound :: EntityProperty
Bounded, (forall x. EntityProperty -> Rep EntityProperty x)
-> (forall x. Rep EntityProperty x -> EntityProperty)
-> Generic EntityProperty
forall x. Rep EntityProperty x -> EntityProperty
forall x. EntityProperty -> Rep EntityProperty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EntityProperty -> Rep EntityProperty x
from :: forall x. EntityProperty -> Rep EntityProperty x
$cto :: forall x. Rep EntityProperty x -> EntityProperty
to :: forall x. Rep EntityProperty x -> EntityProperty
Generic, Eq EntityProperty
Eq EntityProperty =>
(Int -> EntityProperty -> Int)
-> (EntityProperty -> Int) -> Hashable EntityProperty
Int -> EntityProperty -> Int
EntityProperty -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EntityProperty -> Int
hashWithSalt :: Int -> EntityProperty -> Int
$chash :: EntityProperty -> Int
hash :: EntityProperty -> Int
Hashable)
instance ToJSON EntityProperty where
toJSON :: EntityProperty -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (EntityProperty -> Text) -> EntityProperty -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall source target. From source target => source -> target
from (String -> Text)
-> (EntityProperty -> String) -> EntityProperty -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (EntityProperty -> String) -> EntityProperty -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityProperty -> String
forall a. Show a => a -> String
show
instance FromJSON EntityProperty where
parseJSON :: Value -> Parser EntityProperty
parseJSON = String
-> (Text -> Parser EntityProperty)
-> Value
-> Parser EntityProperty
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"EntityProperty" Text -> Parser EntityProperty
tryRead
where
tryRead :: Text -> Parser EntityProperty
tryRead :: Text -> Parser EntityProperty
tryRead Text
t = case String -> Maybe EntityProperty
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe EntityProperty)
-> (Text -> String) -> Text -> Maybe EntityProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall source target. From source target => source -> target
from (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toTitle (Text -> Maybe EntityProperty) -> Text -> Maybe EntityProperty
forall a b. (a -> b) -> a -> b
$ Text
t of
Just EntityProperty
c -> EntityProperty -> Parser EntityProperty
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityProperty
c
Maybe EntityProperty
Nothing -> [Text] -> Parser EntityProperty
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown entity property", Text
t]
data GrowthSpread = GrowthSpread
{ GrowthSpread -> Int
spreadRadius :: Int
, GrowthSpread -> Float
spreadDensity :: Float
}
deriving (GrowthSpread -> GrowthSpread -> Bool
(GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool) -> Eq GrowthSpread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrowthSpread -> GrowthSpread -> Bool
== :: GrowthSpread -> GrowthSpread -> Bool
$c/= :: GrowthSpread -> GrowthSpread -> Bool
/= :: GrowthSpread -> GrowthSpread -> Bool
Eq, Eq GrowthSpread
Eq GrowthSpread =>
(GrowthSpread -> GrowthSpread -> Ordering)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> GrowthSpread)
-> (GrowthSpread -> GrowthSpread -> GrowthSpread)
-> Ord GrowthSpread
GrowthSpread -> GrowthSpread -> Bool
GrowthSpread -> GrowthSpread -> Ordering
GrowthSpread -> GrowthSpread -> GrowthSpread
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GrowthSpread -> GrowthSpread -> Ordering
compare :: GrowthSpread -> GrowthSpread -> Ordering
$c< :: GrowthSpread -> GrowthSpread -> Bool
< :: GrowthSpread -> GrowthSpread -> Bool
$c<= :: GrowthSpread -> GrowthSpread -> Bool
<= :: GrowthSpread -> GrowthSpread -> Bool
$c> :: GrowthSpread -> GrowthSpread -> Bool
> :: GrowthSpread -> GrowthSpread -> Bool
$c>= :: GrowthSpread -> GrowthSpread -> Bool
>= :: GrowthSpread -> GrowthSpread -> Bool
$cmax :: GrowthSpread -> GrowthSpread -> GrowthSpread
max :: GrowthSpread -> GrowthSpread -> GrowthSpread
$cmin :: GrowthSpread -> GrowthSpread -> GrowthSpread
min :: GrowthSpread -> GrowthSpread -> GrowthSpread
Ord, Int -> GrowthSpread -> ShowS
[GrowthSpread] -> ShowS
GrowthSpread -> String
(Int -> GrowthSpread -> ShowS)
-> (GrowthSpread -> String)
-> ([GrowthSpread] -> ShowS)
-> Show GrowthSpread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrowthSpread -> ShowS
showsPrec :: Int -> GrowthSpread -> ShowS
$cshow :: GrowthSpread -> String
show :: GrowthSpread -> String
$cshowList :: [GrowthSpread] -> ShowS
showList :: [GrowthSpread] -> ShowS
Show, ReadPrec [GrowthSpread]
ReadPrec GrowthSpread
Int -> ReadS GrowthSpread
ReadS [GrowthSpread]
(Int -> ReadS GrowthSpread)
-> ReadS [GrowthSpread]
-> ReadPrec GrowthSpread
-> ReadPrec [GrowthSpread]
-> Read GrowthSpread
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GrowthSpread
readsPrec :: Int -> ReadS GrowthSpread
$creadList :: ReadS [GrowthSpread]
readList :: ReadS [GrowthSpread]
$creadPrec :: ReadPrec GrowthSpread
readPrec :: ReadPrec GrowthSpread
$creadListPrec :: ReadPrec [GrowthSpread]
readListPrec :: ReadPrec [GrowthSpread]
Read, (forall x. GrowthSpread -> Rep GrowthSpread x)
-> (forall x. Rep GrowthSpread x -> GrowthSpread)
-> Generic GrowthSpread
forall x. Rep GrowthSpread x -> GrowthSpread
forall x. GrowthSpread -> Rep GrowthSpread x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GrowthSpread -> Rep GrowthSpread x
from :: forall x. GrowthSpread -> Rep GrowthSpread x
$cto :: forall x. Rep GrowthSpread x -> GrowthSpread
to :: forall x. Rep GrowthSpread x -> GrowthSpread
Generic, Eq GrowthSpread
Eq GrowthSpread =>
(Int -> GrowthSpread -> Int)
-> (GrowthSpread -> Int) -> Hashable GrowthSpread
Int -> GrowthSpread -> Int
GrowthSpread -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GrowthSpread -> Int
hashWithSalt :: Int -> GrowthSpread -> Int
$chash :: GrowthSpread -> Int
hash :: GrowthSpread -> Int
Hashable, [GrowthSpread] -> Value
[GrowthSpread] -> Encoding
GrowthSpread -> Bool
GrowthSpread -> Value
GrowthSpread -> Encoding
(GrowthSpread -> Value)
-> (GrowthSpread -> Encoding)
-> ([GrowthSpread] -> Value)
-> ([GrowthSpread] -> Encoding)
-> (GrowthSpread -> Bool)
-> ToJSON GrowthSpread
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GrowthSpread -> Value
toJSON :: GrowthSpread -> Value
$ctoEncoding :: GrowthSpread -> Encoding
toEncoding :: GrowthSpread -> Encoding
$ctoJSONList :: [GrowthSpread] -> Value
toJSONList :: [GrowthSpread] -> Value
$ctoEncodingList :: [GrowthSpread] -> Encoding
toEncodingList :: [GrowthSpread] -> Encoding
$comitField :: GrowthSpread -> Bool
omitField :: GrowthSpread -> Bool
ToJSON)
instance FromJSON GrowthSpread where
parseJSON :: Value -> Parser GrowthSpread
parseJSON = String
-> (Object -> Parser GrowthSpread) -> Value -> Parser GrowthSpread
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GrowthSpread" ((Object -> Parser GrowthSpread) -> Value -> Parser GrowthSpread)
-> (Object -> Parser GrowthSpread) -> Value -> Parser GrowthSpread
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
Int
spreadRadius <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"radius"
Float
spreadDensity <- Object
v Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"density"
GrowthSpread -> Parser GrowthSpread
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GrowthSpread {Float
Int
spreadRadius :: Int
spreadDensity :: Float
spreadRadius :: Int
spreadDensity :: Float
..}
data Growth = Growth
{ Growth -> Maybe Text
maturesTo :: Maybe EntityName
, Growth -> Maybe GrowthSpread
growthSpread :: Maybe GrowthSpread
, Growth -> GrowthTime
growthTime :: GrowthTime
}
deriving (Growth -> Growth -> Bool
(Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool) -> Eq Growth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Growth -> Growth -> Bool
== :: Growth -> Growth -> Bool
$c/= :: Growth -> Growth -> Bool
/= :: Growth -> Growth -> Bool
Eq, Eq Growth
Eq Growth =>
(Growth -> Growth -> Ordering)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Growth)
-> (Growth -> Growth -> Growth)
-> Ord Growth
Growth -> Growth -> Bool
Growth -> Growth -> Ordering
Growth -> Growth -> Growth
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Growth -> Growth -> Ordering
compare :: Growth -> Growth -> Ordering
$c< :: Growth -> Growth -> Bool
< :: Growth -> Growth -> Bool
$c<= :: Growth -> Growth -> Bool
<= :: Growth -> Growth -> Bool
$c> :: Growth -> Growth -> Bool
> :: Growth -> Growth -> Bool
$c>= :: Growth -> Growth -> Bool
>= :: Growth -> Growth -> Bool
$cmax :: Growth -> Growth -> Growth
max :: Growth -> Growth -> Growth
$cmin :: Growth -> Growth -> Growth
min :: Growth -> Growth -> Growth
Ord, Int -> Growth -> ShowS
[Growth] -> ShowS
Growth -> String
(Int -> Growth -> ShowS)
-> (Growth -> String) -> ([Growth] -> ShowS) -> Show Growth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Growth -> ShowS
showsPrec :: Int -> Growth -> ShowS
$cshow :: Growth -> String
show :: Growth -> String
$cshowList :: [Growth] -> ShowS
showList :: [Growth] -> ShowS
Show, ReadPrec [Growth]
ReadPrec Growth
Int -> ReadS Growth
ReadS [Growth]
(Int -> ReadS Growth)
-> ReadS [Growth]
-> ReadPrec Growth
-> ReadPrec [Growth]
-> Read Growth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Growth
readsPrec :: Int -> ReadS Growth
$creadList :: ReadS [Growth]
readList :: ReadS [Growth]
$creadPrec :: ReadPrec Growth
readPrec :: ReadPrec Growth
$creadListPrec :: ReadPrec [Growth]
readListPrec :: ReadPrec [Growth]
Read, (forall x. Growth -> Rep Growth x)
-> (forall x. Rep Growth x -> Growth) -> Generic Growth
forall x. Rep Growth x -> Growth
forall x. Growth -> Rep Growth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Growth -> Rep Growth x
from :: forall x. Growth -> Rep Growth x
$cto :: forall x. Rep Growth x -> Growth
to :: forall x. Rep Growth x -> Growth
Generic, Eq Growth
Eq Growth =>
(Int -> Growth -> Int) -> (Growth -> Int) -> Hashable Growth
Int -> Growth -> Int
Growth -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Growth -> Int
hashWithSalt :: Int -> Growth -> Int
$chash :: Growth -> Int
hash :: Growth -> Int
Hashable, [Growth] -> Value
[Growth] -> Encoding
Growth -> Bool
Growth -> Value
Growth -> Encoding
(Growth -> Value)
-> (Growth -> Encoding)
-> ([Growth] -> Value)
-> ([Growth] -> Encoding)
-> (Growth -> Bool)
-> ToJSON Growth
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Growth -> Value
toJSON :: Growth -> Value
$ctoEncoding :: Growth -> Encoding
toEncoding :: Growth -> Encoding
$ctoJSONList :: [Growth] -> Value
toJSONList :: [Growth] -> Value
$ctoEncodingList :: [Growth] -> Encoding
toEncodingList :: [Growth] -> Encoding
$comitField :: Growth -> Bool
omitField :: Growth -> Bool
ToJSON)
instance FromJSON Growth where
parseJSON :: Value -> Parser Growth
parseJSON Value
x =
(Maybe Text -> Maybe GrowthSpread -> GrowthTime -> Growth
Growth Maybe Text
forall a. Maybe a
Nothing Maybe GrowthSpread
forall a. Maybe a
Nothing (GrowthTime -> Growth) -> Parser GrowthTime -> Parser Growth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GrowthTime
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x)
Parser Growth -> Parser Growth -> Parser Growth
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser Growth
parseFullGrowth Value
x
where
parseFullGrowth :: Value -> Parser Growth
parseFullGrowth = String -> (Object -> Parser Growth) -> Value -> Parser Growth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Growth" ((Object -> Parser Growth) -> Value -> Parser Growth)
-> (Object -> Parser Growth) -> Value -> Parser Growth
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
Maybe Text
maturesTo <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mature"
Maybe GrowthSpread
growthSpread <- Object
v Object -> Key -> Parser (Maybe GrowthSpread)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"spread"
GrowthTime
growthTime <- Object
v Object -> Key -> Parser GrowthTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration"
Growth -> Parser Growth
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Growth {Maybe Text
Maybe GrowthSpread
GrowthTime
maturesTo :: Maybe Text
growthSpread :: Maybe GrowthSpread
growthTime :: GrowthTime
maturesTo :: Maybe Text
growthSpread :: Maybe GrowthSpread
growthTime :: GrowthTime
..}
newtype GrowthTime = GrowthTime (Integer, Integer)
deriving (GrowthTime -> GrowthTime -> Bool
(GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool) -> Eq GrowthTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrowthTime -> GrowthTime -> Bool
== :: GrowthTime -> GrowthTime -> Bool
$c/= :: GrowthTime -> GrowthTime -> Bool
/= :: GrowthTime -> GrowthTime -> Bool
Eq, Eq GrowthTime
Eq GrowthTime =>
(GrowthTime -> GrowthTime -> Ordering)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> GrowthTime)
-> (GrowthTime -> GrowthTime -> GrowthTime)
-> Ord GrowthTime
GrowthTime -> GrowthTime -> Bool
GrowthTime -> GrowthTime -> Ordering
GrowthTime -> GrowthTime -> GrowthTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GrowthTime -> GrowthTime -> Ordering
compare :: GrowthTime -> GrowthTime -> Ordering
$c< :: GrowthTime -> GrowthTime -> Bool
< :: GrowthTime -> GrowthTime -> Bool
$c<= :: GrowthTime -> GrowthTime -> Bool
<= :: GrowthTime -> GrowthTime -> Bool
$c> :: GrowthTime -> GrowthTime -> Bool
> :: GrowthTime -> GrowthTime -> Bool
$c>= :: GrowthTime -> GrowthTime -> Bool
>= :: GrowthTime -> GrowthTime -> Bool
$cmax :: GrowthTime -> GrowthTime -> GrowthTime
max :: GrowthTime -> GrowthTime -> GrowthTime
$cmin :: GrowthTime -> GrowthTime -> GrowthTime
min :: GrowthTime -> GrowthTime -> GrowthTime
Ord, Int -> GrowthTime -> ShowS
[GrowthTime] -> ShowS
GrowthTime -> String
(Int -> GrowthTime -> ShowS)
-> (GrowthTime -> String)
-> ([GrowthTime] -> ShowS)
-> Show GrowthTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrowthTime -> ShowS
showsPrec :: Int -> GrowthTime -> ShowS
$cshow :: GrowthTime -> String
show :: GrowthTime -> String
$cshowList :: [GrowthTime] -> ShowS
showList :: [GrowthTime] -> ShowS
Show, ReadPrec [GrowthTime]
ReadPrec GrowthTime
Int -> ReadS GrowthTime
ReadS [GrowthTime]
(Int -> ReadS GrowthTime)
-> ReadS [GrowthTime]
-> ReadPrec GrowthTime
-> ReadPrec [GrowthTime]
-> Read GrowthTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GrowthTime
readsPrec :: Int -> ReadS GrowthTime
$creadList :: ReadS [GrowthTime]
readList :: ReadS [GrowthTime]
$creadPrec :: ReadPrec GrowthTime
readPrec :: ReadPrec GrowthTime
$creadListPrec :: ReadPrec [GrowthTime]
readListPrec :: ReadPrec [GrowthTime]
Read, (forall x. GrowthTime -> Rep GrowthTime x)
-> (forall x. Rep GrowthTime x -> GrowthTime) -> Generic GrowthTime
forall x. Rep GrowthTime x -> GrowthTime
forall x. GrowthTime -> Rep GrowthTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GrowthTime -> Rep GrowthTime x
from :: forall x. GrowthTime -> Rep GrowthTime x
$cto :: forall x. Rep GrowthTime x -> GrowthTime
to :: forall x. Rep GrowthTime x -> GrowthTime
Generic, Eq GrowthTime
Eq GrowthTime =>
(Int -> GrowthTime -> Int)
-> (GrowthTime -> Int) -> Hashable GrowthTime
Int -> GrowthTime -> Int
GrowthTime -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GrowthTime -> Int
hashWithSalt :: Int -> GrowthTime -> Int
$chash :: GrowthTime -> Int
hash :: GrowthTime -> Int
Hashable, Maybe GrowthTime
Value -> Parser [GrowthTime]
Value -> Parser GrowthTime
(Value -> Parser GrowthTime)
-> (Value -> Parser [GrowthTime])
-> Maybe GrowthTime
-> FromJSON GrowthTime
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GrowthTime
parseJSON :: Value -> Parser GrowthTime
$cparseJSONList :: Value -> Parser [GrowthTime]
parseJSONList :: Value -> Parser [GrowthTime]
$comittedField :: Maybe GrowthTime
omittedField :: Maybe GrowthTime
FromJSON, [GrowthTime] -> Value
[GrowthTime] -> Encoding
GrowthTime -> Bool
GrowthTime -> Value
GrowthTime -> Encoding
(GrowthTime -> Value)
-> (GrowthTime -> Encoding)
-> ([GrowthTime] -> Value)
-> ([GrowthTime] -> Encoding)
-> (GrowthTime -> Bool)
-> ToJSON GrowthTime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GrowthTime -> Value
toJSON :: GrowthTime -> Value
$ctoEncoding :: GrowthTime -> Encoding
toEncoding :: GrowthTime -> Encoding
$ctoJSONList :: [GrowthTime] -> Value
toJSONList :: [GrowthTime] -> Value
$ctoEncodingList :: [GrowthTime] -> Encoding
toEncodingList :: [GrowthTime] -> Encoding
$comitField :: GrowthTime -> Bool
omitField :: GrowthTime -> Bool
ToJSON)
defaultGrowthTime :: GrowthTime
defaultGrowthTime :: GrowthTime
defaultGrowthTime = (Integer, Integer) -> GrowthTime
GrowthTime (Integer
100, Integer
200)
defaultGrowth :: Growth
defaultGrowth :: Growth
defaultGrowth = Maybe Text -> Maybe GrowthSpread -> GrowthTime -> Growth
Growth Maybe Text
forall a. Maybe a
Nothing Maybe GrowthSpread
forall a. Maybe a
Nothing GrowthTime
defaultGrowthTime
data Combustibility = Combustibility
{ Combustibility -> Double
ignition :: Double
, Combustibility -> (Integer, Integer)
duration :: (Integer, Integer)
, Combustibility -> Maybe Text
product :: Maybe EntityName
}
deriving (Combustibility -> Combustibility -> Bool
(Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool) -> Eq Combustibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Combustibility -> Combustibility -> Bool
== :: Combustibility -> Combustibility -> Bool
$c/= :: Combustibility -> Combustibility -> Bool
/= :: Combustibility -> Combustibility -> Bool
Eq, Eq Combustibility
Eq Combustibility =>
(Combustibility -> Combustibility -> Ordering)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Combustibility)
-> (Combustibility -> Combustibility -> Combustibility)
-> Ord Combustibility
Combustibility -> Combustibility -> Bool
Combustibility -> Combustibility -> Ordering
Combustibility -> Combustibility -> Combustibility
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Combustibility -> Combustibility -> Ordering
compare :: Combustibility -> Combustibility -> Ordering
$c< :: Combustibility -> Combustibility -> Bool
< :: Combustibility -> Combustibility -> Bool
$c<= :: Combustibility -> Combustibility -> Bool
<= :: Combustibility -> Combustibility -> Bool
$c> :: Combustibility -> Combustibility -> Bool
> :: Combustibility -> Combustibility -> Bool
$c>= :: Combustibility -> Combustibility -> Bool
>= :: Combustibility -> Combustibility -> Bool
$cmax :: Combustibility -> Combustibility -> Combustibility
max :: Combustibility -> Combustibility -> Combustibility
$cmin :: Combustibility -> Combustibility -> Combustibility
min :: Combustibility -> Combustibility -> Combustibility
Ord, Int -> Combustibility -> ShowS
[Combustibility] -> ShowS
Combustibility -> String
(Int -> Combustibility -> ShowS)
-> (Combustibility -> String)
-> ([Combustibility] -> ShowS)
-> Show Combustibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Combustibility -> ShowS
showsPrec :: Int -> Combustibility -> ShowS
$cshow :: Combustibility -> String
show :: Combustibility -> String
$cshowList :: [Combustibility] -> ShowS
showList :: [Combustibility] -> ShowS
Show, ReadPrec [Combustibility]
ReadPrec Combustibility
Int -> ReadS Combustibility
ReadS [Combustibility]
(Int -> ReadS Combustibility)
-> ReadS [Combustibility]
-> ReadPrec Combustibility
-> ReadPrec [Combustibility]
-> Read Combustibility
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Combustibility
readsPrec :: Int -> ReadS Combustibility
$creadList :: ReadS [Combustibility]
readList :: ReadS [Combustibility]
$creadPrec :: ReadPrec Combustibility
readPrec :: ReadPrec Combustibility
$creadListPrec :: ReadPrec [Combustibility]
readListPrec :: ReadPrec [Combustibility]
Read, (forall x. Combustibility -> Rep Combustibility x)
-> (forall x. Rep Combustibility x -> Combustibility)
-> Generic Combustibility
forall x. Rep Combustibility x -> Combustibility
forall x. Combustibility -> Rep Combustibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Combustibility -> Rep Combustibility x
from :: forall x. Combustibility -> Rep Combustibility x
$cto :: forall x. Rep Combustibility x -> Combustibility
to :: forall x. Rep Combustibility x -> Combustibility
Generic, Eq Combustibility
Eq Combustibility =>
(Int -> Combustibility -> Int)
-> (Combustibility -> Int) -> Hashable Combustibility
Int -> Combustibility -> Int
Combustibility -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Combustibility -> Int
hashWithSalt :: Int -> Combustibility -> Int
$chash :: Combustibility -> Int
hash :: Combustibility -> Int
Hashable, Maybe Combustibility
Value -> Parser [Combustibility]
Value -> Parser Combustibility
(Value -> Parser Combustibility)
-> (Value -> Parser [Combustibility])
-> Maybe Combustibility
-> FromJSON Combustibility
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Combustibility
parseJSON :: Value -> Parser Combustibility
$cparseJSONList :: Value -> Parser [Combustibility]
parseJSONList :: Value -> Parser [Combustibility]
$comittedField :: Maybe Combustibility
omittedField :: Maybe Combustibility
FromJSON, [Combustibility] -> Value
[Combustibility] -> Encoding
Combustibility -> Bool
Combustibility -> Value
Combustibility -> Encoding
(Combustibility -> Value)
-> (Combustibility -> Encoding)
-> ([Combustibility] -> Value)
-> ([Combustibility] -> Encoding)
-> (Combustibility -> Bool)
-> ToJSON Combustibility
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Combustibility -> Value
toJSON :: Combustibility -> Value
$ctoEncoding :: Combustibility -> Encoding
toEncoding :: Combustibility -> Encoding
$ctoJSONList :: [Combustibility] -> Value
toJSONList :: [Combustibility] -> Value
$ctoEncodingList :: [Combustibility] -> Encoding
toEncodingList :: [Combustibility] -> Encoding
$comitField :: Combustibility -> Bool
omitField :: Combustibility -> Bool
ToJSON)
defaultCombustibility :: Combustibility
defaultCombustibility :: Combustibility
defaultCombustibility = Double -> (Integer, Integer) -> Maybe Text -> Combustibility
Combustibility Double
0.5 (Integer
100, Integer
200) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ash")
data Entity = Entity
{ Entity -> Int
_entityHash :: Int
, Entity -> Display
_entityDisplay :: Display
, Entity -> Text
_entityName :: EntityName
, Entity -> Maybe Text
_entityPlural :: Maybe Text
, Entity -> Document Syntax
_entityDescription :: Document Syntax
, Entity -> Set Text
_entityTags :: Set Text
, Entity -> Maybe Heading
_entityOrientation :: Maybe Heading
, Entity -> Maybe Growth
_entityGrowth :: Maybe Growth
, Entity -> Maybe Combustibility
_entityCombustion :: Maybe Combustibility
, Entity -> Maybe Text
_entityYields :: Maybe Text
, Entity -> Set EntityProperty
_entityProperties :: Set EntityProperty
, Entity -> Set TerrainType
_entityBiomes :: Set TerrainType
, Entity -> Capabilities (ExerciseCost Text)
_entityCapabilities :: SingleEntityCapabilities EntityName
, Entity -> Inventory
_entityInventory :: Inventory
}
deriving (Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
(Int -> Entity -> ShowS)
-> (Entity -> String) -> ([Entity] -> ShowS) -> Show Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entity -> ShowS
showsPrec :: Int -> Entity -> ShowS
$cshow :: Entity -> String
show :: Entity -> String
$cshowList :: [Entity] -> ShowS
showList :: [Entity] -> ShowS
Show, (forall x. Entity -> Rep Entity x)
-> (forall x. Rep Entity x -> Entity) -> Generic Entity
forall x. Rep Entity x -> Entity
forall x. Entity -> Rep Entity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Entity -> Rep Entity x
from :: forall x. Entity -> Rep Entity x
$cto :: forall x. Rep Entity x -> Entity
to :: forall x. Rep Entity x -> Entity
Generic)
instance Hashable Entity where
hashWithSalt :: Int -> Entity -> Int
hashWithSalt Int
s (Entity Int
_ Display
disp Text
nm Maybe Text
pl Document Syntax
descr Set Text
tags Maybe Heading
orient Maybe Growth
grow Maybe Combustibility
combust Maybe Text
yld Set EntityProperty
props Set TerrainType
biomes Capabilities (ExerciseCost Text)
caps Inventory
inv) =
Int
s
Int -> Display -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Display
disp
Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
nm
Int -> Maybe Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Text
pl
Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Document Syntax -> Text
forall a. PrettyPrec a => Document a -> Text
docToText Document Syntax
descr
Int -> Set Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Set Text
tags
Int -> Maybe Heading -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Heading
orient
Int -> Maybe Growth -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Growth
grow
Int -> Maybe Combustibility -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Combustibility
combust
Int -> Maybe Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Text
yld
Int -> Set EntityProperty -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Set EntityProperty
props
Int -> Set TerrainType -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Set TerrainType
biomes
Int -> Capabilities (ExerciseCost Text) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Capabilities (ExerciseCost Text)
caps
Int -> Inventory -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Inventory
inv
instance Eq Entity where
== :: Entity -> Entity -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> (Entity -> Int) -> Entity -> Entity -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entity -> Int
_entityHash
instance Ord Entity where
compare :: Entity -> Entity -> Ordering
compare = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Entity -> Int) -> Entity -> Entity -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entity -> Int
_entityHash
rehashEntity :: Entity -> Entity
rehashEntity :: Entity -> Entity
rehashEntity Entity
e = Entity
e {_entityHash = hash e}
mkEntity ::
Display ->
Text ->
Document Syntax ->
[EntityProperty] ->
Set Capability ->
Entity
mkEntity :: Display
-> Text
-> Document Syntax
-> [EntityProperty]
-> Set Capability
-> Entity
mkEntity Display
disp Text
nm Document Syntax
descr [EntityProperty]
props Set Capability
caps =
Entity -> Entity
rehashEntity (Entity -> Entity) -> Entity -> Entity
forall a b. (a -> b) -> a -> b
$
Int
-> Display
-> Text
-> Maybe Text
-> Document Syntax
-> Set Text
-> Maybe Heading
-> Maybe Growth
-> Maybe Combustibility
-> Maybe Text
-> Set EntityProperty
-> Set TerrainType
-> Capabilities (ExerciseCost Text)
-> Inventory
-> Entity
Entity
Int
0
Display
disp
Text
nm
Maybe Text
forall a. Maybe a
Nothing
Document Syntax
descr
Set Text
forall a. Monoid a => a
mempty
Maybe Heading
forall a. Maybe a
Nothing
Maybe Growth
forall a. Maybe a
Nothing
Maybe Combustibility
forall a. Maybe a
Nothing
Maybe Text
forall a. Maybe a
Nothing
([EntityProperty] -> Set EntityProperty
forall a. Ord a => [a] -> Set a
Set.fromList [EntityProperty]
props)
Set TerrainType
forall a. Monoid a => a
mempty
(Set Capability -> Capabilities (ExerciseCost Text)
forall e. Set Capability -> SingleEntityCapabilities e
zeroCostCapabilities Set Capability
caps)
Inventory
empty
data EntityMap = EntityMap
{ EntityMap -> Map Text Entity
entitiesByName :: Map EntityName Entity
, EntityMap -> MultiEntityCapabilities Entity Entity
entitiesByCap :: MultiEntityCapabilities Entity Entity
, EntityMap -> [Entity]
entityDefinitionOrder :: [Entity]
}
deriving (EntityMap -> EntityMap -> Bool
(EntityMap -> EntityMap -> Bool)
-> (EntityMap -> EntityMap -> Bool) -> Eq EntityMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityMap -> EntityMap -> Bool
== :: EntityMap -> EntityMap -> Bool
$c/= :: EntityMap -> EntityMap -> Bool
/= :: EntityMap -> EntityMap -> Bool
Eq, Int -> EntityMap -> ShowS
[EntityMap] -> ShowS
EntityMap -> String
(Int -> EntityMap -> ShowS)
-> (EntityMap -> String)
-> ([EntityMap] -> ShowS)
-> Show EntityMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityMap -> ShowS
showsPrec :: Int -> EntityMap -> ShowS
$cshow :: EntityMap -> String
show :: EntityMap -> String
$cshowList :: [EntityMap] -> ShowS
showList :: [EntityMap] -> ShowS
Show, (forall x. EntityMap -> Rep EntityMap x)
-> (forall x. Rep EntityMap x -> EntityMap) -> Generic EntityMap
forall x. Rep EntityMap x -> EntityMap
forall x. EntityMap -> Rep EntityMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EntityMap -> Rep EntityMap x
from :: forall x. EntityMap -> Rep EntityMap x
$cto :: forall x. Rep EntityMap x -> EntityMap
to :: forall x. Rep EntityMap x -> EntityMap
Generic, [EntityMap] -> Value
[EntityMap] -> Encoding
EntityMap -> Bool
EntityMap -> Value
EntityMap -> Encoding
(EntityMap -> Value)
-> (EntityMap -> Encoding)
-> ([EntityMap] -> Value)
-> ([EntityMap] -> Encoding)
-> (EntityMap -> Bool)
-> ToJSON EntityMap
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: EntityMap -> Value
toJSON :: EntityMap -> Value
$ctoEncoding :: EntityMap -> Encoding
toEncoding :: EntityMap -> Encoding
$ctoJSONList :: [EntityMap] -> Value
toJSONList :: [EntityMap] -> Value
$ctoEncodingList :: [EntityMap] -> Encoding
toEncodingList :: [EntityMap] -> Encoding
$comitField :: EntityMap -> Bool
omitField :: EntityMap -> Bool
ToJSON)
instance Semigroup EntityMap where
EntityMap Map Text Entity
n1 MultiEntityCapabilities Entity Entity
c1 [Entity]
d1 <> :: EntityMap -> EntityMap -> EntityMap
<> EntityMap Map Text Entity
n2 MultiEntityCapabilities Entity Entity
c2 [Entity]
d2 =
Map Text Entity
-> MultiEntityCapabilities Entity Entity -> [Entity] -> EntityMap
EntityMap
(Map Text Entity
n1 Map Text Entity -> Map Text Entity -> Map Text Entity
forall a. Semigroup a => a -> a -> a
<> Map Text Entity
n2)
(MultiEntityCapabilities Entity Entity
c1 MultiEntityCapabilities Entity Entity
-> MultiEntityCapabilities Entity Entity
-> MultiEntityCapabilities Entity Entity
forall a. Semigroup a => a -> a -> a
<> MultiEntityCapabilities Entity Entity
c2)
((Entity -> Bool) -> [Entity] -> [Entity]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Map Text Entity -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map Text Entity
n2) (Text -> Bool) -> (Entity -> Text) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName) [Entity]
d1 [Entity] -> [Entity] -> [Entity]
forall a. Semigroup a => a -> a -> a
<> [Entity]
d2)
instance Monoid EntityMap where
mempty :: EntityMap
mempty = Map Text Entity
-> MultiEntityCapabilities Entity Entity -> [Entity] -> EntityMap
EntityMap Map Text Entity
forall k a. Map k a
M.empty MultiEntityCapabilities Entity Entity
forall a. Monoid a => a
mempty []
mappend :: EntityMap -> EntityMap -> EntityMap
mappend = EntityMap -> EntityMap -> EntityMap
forall a. Semigroup a => a -> a -> a
(<>)
allEntities :: EntityMap -> [Entity]
allEntities :: EntityMap -> [Entity]
allEntities (EntityMap Map Text Entity
_ MultiEntityCapabilities Entity Entity
_ [Entity]
x) = [Entity]
x
lookupEntityName :: Text -> EntityMap -> Maybe Entity
lookupEntityName :: Text -> EntityMap -> Maybe Entity
lookupEntityName Text
nm = Text -> Map Text Entity -> Maybe Entity
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
nm (Map Text Entity -> Maybe Entity)
-> (EntityMap -> Map Text Entity) -> EntityMap -> Maybe Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap -> Map Text Entity
entitiesByName
devicesForCap :: Capability -> EntityMap -> [Entity]
devicesForCap :: Capability -> EntityMap -> [Entity]
devicesForCap Capability
cap = [Entity]
-> (NonEmpty (DeviceUseCost Entity Entity) -> [Entity])
-> Maybe (NonEmpty (DeviceUseCost Entity Entity))
-> [Entity]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (NonEmpty Entity -> [Entity]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Entity -> [Entity])
-> (NonEmpty (DeviceUseCost Entity Entity) -> NonEmpty Entity)
-> NonEmpty (DeviceUseCost Entity Entity)
-> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceUseCost Entity Entity -> Entity)
-> NonEmpty (DeviceUseCost Entity Entity) -> NonEmpty Entity
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DeviceUseCost Entity Entity -> Entity
forall e en. DeviceUseCost e en -> e
device) (Maybe (NonEmpty (DeviceUseCost Entity Entity)) -> [Entity])
-> (EntityMap -> Maybe (NonEmpty (DeviceUseCost Entity Entity)))
-> EntityMap
-> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity))
-> Maybe (NonEmpty (DeviceUseCost Entity Entity))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Capability
cap (Map Capability (NonEmpty (DeviceUseCost Entity Entity))
-> Maybe (NonEmpty (DeviceUseCost Entity Entity)))
-> (EntityMap
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity)))
-> EntityMap
-> Maybe (NonEmpty (DeviceUseCost Entity Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiEntityCapabilities Entity Entity
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity))
forall e. Capabilities e -> Map Capability e
getMap (MultiEntityCapabilities Entity Entity
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity)))
-> (EntityMap -> MultiEntityCapabilities Entity Entity)
-> EntityMap
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap -> MultiEntityCapabilities Entity Entity
entitiesByCap
validateEntityAttrRefs :: Has (Throw LoadingFailure) sig m => Set WorldAttr -> [Entity] -> m ()
validateEntityAttrRefs :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
Set WorldAttr -> [Entity] -> m ()
validateEntityAttrRefs Set WorldAttr
validAttrs [Entity]
es =
[(Text, Entity)] -> ((Text, Entity) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Entity)]
namedEntities (((Text, Entity) -> m ()) -> m ())
-> ((Text, Entity) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Text
eName, Entity
ent) ->
case Entity
ent Entity -> Getting Attribute Entity Attribute -> Attribute
forall s a. s -> Getting a s a -> a
^. (Display -> Const Attribute Display)
-> Entity -> Const Attribute Entity
Lens' Entity Display
entityDisplay ((Display -> Const Attribute Display)
-> Entity -> Const Attribute Entity)
-> ((Attribute -> Const Attribute Attribute)
-> Display -> Const Attribute Display)
-> Getting Attribute Entity Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> Const Attribute Attribute)
-> Display -> Const Attribute Display
Lens' Display Attribute
displayAttr of
AWorld Text
n ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorldAttr -> Set WorldAttr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (String -> WorldAttr
WorldAttr (String -> WorldAttr) -> String -> WorldAttr
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
n) Set WorldAttr
validAttrs)
(m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadingFailure -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError
(LoadingFailure -> m ())
-> (Text -> LoadingFailure) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LoadingFailure
CustomMessage
(Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
[ Text
"Nonexistent attribute"
, Text -> Text
quote Text
n
, Text
"referenced by entity"
, Text -> Text
quote Text
eName
]
Attribute
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
namedEntities :: [(Text, Entity)]
namedEntities = (Entity -> (Text, Entity)) -> [Entity] -> [(Text, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName (Entity -> Text) -> (Entity -> Entity) -> Entity -> (Text, Entity)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Entity -> Entity
forall a. a -> a
id) [Entity]
es
buildEntityMap :: Has (Throw LoadingFailure) sig m => [Entity] -> m EntityMap
buildEntityMap :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
[Entity] -> m EntityMap
buildEntityMap [Entity]
es = do
case [Text] -> Maybe Text
forall a. Ord a => [a] -> Maybe a
findDup (((Text, Entity) -> Text) -> [(Text, Entity)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Entity) -> Text
forall a b. (a, b) -> a
fst [(Text, Entity)]
namedEntities) of
Maybe Text
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Text
duped -> LoadingFailure -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (LoadingFailure -> m ()) -> LoadingFailure -> m ()
forall a b. (a -> b) -> a -> b
$ AssetData -> Text -> LoadingFailure
Duplicate AssetData
Entities Text
duped
case Map Text Entity
-> [Entity] -> Either Text (MultiEntityCapabilities Entity Entity)
combineEntityCapsM Map Text Entity
entsByName [Entity]
es of
Left Text
x -> LoadingFailure -> m EntityMap
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (LoadingFailure -> m EntityMap) -> LoadingFailure -> m EntityMap
forall a b. (a -> b) -> a -> b
$ Text -> LoadingFailure
CustomMessage Text
x
Right MultiEntityCapabilities Entity Entity
ebc ->
EntityMap -> m EntityMap
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityMap -> m EntityMap) -> EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$
EntityMap
{ entitiesByName :: Map Text Entity
entitiesByName = Map Text Entity
entsByName
, entitiesByCap :: MultiEntityCapabilities Entity Entity
entitiesByCap = MultiEntityCapabilities Entity Entity
ebc
, entityDefinitionOrder :: [Entity]
entityDefinitionOrder = [Entity]
es
}
where
namedEntities :: [(Text, Entity)]
namedEntities = (Entity -> (Text, Entity)) -> [Entity] -> [(Text, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName (Entity -> Text) -> (Entity -> Entity) -> Entity -> (Text, Entity)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Entity -> Entity
forall a. a -> a
id) [Entity]
es
entsByName :: Map Text Entity
entsByName = [(Text, Entity)] -> Map Text Entity
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Entity)]
namedEntities
combineEntityCaps ::
[Entity] ->
MultiEntityCapabilities Entity EntityName
combineEntityCaps :: [Entity] -> MultiEntityCapabilities Entity Text
combineEntityCaps = [MultiEntityCapabilities Entity Text]
-> MultiEntityCapabilities Entity Text
forall a. Monoid a => [a] -> a
mconcat ([MultiEntityCapabilities Entity Text]
-> MultiEntityCapabilities Entity Text)
-> ([Entity] -> [MultiEntityCapabilities Entity Text])
-> [Entity]
-> MultiEntityCapabilities Entity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> MultiEntityCapabilities Entity Text)
-> [Entity] -> [MultiEntityCapabilities Entity Text]
forall a b. (a -> b) -> [a] -> [b]
map Entity -> MultiEntityCapabilities Entity Text
forall {f :: * -> *}.
Applicative f =>
Entity -> Capabilities (f (DeviceUseCost Entity Text))
mkForEntity
where
mkForEntity :: Entity -> Capabilities (f (DeviceUseCost Entity Text))
mkForEntity Entity
e = ExerciseCost Text -> f (DeviceUseCost Entity Text)
f (ExerciseCost Text -> f (DeviceUseCost Entity Text))
-> Capabilities (ExerciseCost Text)
-> Capabilities (f (DeviceUseCost Entity Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity
e Entity
-> Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities
where
f :: ExerciseCost Text -> f (DeviceUseCost Entity Text)
f = DeviceUseCost Entity Text -> f (DeviceUseCost Entity Text)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceUseCost Entity Text -> f (DeviceUseCost Entity Text))
-> (ExerciseCost Text -> DeviceUseCost Entity Text)
-> ExerciseCost Text
-> f (DeviceUseCost Entity Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> ExerciseCost Text -> DeviceUseCost Entity Text
forall e en. e -> ExerciseCost en -> DeviceUseCost e en
DeviceUseCost Entity
e
lookupEntityE :: Map Text b -> Text -> Either Text b
lookupEntityE :: forall b. Map Text b -> Text -> Either Text b
lookupEntityE Map Text b
em Text
en =
Text -> Maybe b -> Either Text b
forall a b. a -> Maybe b -> Either a b
maybeToEither Text
err (Maybe b -> Either Text b) -> Maybe b -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text -> Map Text b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
en Map Text b
em
where
err :: Text
err = [Text] -> Text
T.unwords [Text -> Text
quote Text
en, Text
"is not a valid entity name"]
combineEntityCapsM ::
Map EntityName Entity ->
[Entity] ->
Either Text (MultiEntityCapabilities Entity Entity)
combineEntityCapsM :: Map Text Entity
-> [Entity] -> Either Text (MultiEntityCapabilities Entity Entity)
combineEntityCapsM Map Text Entity
em =
([MultiEntityCapabilities Entity Entity]
-> MultiEntityCapabilities Entity Entity)
-> Either Text [MultiEntityCapabilities Entity Entity]
-> Either Text (MultiEntityCapabilities Entity Entity)
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MultiEntityCapabilities Entity Entity]
-> MultiEntityCapabilities Entity Entity
forall a. Monoid a => [a] -> a
mconcat (Either Text [MultiEntityCapabilities Entity Entity]
-> Either Text (MultiEntityCapabilities Entity Entity))
-> ([Entity]
-> Either Text [MultiEntityCapabilities Entity Entity])
-> [Entity]
-> Either Text (MultiEntityCapabilities Entity Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Either Text (MultiEntityCapabilities Entity Entity))
-> [Entity] -> Either Text [MultiEntityCapabilities Entity Entity]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Entity -> Either Text (MultiEntityCapabilities Entity Entity)
mkForEntity
where
transformCaps :: Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
transformCaps = ((ExerciseCost Text -> Either Text (ExerciseCost Entity))
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Capabilities a -> f (Capabilities b)
traverse ((ExerciseCost Text -> Either Text (ExerciseCost Entity))
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity)))
-> ((Text -> Either Text Entity)
-> ExerciseCost Text -> Either Text (ExerciseCost Entity))
-> (Text -> Either Text Entity)
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text Entity)
-> ExerciseCost Text -> Either Text (ExerciseCost Entity)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExerciseCost a -> f (ExerciseCost b)
traverse) (Map Text Entity -> Text -> Either Text Entity
forall b. Map Text b -> Text -> Either Text b
lookupEntityE Map Text Entity
em)
mkForEntity :: Entity -> Either Text (MultiEntityCapabilities Entity Entity)
mkForEntity Entity
e =
(ExerciseCost Entity -> NonEmpty (DeviceUseCost Entity Entity))
-> Capabilities (ExerciseCost Entity)
-> MultiEntityCapabilities Entity Entity
forall a b. (a -> b) -> Capabilities a -> Capabilities b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExerciseCost Entity -> NonEmpty (DeviceUseCost Entity Entity)
f (Capabilities (ExerciseCost Entity)
-> MultiEntityCapabilities Entity Entity)
-> Either Text (Capabilities (ExerciseCost Entity))
-> Either Text (MultiEntityCapabilities Entity Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
transformCaps (Entity
e Entity
-> Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)
where
f :: ExerciseCost Entity -> NonEmpty (DeviceUseCost Entity Entity)
f = DeviceUseCost Entity Entity
-> NonEmpty (DeviceUseCost Entity Entity)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceUseCost Entity Entity
-> NonEmpty (DeviceUseCost Entity Entity))
-> (ExerciseCost Entity -> DeviceUseCost Entity Entity)
-> ExerciseCost Entity
-> NonEmpty (DeviceUseCost Entity Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> ExerciseCost Entity -> DeviceUseCost Entity Entity
forall e en. e -> ExerciseCost en -> DeviceUseCost e en
DeviceUseCost Entity
e
instance FromJSON Entity where
parseJSON :: Value -> Parser Entity
parseJSON = String -> (Object -> Parser Entity) -> Value -> Parser Entity
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Entity" ((Object -> Parser Entity) -> Value -> Parser Entity)
-> (Object -> Parser Entity) -> Value -> Parser Entity
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
let _entityHash :: Int
_entityHash = Int
0
Display
_entityDisplay <- Object
v Object -> Key -> Parser Display
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"display"
Text
_entityName <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
Maybe Text
_entityPlural <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"plural"
Document Syntax
_entityDescription <- Object
v Object -> Key -> Parser (Document Syntax)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
Set Text
_entityTags <- Object
v Object -> Key -> Parser (Maybe (Set Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags" Parser (Maybe (Set Text)) -> Set Text -> Parser (Set Text)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Set Text
forall a. Monoid a => a
mempty
Maybe Heading
_entityOrientation <- Object
v Object -> Key -> Parser (Maybe Heading)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"orientation"
Maybe Growth
_entityGrowth <- Object
v Object -> Key -> Parser (Maybe Growth)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"growth"
Maybe Combustibility
_entityCombustion <- Object
v Object -> Key -> Parser (Maybe Combustibility)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"combustion"
Maybe Text
_entityYields <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"yields"
Set EntityProperty
_entityProperties <- Object
v Object -> Key -> Parser (Maybe (Set EntityProperty))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"properties" Parser (Maybe (Set EntityProperty))
-> Set EntityProperty -> Parser (Set EntityProperty)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Set EntityProperty
forall a. Monoid a => a
mempty
Set TerrainType
_entityBiomes <- Object
v Object -> Key -> Parser (Maybe (Set TerrainType))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"biomes" Parser (Maybe (Set TerrainType))
-> Set TerrainType -> Parser (Set TerrainType)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Set TerrainType
forall a. Monoid a => a
mempty
Capabilities (ExerciseCost Text)
_entityCapabilities <- Object
v Object -> Key -> Parser (Maybe (Capabilities (ExerciseCost Text)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"capabilities" Parser (Maybe (Capabilities (ExerciseCost Text)))
-> Capabilities (ExerciseCost Text)
-> Parser (Capabilities (ExerciseCost Text))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Capability (ExerciseCost Text)
-> Capabilities (ExerciseCost Text)
forall e. Map Capability e -> Capabilities e
Capabilities Map Capability (ExerciseCost Text)
forall a. Monoid a => a
mempty
let _entityInventory :: Inventory
_entityInventory = Inventory
empty
Entity -> Parser Entity
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Entity -> Parser Entity) -> Entity -> Parser Entity
forall a b. (a -> b) -> a -> b
$ Entity -> Entity
rehashEntity Entity {Int
Maybe Text
Maybe Heading
Maybe Combustibility
Maybe Growth
Text
Set Text
Set TerrainType
Set EntityProperty
Document Syntax
Display
Capabilities (ExerciseCost Text)
Inventory
_entityHash :: Int
_entityDisplay :: Display
_entityName :: Text
_entityPlural :: Maybe Text
_entityDescription :: Document Syntax
_entityTags :: Set Text
_entityOrientation :: Maybe Heading
_entityGrowth :: Maybe Growth
_entityCombustion :: Maybe Combustibility
_entityYields :: Maybe Text
_entityProperties :: Set EntityProperty
_entityBiomes :: Set TerrainType
_entityCapabilities :: Capabilities (ExerciseCost Text)
_entityInventory :: Inventory
_entityHash :: Int
_entityDisplay :: Display
_entityName :: Text
_entityPlural :: Maybe Text
_entityDescription :: Document Syntax
_entityTags :: Set Text
_entityOrientation :: Maybe Heading
_entityGrowth :: Maybe Growth
_entityCombustion :: Maybe Combustibility
_entityYields :: Maybe Text
_entityProperties :: Set EntityProperty
_entityBiomes :: Set TerrainType
_entityCapabilities :: Capabilities (ExerciseCost Text)
_entityInventory :: Inventory
..}
instance FromJSONE EntityMap Entity where
parseJSONE :: Value -> ParserE EntityMap Entity
parseJSONE = String
-> (Text -> ParserE EntityMap Entity)
-> Value
-> ParserE EntityMap Entity
forall e a. String -> (Text -> ParserE e a) -> Value -> ParserE e a
withTextE String
"entity name" ((Text -> ParserE EntityMap Entity)
-> Value -> ParserE EntityMap Entity)
-> (Text -> ParserE EntityMap Entity)
-> Value
-> ParserE EntityMap Entity
forall a b. (a -> b) -> a -> b
$ \Text
name ->
(EntityMap -> Parser Entity) -> ParserE EntityMap Entity
forall e (f :: * -> *) a. (e -> f a) -> With e f a
E ((EntityMap -> Parser Entity) -> ParserE EntityMap Entity)
-> (EntityMap -> Parser Entity) -> ParserE EntityMap Entity
forall a b. (a -> b) -> a -> b
$ \EntityMap
em -> case Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em of
Maybe Entity
Nothing -> [Text] -> Parser Entity
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown entity:", Text
name]
Just Entity
e -> Entity -> Parser Entity
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e
instance ToJSON Entity where
toJSON :: Entity -> Value
toJSON Entity
e =
[Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ Key
"display" Key -> Display -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting Display Entity Display -> Display
forall s a. s -> Getting a s a -> a
^. Getting Display Entity Display
Lens' Entity Display
entityDisplay)
, Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName)
, Key
"description" Key -> Document Syntax -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Document Syntax) Entity (Document Syntax)
-> Document Syntax
forall s a. s -> Getting a s a -> a
^. Getting (Document Syntax) Entity (Document Syntax)
Lens' Entity (Document Syntax)
entityDescription)
, Key
"tags" Key -> Set Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting (Set Text) Entity (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^. Getting (Set Text) Entity (Set Text)
Lens' Entity (Set Text)
entityTags)
]
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"plural" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityPlural) | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityPlural)]
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"orientation" Key -> Maybe Heading -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Maybe Heading) Entity (Maybe Heading) -> Maybe Heading
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Heading) Entity (Maybe Heading)
Lens' Entity (Maybe Heading)
entityOrientation) | Maybe Heading -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity
-> Getting (Maybe Heading) Entity (Maybe Heading) -> Maybe Heading
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Heading) Entity (Maybe Heading)
Lens' Entity (Maybe Heading)
entityOrientation)]
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"growth" Key -> Maybe Growth -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Maybe Growth) Entity (Maybe Growth) -> Maybe Growth
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Growth) Entity (Maybe Growth)
Lens' Entity (Maybe Growth)
entityGrowth) | Maybe Growth -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity
-> Getting (Maybe Growth) Entity (Maybe Growth) -> Maybe Growth
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Growth) Entity (Maybe Growth)
Lens' Entity (Maybe Growth)
entityGrowth)]
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"yields" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityYields) | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityYields)]
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"properties" Key -> Set EntityProperty -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties) | Bool -> Bool
not (Bool -> Bool)
-> (Set EntityProperty -> Bool) -> Set EntityProperty -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EntityProperty -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set EntityProperty -> Bool) -> Set EntityProperty -> Bool
forall a b. (a -> b) -> a -> b
$ Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties]
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"capabilities" Key -> Capabilities (ExerciseCost Text) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities) | Bool -> Bool
not (Bool -> Bool)
-> (Capabilities (ExerciseCost Text) -> Bool)
-> Capabilities (ExerciseCost Text)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Capability (ExerciseCost Text) -> Bool
forall k a. Map k a -> Bool
M.null (Map Capability (ExerciseCost Text) -> Bool)
-> (Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Capabilities (ExerciseCost Text) -> Bool)
-> Capabilities (ExerciseCost Text) -> Bool
forall a b. (a -> b) -> a -> b
$ Entity
e Entity
-> Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities]
loadEntities ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m EntityMap
loadEntities :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m EntityMap
loadEntities = do
let entityFile :: String
entityFile = String
"entities.yaml"
entityFailure :: LoadingFailure -> SystemFailure
entityFailure = Asset -> String -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
Entities) String
entityFile
String
fileName <- AssetData -> String -> m String
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Entities String
entityFile
[Entity]
decoded <-
(ParseException -> SystemFailure)
-> ThrowC ParseException m [Entity] -> m [Entity]
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow (LoadingFailure -> SystemFailure
entityFailure (LoadingFailure -> SystemFailure)
-> (ParseException -> LoadingFailure)
-> ParseException
-> SystemFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml) (ThrowC ParseException m [Entity] -> m [Entity])
-> (IO (Either ParseException [Entity])
-> ThrowC ParseException m [Entity])
-> IO (Either ParseException [Entity])
-> m [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ParseException [Entity] -> ThrowC ParseException m [Entity]
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither (Either ParseException [Entity]
-> ThrowC ParseException m [Entity])
-> (IO (Either ParseException [Entity])
-> ThrowC ParseException m (Either ParseException [Entity]))
-> IO (Either ParseException [Entity])
-> ThrowC ParseException m [Entity]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Either ParseException [Entity])
-> ThrowC ParseException m (Either ParseException [Entity])
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO) (IO (Either ParseException [Entity]) -> m [Entity])
-> IO (Either ParseException [Entity]) -> m [Entity]
forall a b. (a -> b) -> a -> b
$
String -> IO (Either ParseException [Entity])
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
fileName
(LoadingFailure -> SystemFailure)
-> ThrowC LoadingFailure m () -> m ()
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow LoadingFailure -> SystemFailure
entityFailure (ThrowC LoadingFailure m () -> m ())
-> ThrowC LoadingFailure m () -> m ()
forall a b. (a -> b) -> a -> b
$ Set WorldAttr -> [Entity] -> ThrowC LoadingFailure m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
Set WorldAttr -> [Entity] -> m ()
validateEntityAttrRefs (Map WorldAttr PreservableColor -> Set WorldAttr
forall k a. Map k a -> Set k
M.keysSet Map WorldAttr PreservableColor
worldAttributes) [Entity]
decoded
(LoadingFailure -> SystemFailure)
-> ThrowC LoadingFailure m EntityMap -> m EntityMap
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow LoadingFailure -> SystemFailure
entityFailure (ThrowC LoadingFailure m EntityMap -> m EntityMap)
-> ThrowC LoadingFailure m EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ [Entity] -> ThrowC LoadingFailure m EntityMap
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
[Entity] -> m EntityMap
buildEntityMap [Entity]
decoded
hashedLens :: (Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens :: forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> a
get Entity -> a -> Entity
set = (Entity -> a) -> (Entity -> a -> Entity) -> Lens Entity Entity a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Entity -> a
get (\Entity
e a
a -> Entity -> Entity
rehashEntity (Entity -> Entity) -> Entity -> Entity
forall a b. (a -> b) -> a -> b
$ Entity -> a -> Entity
set Entity
e a
a)
entityHash :: Getter Entity Int
entityHash :: Getter Entity Int
entityHash = (Entity -> Int) -> (Int -> f Int) -> Entity -> f Entity
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Entity -> Int
_entityHash
entityDisplay :: Lens' Entity Display
entityDisplay :: Lens' Entity Display
entityDisplay = (Entity -> Display)
-> (Entity -> Display -> Entity) -> Lens' Entity Display
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Display
_entityDisplay (\Entity
e Display
x -> Entity
e {_entityDisplay = x})
entityName :: Lens' Entity EntityName
entityName :: Lens' Entity Text
entityName = (Entity -> Text) -> (Entity -> Text -> Entity) -> Lens' Entity Text
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Text
_entityName (\Entity
e Text
x -> Entity
e {_entityName = x})
entityPlural :: Lens' Entity (Maybe Text)
entityPlural :: Lens' Entity (Maybe Text)
entityPlural = (Entity -> Maybe Text)
-> (Entity -> Maybe Text -> Entity) -> Lens' Entity (Maybe Text)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Text
_entityPlural (\Entity
e Maybe Text
x -> Entity
e {_entityPlural = x})
entityNameFor :: Int -> Getter Entity Text
entityNameFor :: Int -> Getter Entity Text
entityNameFor Int
1 = (Text -> f Text) -> Entity -> f Entity
Lens' Entity Text
entityName
entityNameFor Int
_ = (Entity -> Text) -> (Text -> f Text) -> Entity -> f Entity
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Entity -> Text) -> (Text -> f Text) -> Entity -> f Entity)
-> (Entity -> Text) -> (Text -> f Text) -> Entity -> f Entity
forall a b. (a -> b) -> a -> b
$ \Entity
e ->
case Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityPlural of
Just Text
pl -> Text
pl
Maybe Text
Nothing -> Text -> Text
plural (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName)
entityDescription :: Lens' Entity (Document Syntax)
entityDescription :: Lens' Entity (Document Syntax)
entityDescription = (Entity -> Document Syntax)
-> (Entity -> Document Syntax -> Entity)
-> Lens' Entity (Document Syntax)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Document Syntax
_entityDescription (\Entity
e Document Syntax
x -> Entity
e {_entityDescription = x})
entityTags :: Lens' Entity (Set Text)
entityTags :: Lens' Entity (Set Text)
entityTags = (Entity -> Set Text)
-> (Entity -> Set Text -> Entity) -> Lens' Entity (Set Text)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set Text
_entityTags (\Entity
e Set Text
x -> Entity
e {_entityTags = x})
entityOrientation :: Lens' Entity (Maybe Heading)
entityOrientation :: Lens' Entity (Maybe Heading)
entityOrientation = (Entity -> Maybe Heading)
-> (Entity -> Maybe Heading -> Entity)
-> Lens' Entity (Maybe Heading)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Heading
_entityOrientation (\Entity
e Maybe Heading
x -> Entity
e {_entityOrientation = x})
entityGrowth :: Lens' Entity (Maybe Growth)
entityGrowth :: Lens' Entity (Maybe Growth)
entityGrowth = (Entity -> Maybe Growth)
-> (Entity -> Maybe Growth -> Entity)
-> Lens' Entity (Maybe Growth)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Growth
_entityGrowth (\Entity
e Maybe Growth
x -> Entity
e {_entityGrowth = x})
entityCombustion :: Lens' Entity (Maybe Combustibility)
entityCombustion :: Lens' Entity (Maybe Combustibility)
entityCombustion = (Entity -> Maybe Combustibility)
-> (Entity -> Maybe Combustibility -> Entity)
-> Lens' Entity (Maybe Combustibility)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Combustibility
_entityCombustion (\Entity
e Maybe Combustibility
x -> Entity
e {_entityCombustion = x})
entityYields :: Lens' Entity (Maybe Text)
entityYields :: Lens' Entity (Maybe Text)
entityYields = (Entity -> Maybe Text)
-> (Entity -> Maybe Text -> Entity) -> Lens' Entity (Maybe Text)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Text
_entityYields (\Entity
e Maybe Text
x -> Entity
e {_entityYields = x})
entityProperties :: Lens' Entity (Set EntityProperty)
entityProperties :: Lens' Entity (Set EntityProperty)
entityProperties = (Entity -> Set EntityProperty)
-> (Entity -> Set EntityProperty -> Entity)
-> Lens' Entity (Set EntityProperty)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set EntityProperty
_entityProperties (\Entity
e Set EntityProperty
x -> Entity
e {_entityProperties = x})
hasProperty :: Entity -> EntityProperty -> Bool
hasProperty :: Entity -> EntityProperty -> Bool
hasProperty Entity
e EntityProperty
p = EntityProperty
p EntityProperty -> Set EntityProperty -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties)
entityCapabilities :: Lens' Entity (SingleEntityCapabilities EntityName)
entityCapabilities :: Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities = (Entity -> Capabilities (ExerciseCost Text))
-> (Entity -> Capabilities (ExerciseCost Text) -> Entity)
-> Lens' Entity (Capabilities (ExerciseCost Text))
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Capabilities (ExerciseCost Text)
_entityCapabilities (\Entity
e Capabilities (ExerciseCost Text)
x -> Entity
e {_entityCapabilities = x})
entityBiomes :: Lens' Entity (Set TerrainType)
entityBiomes :: Lens' Entity (Set TerrainType)
entityBiomes = (Entity -> Set TerrainType)
-> (Entity -> Set TerrainType -> Entity)
-> Lens' Entity (Set TerrainType)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set TerrainType
_entityBiomes (\Entity
e Set TerrainType
x -> Entity
e {_entityBiomes = x})
entityInventory :: Lens' Entity Inventory
entityInventory :: Lens' Entity Inventory
entityInventory = (Entity -> Inventory)
-> (Entity -> Inventory -> Entity) -> Lens' Entity Inventory
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Inventory
_entityInventory (\Entity
e Inventory
x -> Entity
e {_entityInventory = x})
data Inventory = Inventory
{
Inventory -> IntMap (Int, Entity)
counts :: IntMap (Count, Entity)
,
Inventory -> Map Text IntSet
byName :: Map Text IntSet
,
Inventory -> Int
inventoryHash :: Int
}
deriving (Int -> Inventory -> ShowS
[Inventory] -> ShowS
Inventory -> String
(Int -> Inventory -> ShowS)
-> (Inventory -> String)
-> ([Inventory] -> ShowS)
-> Show Inventory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inventory -> ShowS
showsPrec :: Int -> Inventory -> ShowS
$cshow :: Inventory -> String
show :: Inventory -> String
$cshowList :: [Inventory] -> ShowS
showList :: [Inventory] -> ShowS
Show, (forall x. Inventory -> Rep Inventory x)
-> (forall x. Rep Inventory x -> Inventory) -> Generic Inventory
forall x. Rep Inventory x -> Inventory
forall x. Inventory -> Rep Inventory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Inventory -> Rep Inventory x
from :: forall x. Inventory -> Rep Inventory x
$cto :: forall x. Rep Inventory x -> Inventory
to :: forall x. Rep Inventory x -> Inventory
Generic, Maybe Inventory
Value -> Parser [Inventory]
Value -> Parser Inventory
(Value -> Parser Inventory)
-> (Value -> Parser [Inventory])
-> Maybe Inventory
-> FromJSON Inventory
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Inventory
parseJSON :: Value -> Parser Inventory
$cparseJSONList :: Value -> Parser [Inventory]
parseJSONList :: Value -> Parser [Inventory]
$comittedField :: Maybe Inventory
omittedField :: Maybe Inventory
FromJSON, [Inventory] -> Value
[Inventory] -> Encoding
Inventory -> Bool
Inventory -> Value
Inventory -> Encoding
(Inventory -> Value)
-> (Inventory -> Encoding)
-> ([Inventory] -> Value)
-> ([Inventory] -> Encoding)
-> (Inventory -> Bool)
-> ToJSON Inventory
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Inventory -> Value
toJSON :: Inventory -> Value
$ctoEncoding :: Inventory -> Encoding
toEncoding :: Inventory -> Encoding
$ctoJSONList :: [Inventory] -> Value
toJSONList :: [Inventory] -> Value
$ctoEncodingList :: [Inventory] -> Encoding
toEncodingList :: [Inventory] -> Encoding
$comitField :: Inventory -> Bool
omitField :: Inventory -> Bool
ToJSON)
instance Hashable Inventory where
hash :: Inventory -> Int
hash = Inventory -> Int
inventoryHash
hashWithSalt :: Int -> Inventory -> Int
hashWithSalt Int
s = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int -> Int) -> (Inventory -> Int) -> Inventory -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> Int
inventoryHash
instance Eq Inventory where
== :: Inventory -> Inventory -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Inventory -> Int) -> Inventory -> Inventory -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Inventory -> Int
forall a. Hashable a => a -> Int
hash
lookup :: Entity -> Inventory -> Count
lookup :: Entity -> Inventory -> Int
lookup Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
_ Int
_) = Int -> ((Int, Entity) -> Int) -> Maybe (Int, Entity) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Entity) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Entity) -> Int) -> Maybe (Int, Entity) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs
lookupByName :: Text -> Inventory -> [Entity]
lookupByName :: Text -> Inventory -> [Entity]
lookupByName Text
name (Inventory IntMap (Int, Entity)
cs Map Text IntSet
byN Int
_) =
[Entity] -> (IntSet -> [Entity]) -> Maybe IntSet -> [Entity]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Int -> Entity) -> [Int] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Entity) -> Entity
forall a b. (a, b) -> b
snd ((Int, Entity) -> Entity)
-> (Int -> (Int, Entity)) -> Int -> Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap (Int, Entity)
cs IntMap (Int, Entity) -> Int -> (Int, Entity)
forall a. IntMap a -> Int -> a
IM.!)) ([Int] -> [Entity]) -> (IntSet -> [Int]) -> IntSet -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.elems) (Text -> Map Text IntSet -> Maybe IntSet
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Text
T.toLower Text
name) Map Text IntSet
byN)
countByName :: Text -> Inventory -> Count
countByName :: Text -> Inventory -> Int
countByName Text
name Inventory
inv =
Int -> (Entity -> Int) -> Maybe Entity -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Entity -> Inventory -> Int
`lookup` Inventory
inv) ([Entity] -> Maybe Entity
forall a. [a] -> Maybe a
listToMaybe (Text -> Inventory -> [Entity]
lookupByName Text
name Inventory
inv))
empty :: Inventory
empty :: Inventory
empty = IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory IntMap (Int, Entity)
forall a. IntMap a
IM.empty Map Text IntSet
forall k a. Map k a
M.empty Int
0
singleton :: Entity -> Inventory
singleton :: Entity -> Inventory
singleton = (Entity -> Inventory -> Inventory)
-> Inventory -> Entity -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Entity -> Inventory -> Inventory
insert Inventory
empty
insert :: Entity -> Inventory -> Inventory
insert :: Entity -> Inventory -> Inventory
insert = Int -> Entity -> Inventory -> Inventory
insertCount Int
1
fromList :: [Entity] -> Inventory
fromList :: [Entity] -> Inventory
fromList = (Inventory -> Entity -> Inventory)
-> Inventory -> [Entity] -> Inventory
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Entity -> Inventory -> Inventory)
-> Inventory -> Entity -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Entity -> Inventory -> Inventory
insert) Inventory
empty
fromElems :: [(Count, Entity)] -> Inventory
fromElems :: [(Int, Entity)] -> Inventory
fromElems = (Inventory -> (Int, Entity) -> Inventory)
-> Inventory -> [(Int, Entity)] -> Inventory
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Int, Entity) -> Inventory -> Inventory)
-> Inventory -> (Int, Entity) -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> Entity -> Inventory -> Inventory)
-> (Int, Entity) -> Inventory -> Inventory
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Entity -> Inventory -> Inventory
insertCount)) Inventory
empty
insertCount :: Count -> Entity -> Inventory -> Inventory
insertCount :: Int -> Entity -> Inventory -> Inventory
insertCount Int
k Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
byN Int
h) =
IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory
(((Int, Entity) -> (Int, Entity) -> (Int, Entity))
-> Int
-> (Int, Entity)
-> IntMap (Int, Entity)
-> IntMap (Int, Entity)
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith (\(Int
m, Entity
_) (Int
n, Entity
_) -> (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, Entity
e)) (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) (Int
k, Entity
e) IntMap (Int, Entity)
cs)
((IntSet -> IntSet -> IntSet)
-> Text -> IntSet -> Map Text IntSet -> Map Text IntSet
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith IntSet -> IntSet -> IntSet
IS.union (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName) (Int -> IntSet
IS.singleton (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash)) Map Text IntSet
byN)
(Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash))
where
extra :: Int
extra = if (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) Int -> IntMap (Int, Entity) -> Bool
forall a. Int -> IntMap a -> Bool
`IM.member` IntMap (Int, Entity)
cs then Int
0 else Int
1
contains :: Inventory -> Entity -> Bool
contains :: Inventory -> Entity -> Bool
contains Inventory
inv Entity
e = Entity -> Inventory -> Int
lookup Entity
e Inventory
inv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
contains0plus :: Entity -> Inventory -> Bool
contains0plus :: Entity -> Inventory -> Bool
contains0plus Entity
e = Maybe (Int, Entity) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Int, Entity) -> Bool)
-> (Inventory -> Maybe (Int, Entity)) -> Inventory -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) (IntMap (Int, Entity) -> Maybe (Int, Entity))
-> (Inventory -> IntMap (Int, Entity))
-> Inventory
-> Maybe (Int, Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> IntMap (Int, Entity)
counts
isSubsetOf :: Inventory -> Inventory -> Bool
isSubsetOf :: Inventory -> Inventory -> Bool
isSubsetOf Inventory
inv1 Inventory
inv2 = ((Int, Entity) -> Bool) -> [(Int, Entity)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Int
n, Entity
e) -> Entity -> Inventory -> Int
lookup Entity
e Inventory
inv2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) (Inventory -> [(Int, Entity)]
elems Inventory
inv1)
isEmpty :: Inventory -> Bool
isEmpty :: Inventory -> Bool
isEmpty = ((Int, Entity) -> Bool) -> [(Int, Entity)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> ((Int, Entity) -> Int) -> (Int, Entity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Entity)] -> Bool)
-> (Inventory -> [(Int, Entity)]) -> Inventory -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems
inventoryCapabilities :: Inventory -> MultiEntityCapabilities Entity EntityName
inventoryCapabilities :: Inventory -> MultiEntityCapabilities Entity Text
inventoryCapabilities = [Entity] -> MultiEntityCapabilities Entity Text
combineEntityCaps ([Entity] -> MultiEntityCapabilities Entity Text)
-> (Inventory -> [Entity])
-> Inventory
-> MultiEntityCapabilities Entity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [Entity]
nonzeroEntities
nonzeroEntities :: Inventory -> [Entity]
nonzeroEntities :: Inventory -> [Entity]
nonzeroEntities = ((Int, Entity) -> Entity) -> [(Int, Entity)] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd ([(Int, Entity)] -> [Entity])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> Bool) -> [(Int, Entity)] -> [(Int, Entity)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool) -> ((Int, Entity) -> Int) -> (Int, Entity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Entity)] -> [(Int, Entity)])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [(Int, Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems
extantElemsWithCapability :: Capability -> Inventory -> [Entity]
extantElemsWithCapability :: Capability -> Inventory -> [Entity]
extantElemsWithCapability Capability
cap =
(Entity -> Bool) -> [Entity] -> [Entity]
forall a. (a -> Bool) -> [a] -> [a]
filter (Capability -> Map Capability (ExerciseCost Text) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Capability
cap (Map Capability (ExerciseCost Text) -> Bool)
-> (Entity -> Map Capability (ExerciseCost Text)) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text))
-> (Entity -> Capabilities (ExerciseCost Text))
-> Entity
-> Map Capability (ExerciseCost Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity
-> Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)) ([Entity] -> [Entity])
-> (Inventory -> [Entity]) -> Inventory -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [Entity]
nonzeroEntities
entitiesByCapability :: Inventory -> Map Capability (NE.NonEmpty Entity)
entitiesByCapability :: Inventory -> Map Capability (NonEmpty Entity)
entitiesByCapability Inventory
inv =
[(Capability, Entity)] -> Map Capability (NonEmpty Entity)
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples [(Capability, Entity)]
entityCapabilityPairs
where
getCaps :: Entity -> [Capability]
getCaps = Map Capability (ExerciseCost Text) -> [Capability]
forall k a. Map k a -> [k]
M.keys (Map Capability (ExerciseCost Text) -> [Capability])
-> (Entity -> Map Capability (ExerciseCost Text))
-> Entity
-> [Capability]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text))
-> (Entity -> Capabilities (ExerciseCost Text))
-> Entity
-> Map Capability (ExerciseCost Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity
-> Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Capabilities (ExerciseCost Text))
Entity
(Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)
entityCapabilityPairs :: [(Capability, Entity)]
entityCapabilityPairs = ((Int, Entity) -> [(Capability, Entity)])
-> [(Int, Entity)] -> [(Capability, Entity)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\Entity
e -> (Capability -> (Capability, Entity))
-> [Capability] -> [(Capability, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (,Entity
e) ([Capability] -> [(Capability, Entity)])
-> [Capability] -> [(Capability, Entity)]
forall a b. (a -> b) -> a -> b
$ Entity -> [Capability]
getCaps Entity
e) (Entity -> [(Capability, Entity)])
-> ((Int, Entity) -> Entity)
-> (Int, Entity)
-> [(Capability, Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd) ([(Int, Entity)] -> [(Capability, Entity)])
-> [(Int, Entity)] -> [(Capability, Entity)]
forall a b. (a -> b) -> a -> b
$ Inventory -> [(Int, Entity)]
elems Inventory
inv
delete :: Entity -> Inventory -> Inventory
delete :: Entity -> Inventory -> Inventory
delete = Int -> Entity -> Inventory -> Inventory
deleteCount Int
1
deleteCount :: Count -> Entity -> Inventory -> Inventory
deleteCount :: Int -> Entity -> Inventory -> Inventory
deleteCount Int
k Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
byN Int
h) = IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory IntMap (Int, Entity)
cs' Map Text IntSet
byN Int
h'
where
m :: Int
m = ((Int, Entity) -> Int
forall a b. (a, b) -> a
fst ((Int, Entity) -> Int) -> Maybe (Int, Entity) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs) Maybe Int -> Int -> Int
forall a. Maybe a -> a -> a
? Int
0
cs' :: IntMap (Int, Entity)
cs' = ((Int, Entity) -> (Int, Entity))
-> Int -> IntMap (Int, Entity) -> IntMap (Int, Entity)
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (Int, Entity) -> (Int, Entity)
forall a. (Int, a) -> (Int, a)
removeCount (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs
h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
k Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash)
removeCount :: (Count, a) -> (Count, a)
removeCount :: forall a. (Int, a) -> (Int, a)
removeCount (Int
n, a
a) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k), a
a)
deleteAll :: Entity -> Inventory -> Inventory
deleteAll :: Entity -> Inventory -> Inventory
deleteAll Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
byN Int
h) =
IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory
(((Int, Entity) -> (Int, Entity))
-> Int -> IntMap (Int, Entity) -> IntMap (Int, Entity)
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust ((Int -> Int) -> (Int, Entity) -> (Int, Entity)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Int -> Int
forall a b. a -> b -> a
const Int
0)) (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs)
Map Text IntSet
byN
(Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash))
where
n :: Int
n = ((Int, Entity) -> Int
forall a b. (a, b) -> a
fst ((Int, Entity) -> Int) -> Maybe (Int, Entity) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs) Maybe Int -> Int -> Int
forall a. Maybe a -> a -> a
? Int
0
elems :: Inventory -> [(Count, Entity)]
elems :: Inventory -> [(Int, Entity)]
elems (Inventory IntMap (Int, Entity)
cs Map Text IntSet
_ Int
_) = IntMap (Int, Entity) -> [(Int, Entity)]
forall a. IntMap a -> [a]
IM.elems IntMap (Int, Entity)
cs
union :: Inventory -> Inventory -> Inventory
union :: Inventory -> Inventory -> Inventory
union (Inventory IntMap (Int, Entity)
cs1 Map Text IntSet
byN1 Int
h1) (Inventory IntMap (Int, Entity)
cs2 Map Text IntSet
byN2 Int
h2) =
IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory
(((Int, Entity) -> (Int, Entity) -> (Int, Entity))
-> IntMap (Int, Entity)
-> IntMap (Int, Entity)
-> IntMap (Int, Entity)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith (\(Int
c1, Entity
e) (Int
c2, Entity
_) -> (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2, Entity
e)) IntMap (Int, Entity)
cs1 IntMap (Int, Entity)
cs2)
((IntSet -> IntSet -> IntSet)
-> Map Text IntSet -> Map Text IntSet -> Map Text IntSet
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith IntSet -> IntSet -> IntSet
IS.union Map Text IntSet
byN1 Map Text IntSet
byN2)
(Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
common)
where
common :: Int
common = (Int -> Int -> Int) -> Int -> IntSet -> Int
forall a. (a -> Int -> a) -> a -> IntSet -> a
IS.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (IntSet -> Int) -> IntSet -> Int
forall a b. (a -> b) -> a -> b
$ IntMap (Int, Entity) -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap (Int, Entity)
cs1 IntSet -> IntSet -> IntSet
`IS.intersection` IntMap (Int, Entity) -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap (Int, Entity)
cs2
difference :: Inventory -> Inventory -> Inventory
difference :: Inventory -> Inventory -> Inventory
difference Inventory
inv1 = (Inventory -> (Int, Entity) -> Inventory)
-> Inventory -> [(Int, Entity)] -> Inventory
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Int, Entity) -> Inventory -> Inventory)
-> Inventory -> (Int, Entity) -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> Entity -> Inventory -> Inventory)
-> (Int, Entity) -> Inventory -> Inventory
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Entity -> Inventory -> Inventory
deleteCount)) Inventory
inv1 ([(Int, Entity)] -> Inventory)
-> (Inventory -> [(Int, Entity)]) -> Inventory -> Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems