{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Swarm.Game.Entity (
EntityName,
EntityProperty (..),
GrowthTime (..),
defaultGrowthTime,
Combustibility (..),
defaultCombustibility,
Entity,
mkEntity,
entityDisplay,
entityName,
entityPlural,
entityNameFor,
entityDescription,
entityOrientation,
entityGrowth,
entityCombustion,
entityYields,
entityProperties,
hasProperty,
entityCapabilities,
entityInventory,
entityHash,
EntityMap (..),
buildEntityMap,
loadEntities,
lookupEntityName,
deviceForCap,
Inventory,
Count,
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.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 ((<=<))
import Data.Bifunctor (first)
import Data.Char (toLower)
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 (fromMaybe, isJust, listToMaybe)
import Data.Set (Set)
import Data.Set qualified as Set (fromList, member, toList, unions)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml
import GHC.Generics (Generic)
import Swarm.Game.Display
import Swarm.Game.Failure
import Swarm.Game.Location
import Swarm.Game.ResourceLoading (getDataFileNameSafe)
import Swarm.Language.Capability
import Swarm.Language.Syntax (Syntax)
import Swarm.Language.Text.Markdown (Document, docToText)
import Swarm.Util (binTuples, failT, findDup, plural, (?))
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
|
Portable
|
Opaque
|
Growable
|
Combustible
|
Infinite
|
Liquid
|
Known
deriving (EntityProperty -> EntityProperty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityProperty -> EntityProperty -> Bool
$c/= :: EntityProperty -> EntityProperty -> Bool
== :: EntityProperty -> EntityProperty -> Bool
$c== :: EntityProperty -> EntityProperty -> Bool
Eq, Eq 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
min :: EntityProperty -> EntityProperty -> EntityProperty
$cmin :: EntityProperty -> EntityProperty -> EntityProperty
max :: EntityProperty -> EntityProperty -> EntityProperty
$cmax :: EntityProperty -> EntityProperty -> EntityProperty
>= :: EntityProperty -> EntityProperty -> Bool
$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
compare :: EntityProperty -> EntityProperty -> Ordering
$ccompare :: EntityProperty -> EntityProperty -> Ordering
Ord, Count -> EntityProperty -> ShowS
[EntityProperty] -> ShowS
EntityProperty -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityProperty] -> ShowS
$cshowList :: [EntityProperty] -> ShowS
show :: EntityProperty -> String
$cshow :: EntityProperty -> String
showsPrec :: Count -> EntityProperty -> ShowS
$cshowsPrec :: Count -> EntityProperty -> ShowS
Show, ReadPrec [EntityProperty]
ReadPrec EntityProperty
Count -> ReadS EntityProperty
ReadS [EntityProperty]
forall a.
(Count -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EntityProperty]
$creadListPrec :: ReadPrec [EntityProperty]
readPrec :: ReadPrec EntityProperty
$creadPrec :: ReadPrec EntityProperty
readList :: ReadS [EntityProperty]
$creadList :: ReadS [EntityProperty]
readsPrec :: Count -> ReadS EntityProperty
$creadsPrec :: Count -> ReadS EntityProperty
Read, Count -> EntityProperty
EntityProperty -> Count
EntityProperty -> [EntityProperty]
EntityProperty -> EntityProperty
EntityProperty -> EntityProperty -> [EntityProperty]
EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
forall a.
(a -> a)
-> (a -> a)
-> (Count -> a)
-> (a -> Count)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
$cenumFromThenTo :: EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
enumFromTo :: EntityProperty -> EntityProperty -> [EntityProperty]
$cenumFromTo :: EntityProperty -> EntityProperty -> [EntityProperty]
enumFromThen :: EntityProperty -> EntityProperty -> [EntityProperty]
$cenumFromThen :: EntityProperty -> EntityProperty -> [EntityProperty]
enumFrom :: EntityProperty -> [EntityProperty]
$cenumFrom :: EntityProperty -> [EntityProperty]
fromEnum :: EntityProperty -> Count
$cfromEnum :: EntityProperty -> Count
toEnum :: Count -> EntityProperty
$ctoEnum :: Count -> EntityProperty
pred :: EntityProperty -> EntityProperty
$cpred :: EntityProperty -> EntityProperty
succ :: EntityProperty -> EntityProperty
$csucc :: EntityProperty -> EntityProperty
Enum, EntityProperty
forall a. a -> a -> Bounded a
maxBound :: EntityProperty
$cmaxBound :: EntityProperty
minBound :: EntityProperty
$cminBound :: EntityProperty
Bounded, 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
$cto :: forall x. Rep EntityProperty x -> EntityProperty
$cfrom :: forall x. EntityProperty -> Rep EntityProperty x
Generic, Eq EntityProperty
Count -> EntityProperty -> Count
EntityProperty -> Count
forall a.
Eq a -> (Count -> a -> Count) -> (a -> Count) -> Hashable a
hash :: EntityProperty -> Count
$chash :: EntityProperty -> Count
hashWithSalt :: Count -> EntityProperty -> Count
$chashWithSalt :: Count -> EntityProperty -> Count
Hashable)
instance ToJSON EntityProperty where
toJSON :: EntityProperty -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance FromJSON EntityProperty where
parseJSON :: Value -> Parser EntityProperty
parseJSON = 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 forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toTitle forall a b. (a -> b) -> a -> b
$ Text
t of
Just EntityProperty
c -> forall (m :: * -> *) a. Monad m => a -> m a
return EntityProperty
c
Maybe EntityProperty
Nothing -> forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown entity property", Text
t]
newtype GrowthTime = GrowthTime (Integer, Integer)
deriving (GrowthTime -> GrowthTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrowthTime -> GrowthTime -> Bool
$c/= :: GrowthTime -> GrowthTime -> Bool
== :: GrowthTime -> GrowthTime -> Bool
$c== :: GrowthTime -> GrowthTime -> Bool
Eq, Eq 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
min :: GrowthTime -> GrowthTime -> GrowthTime
$cmin :: GrowthTime -> GrowthTime -> GrowthTime
max :: GrowthTime -> GrowthTime -> GrowthTime
$cmax :: GrowthTime -> GrowthTime -> GrowthTime
>= :: GrowthTime -> GrowthTime -> Bool
$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
compare :: GrowthTime -> GrowthTime -> Ordering
$ccompare :: GrowthTime -> GrowthTime -> Ordering
Ord, Count -> GrowthTime -> ShowS
[GrowthTime] -> ShowS
GrowthTime -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrowthTime] -> ShowS
$cshowList :: [GrowthTime] -> ShowS
show :: GrowthTime -> String
$cshow :: GrowthTime -> String
showsPrec :: Count -> GrowthTime -> ShowS
$cshowsPrec :: Count -> GrowthTime -> ShowS
Show, ReadPrec [GrowthTime]
ReadPrec GrowthTime
Count -> ReadS GrowthTime
ReadS [GrowthTime]
forall a.
(Count -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GrowthTime]
$creadListPrec :: ReadPrec [GrowthTime]
readPrec :: ReadPrec GrowthTime
$creadPrec :: ReadPrec GrowthTime
readList :: ReadS [GrowthTime]
$creadList :: ReadS [GrowthTime]
readsPrec :: Count -> ReadS GrowthTime
$creadsPrec :: Count -> ReadS GrowthTime
Read, 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
$cto :: forall x. Rep GrowthTime x -> GrowthTime
$cfrom :: forall x. GrowthTime -> Rep GrowthTime x
Generic, Eq GrowthTime
Count -> GrowthTime -> Count
GrowthTime -> Count
forall a.
Eq a -> (Count -> a -> Count) -> (a -> Count) -> Hashable a
hash :: GrowthTime -> Count
$chash :: GrowthTime -> Count
hashWithSalt :: Count -> GrowthTime -> Count
$chashWithSalt :: Count -> GrowthTime -> Count
Hashable, Value -> Parser [GrowthTime]
Value -> Parser GrowthTime
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GrowthTime]
$cparseJSONList :: Value -> Parser [GrowthTime]
parseJSON :: Value -> Parser GrowthTime
$cparseJSON :: Value -> Parser GrowthTime
FromJSON, [GrowthTime] -> Encoding
[GrowthTime] -> Value
GrowthTime -> Encoding
GrowthTime -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GrowthTime] -> Encoding
$ctoEncodingList :: [GrowthTime] -> Encoding
toJSONList :: [GrowthTime] -> Value
$ctoJSONList :: [GrowthTime] -> Value
toEncoding :: GrowthTime -> Encoding
$ctoEncoding :: GrowthTime -> Encoding
toJSON :: GrowthTime -> Value
$ctoJSON :: GrowthTime -> Value
ToJSON)
defaultGrowthTime :: GrowthTime
defaultGrowthTime :: GrowthTime
defaultGrowthTime = (Integer, Integer) -> GrowthTime
GrowthTime (Integer
100, Integer
200)
data Combustibility = Combustibility
{ Combustibility -> Double
ignition :: Double
, Combustibility -> (Integer, Integer)
duration :: (Integer, Integer)
, Combustibility -> Maybe Text
product :: Maybe EntityName
}
deriving (Combustibility -> Combustibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Combustibility -> Combustibility -> Bool
$c/= :: Combustibility -> Combustibility -> Bool
== :: Combustibility -> Combustibility -> Bool
$c== :: Combustibility -> Combustibility -> Bool
Eq, Eq 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
min :: Combustibility -> Combustibility -> Combustibility
$cmin :: Combustibility -> Combustibility -> Combustibility
max :: Combustibility -> Combustibility -> Combustibility
$cmax :: Combustibility -> Combustibility -> Combustibility
>= :: Combustibility -> Combustibility -> Bool
$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
compare :: Combustibility -> Combustibility -> Ordering
$ccompare :: Combustibility -> Combustibility -> Ordering
Ord, Count -> Combustibility -> ShowS
[Combustibility] -> ShowS
Combustibility -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Combustibility] -> ShowS
$cshowList :: [Combustibility] -> ShowS
show :: Combustibility -> String
$cshow :: Combustibility -> String
showsPrec :: Count -> Combustibility -> ShowS
$cshowsPrec :: Count -> Combustibility -> ShowS
Show, ReadPrec [Combustibility]
ReadPrec Combustibility
Count -> ReadS Combustibility
ReadS [Combustibility]
forall a.
(Count -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Combustibility]
$creadListPrec :: ReadPrec [Combustibility]
readPrec :: ReadPrec Combustibility
$creadPrec :: ReadPrec Combustibility
readList :: ReadS [Combustibility]
$creadList :: ReadS [Combustibility]
readsPrec :: Count -> ReadS Combustibility
$creadsPrec :: Count -> ReadS Combustibility
Read, 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
$cto :: forall x. Rep Combustibility x -> Combustibility
$cfrom :: forall x. Combustibility -> Rep Combustibility x
Generic, Eq Combustibility
Count -> Combustibility -> Count
Combustibility -> Count
forall a.
Eq a -> (Count -> a -> Count) -> (a -> Count) -> Hashable a
hash :: Combustibility -> Count
$chash :: Combustibility -> Count
hashWithSalt :: Count -> Combustibility -> Count
$chashWithSalt :: Count -> Combustibility -> Count
Hashable, Value -> Parser [Combustibility]
Value -> Parser Combustibility
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Combustibility]
$cparseJSONList :: Value -> Parser [Combustibility]
parseJSON :: Value -> Parser Combustibility
$cparseJSON :: Value -> Parser Combustibility
FromJSON, [Combustibility] -> Encoding
[Combustibility] -> Value
Combustibility -> Encoding
Combustibility -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Combustibility] -> Encoding
$ctoEncodingList :: [Combustibility] -> Encoding
toJSONList :: [Combustibility] -> Value
$ctoJSONList :: [Combustibility] -> Value
toEncoding :: Combustibility -> Encoding
$ctoEncoding :: Combustibility -> Encoding
toJSON :: Combustibility -> Value
$ctoJSON :: Combustibility -> Value
ToJSON)
defaultCombustibility :: Combustibility
defaultCombustibility :: Combustibility
defaultCombustibility = Double -> (Integer, Integer) -> Maybe Text -> Combustibility
Combustibility Double
0.5 (Integer
100, Integer
200) (forall a. a -> Maybe a
Just Text
"ash")
data Entity = Entity
{ Entity -> Count
_entityHash :: Int
, Entity -> Display
_entityDisplay :: Display
, Entity -> Text
_entityName :: EntityName
, Entity -> Maybe Text
_entityPlural :: Maybe Text
, Entity -> Document Syntax
_entityDescription :: Document Syntax
, Entity -> Maybe Heading
_entityOrientation :: Maybe Heading
, Entity -> Maybe GrowthTime
_entityGrowth :: Maybe GrowthTime
, Entity -> Maybe Combustibility
_entityCombustion :: Maybe Combustibility
, Entity -> Maybe Text
_entityYields :: Maybe Text
, Entity -> Set EntityProperty
_entityProperties :: Set EntityProperty
, Entity -> Set Capability
_entityCapabilities :: Set Capability
, Entity -> Inventory
_entityInventory :: Inventory
}
deriving (Count -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entity] -> ShowS
$cshowList :: [Entity] -> ShowS
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Count -> Entity -> ShowS
$cshowsPrec :: Count -> Entity -> ShowS
Show, 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
$cto :: forall x. Rep Entity x -> Entity
$cfrom :: forall x. Entity -> Rep Entity x
Generic)
instance Hashable Entity where
hashWithSalt :: Count -> Entity -> Count
hashWithSalt Count
s (Entity Count
_ Display
disp Text
nm Maybe Text
pl Document Syntax
descr Maybe Heading
orient Maybe GrowthTime
grow Maybe Combustibility
combust Maybe Text
yld Set EntityProperty
props Set Capability
caps Inventory
inv) =
Count
s
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Display
disp
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Text
nm
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Maybe Text
pl
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` forall a. PrettyPrec a => Document a -> Text
docToText Document Syntax
descr
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Maybe Heading
orient
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Maybe GrowthTime
grow
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Maybe Combustibility
combust
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Maybe Text
yld
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Set EntityProperty
props
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Set Capability
caps
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Inventory
inv
instance Eq Entity where
== :: Entity -> Entity -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entity -> Count
_entityHash
instance Ord Entity where
compare :: Entity -> Entity -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entity -> Count
_entityHash
rehashEntity :: Entity -> Entity
rehashEntity :: Entity -> Entity
rehashEntity Entity
e = Entity
e {_entityHash :: Count
_entityHash = forall a. Hashable a => a -> Count
hash Entity
e}
mkEntity ::
Display ->
Text ->
Document Syntax ->
[EntityProperty] ->
[Capability] ->
Entity
mkEntity :: Display
-> Text
-> Document Syntax
-> [EntityProperty]
-> [Capability]
-> Entity
mkEntity Display
disp Text
nm Document Syntax
descr [EntityProperty]
props [Capability]
caps =
Entity -> Entity
rehashEntity forall a b. (a -> b) -> a -> b
$
Count
-> Display
-> Text
-> Maybe Text
-> Document Syntax
-> Maybe Heading
-> Maybe GrowthTime
-> Maybe Combustibility
-> Maybe Text
-> Set EntityProperty
-> Set Capability
-> Inventory
-> Entity
Entity
Count
0
Display
disp
Text
nm
forall a. Maybe a
Nothing
Document Syntax
descr
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
(forall a. Ord a => [a] -> Set a
Set.fromList [EntityProperty]
props)
(forall a. Ord a => [a] -> Set a
Set.fromList [Capability]
caps)
Inventory
empty
data EntityMap = EntityMap
{ EntityMap -> Map Text Entity
entitiesByName :: Map Text Entity
, EntityMap -> Map Capability [Entity]
entitiesByCap :: Map Capability [Entity]
}
deriving (EntityMap -> EntityMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityMap -> EntityMap -> Bool
$c/= :: EntityMap -> EntityMap -> Bool
== :: EntityMap -> EntityMap -> Bool
$c== :: EntityMap -> EntityMap -> Bool
Eq, Count -> EntityMap -> ShowS
[EntityMap] -> ShowS
EntityMap -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityMap] -> ShowS
$cshowList :: [EntityMap] -> ShowS
show :: EntityMap -> String
$cshow :: EntityMap -> String
showsPrec :: Count -> EntityMap -> ShowS
$cshowsPrec :: Count -> EntityMap -> ShowS
Show, 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
$cto :: forall x. Rep EntityMap x -> EntityMap
$cfrom :: forall x. EntityMap -> Rep EntityMap x
Generic, Value -> Parser [EntityMap]
Value -> Parser EntityMap
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EntityMap]
$cparseJSONList :: Value -> Parser [EntityMap]
parseJSON :: Value -> Parser EntityMap
$cparseJSON :: Value -> Parser EntityMap
FromJSON, [EntityMap] -> Encoding
[EntityMap] -> Value
EntityMap -> Encoding
EntityMap -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EntityMap] -> Encoding
$ctoEncodingList :: [EntityMap] -> Encoding
toJSONList :: [EntityMap] -> Value
$ctoJSONList :: [EntityMap] -> Value
toEncoding :: EntityMap -> Encoding
$ctoEncoding :: EntityMap -> Encoding
toJSON :: EntityMap -> Value
$ctoJSON :: EntityMap -> Value
ToJSON)
instance Semigroup EntityMap where
EntityMap Map Text Entity
n1 Map Capability [Entity]
c1 <> :: EntityMap -> EntityMap -> EntityMap
<> EntityMap Map Text Entity
n2 Map Capability [Entity]
c2 = Map Text Entity -> Map Capability [Entity] -> EntityMap
EntityMap (Map Text Entity
n1 forall a. Semigroup a => a -> a -> a
<> Map Text Entity
n2) (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map Capability [Entity]
c1 Map Capability [Entity]
c2)
instance Monoid EntityMap where
mempty :: EntityMap
mempty = Map Text Entity -> Map Capability [Entity] -> EntityMap
EntityMap forall k a. Map k a
M.empty forall k a. Map k a
M.empty
mappend :: EntityMap -> EntityMap -> EntityMap
mappend = forall a. Semigroup a => a -> a -> a
(<>)
lookupEntityName :: Text -> EntityMap -> Maybe Entity
lookupEntityName :: Text -> EntityMap -> Maybe Entity
lookupEntityName Text
nm = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
nm forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap -> Map Text Entity
entitiesByName
deviceForCap :: Capability -> EntityMap -> [Entity]
deviceForCap :: Capability -> EntityMap -> [Entity]
deviceForCap Capability
cap = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Capability
cap forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap -> Map Capability [Entity]
entitiesByCap
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 forall a. Ord a => [a] -> Maybe a
findDup (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, Entity)]
namedEntities) of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Text
duped -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ AssetData -> Text -> LoadingFailure
Duplicate AssetData
Entities Text
duped
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
EntityMap
{ entitiesByName :: Map Text Entity
entitiesByName = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Entity)]
namedEntities
, entitiesByCap :: Map Capability [Entity]
entitiesByCap = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Entity
e -> forall a b. (a -> b) -> [a] -> [b]
map (,[Entity
e]) (forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities)) forall a b. (a -> b) -> a -> b
$ [Entity]
es
}
where
namedEntities :: [(Text, Entity)]
namedEntities = forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity Text
entityName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [Entity]
es
instance FromJSON Entity where
parseJSON :: Value -> Parser Entity
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Entity" forall a b. (a -> b) -> a -> b
$ \Object
v ->
Entity -> Entity
rehashEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Count
-> Display
-> Text
-> Maybe Text
-> Document Syntax
-> Maybe Heading
-> Maybe GrowthTime
-> Maybe Combustibility
-> Maybe Text
-> Set EntityProperty
-> Set Capability
-> Inventory
-> Entity
Entity Count
0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"display"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"plural"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"orientation"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"growth"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"combustion"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"yields"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"properties" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"capabilities" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Inventory
empty
)
instance FromJSONE EntityMap Entity where
parseJSONE :: Value -> ParserE EntityMap Entity
parseJSONE = forall e a. String -> (Text -> ParserE e a) -> Value -> ParserE e a
withTextE String
"entity name" forall a b. (a -> b) -> a -> b
$ \Text
name ->
forall e (f :: * -> *) a. (e -> f a) -> With e f a
E forall a b. (a -> b) -> a -> b
$ \EntityMap
em -> case Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em of
Maybe Entity
Nothing -> forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown entity:", Text
name]
Just Entity
e -> forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e
instance ToJSON Entity where
toJSON :: Entity -> Value
toJSON Entity
e =
[Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
[ Key
"display" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Display
entityDisplay)
, Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)
, Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Document Syntax)
entityDescription)
]
forall a. [a] -> [a] -> [a]
++ [Key
"plural" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Text)
entityPlural) | forall a. Maybe a -> Bool
isJust (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Text)
entityPlural)]
forall a. [a] -> [a] -> [a]
++ [Key
"orientation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Heading)
entityOrientation) | forall a. Maybe a -> Bool
isJust (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Heading)
entityOrientation)]
forall a. [a] -> [a] -> [a]
++ [Key
"growth" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe GrowthTime)
entityGrowth) | forall a. Maybe a -> Bool
isJust (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe GrowthTime)
entityGrowth)]
forall a. [a] -> [a] -> [a]
++ [Key
"yields" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Text)
entityYields) | forall a. Maybe a -> Bool
isJust (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Text)
entityYields)]
forall a. [a] -> [a] -> [a]
++ [Key
"properties" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set EntityProperty)
entityProperties) | Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set EntityProperty)
entityProperties]
forall a. [a] -> [a] -> [a]
++ [Key
"capabilities" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities) | Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
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 <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Entities String
entityFile
[Entity]
decoded <-
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow (LoadingFailure -> SystemFailure
entityFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO) forall a b. (a -> b) -> a -> b
$
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
fileName
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow LoadingFailure -> SystemFailure
entityFailure forall a b. (a -> b) -> a -> b
$ 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 = 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 forall a b. (a -> b) -> a -> b
$ Entity -> a -> Entity
set Entity
e a
a)
entityHash :: Getter Entity Int
entityHash :: Getter Entity Count
entityHash = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Entity -> Count
_entityHash
entityDisplay :: Lens' Entity Display
entityDisplay :: Lens' Entity Display
entityDisplay = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Display
_entityDisplay (\Entity
e Display
x -> Entity
e {_entityDisplay :: Display
_entityDisplay = Display
x})
entityName :: Lens' Entity EntityName
entityName :: Lens' Entity Text
entityName = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Text
_entityName (\Entity
e Text
x -> Entity
e {_entityName :: Text
_entityName = Text
x})
entityPlural :: Lens' Entity (Maybe Text)
entityPlural :: Lens' Entity (Maybe Text)
entityPlural = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Text
_entityPlural (\Entity
e Maybe Text
x -> Entity
e {_entityPlural :: Maybe Text
_entityPlural = Maybe Text
x})
entityNameFor :: Int -> Getter Entity Text
entityNameFor :: Count -> Getter Entity Text
entityNameFor Count
1 = Lens' Entity Text
entityName
entityNameFor Count
_ = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \Entity
e ->
case Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Text)
entityPlural of
Just Text
pl -> Text
pl
Maybe Text
Nothing -> Text -> Text
plural (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)
entityDescription :: Lens' Entity (Document Syntax)
entityDescription :: Lens' Entity (Document Syntax)
entityDescription = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Document Syntax
_entityDescription (\Entity
e Document Syntax
x -> Entity
e {_entityDescription :: Document Syntax
_entityDescription = Document Syntax
x})
entityOrientation :: Lens' Entity (Maybe Heading)
entityOrientation :: Lens' Entity (Maybe Heading)
entityOrientation = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Heading
_entityOrientation (\Entity
e Maybe Heading
x -> Entity
e {_entityOrientation :: Maybe Heading
_entityOrientation = Maybe Heading
x})
entityGrowth :: Lens' Entity (Maybe GrowthTime)
entityGrowth :: Lens' Entity (Maybe GrowthTime)
entityGrowth = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe GrowthTime
_entityGrowth (\Entity
e Maybe GrowthTime
x -> Entity
e {_entityGrowth :: Maybe GrowthTime
_entityGrowth = Maybe GrowthTime
x})
entityCombustion :: Lens' Entity (Maybe Combustibility)
entityCombustion :: Lens' Entity (Maybe Combustibility)
entityCombustion = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Combustibility
_entityCombustion (\Entity
e Maybe Combustibility
x -> Entity
e {_entityCombustion :: Maybe Combustibility
_entityCombustion = Maybe Combustibility
x})
entityYields :: Lens' Entity (Maybe Text)
entityYields :: Lens' Entity (Maybe Text)
entityYields = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Text
_entityYields (\Entity
e Maybe Text
x -> Entity
e {_entityYields :: Maybe Text
_entityYields = Maybe Text
x})
entityProperties :: Lens' Entity (Set EntityProperty)
entityProperties :: Lens' Entity (Set EntityProperty)
entityProperties = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set EntityProperty
_entityProperties (\Entity
e Set EntityProperty
x -> Entity
e {_entityProperties :: Set EntityProperty
_entityProperties = Set EntityProperty
x})
hasProperty :: Entity -> EntityProperty -> Bool
hasProperty :: Entity -> EntityProperty -> Bool
hasProperty Entity
e EntityProperty
p = EntityProperty
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set EntityProperty)
entityProperties)
entityCapabilities :: Lens' Entity (Set Capability)
entityCapabilities :: Lens' Entity (Set Capability)
entityCapabilities = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set Capability
_entityCapabilities (\Entity
e Set Capability
x -> Entity
e {_entityCapabilities :: Set Capability
_entityCapabilities = Set Capability
x})
entityInventory :: Lens' Entity Inventory
entityInventory :: Lens' Entity Inventory
entityInventory = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Inventory
_entityInventory (\Entity
e Inventory
x -> Entity
e {_entityInventory :: Inventory
_entityInventory = Inventory
x})
type Count = Int
data Inventory = Inventory
{
Inventory -> IntMap (Count, Entity)
counts :: IntMap (Count, Entity)
,
Inventory -> Map Text IntSet
byName :: Map Text IntSet
,
Inventory -> Count
inventoryHash :: Int
}
deriving (Count -> Inventory -> ShowS
[Inventory] -> ShowS
Inventory -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inventory] -> ShowS
$cshowList :: [Inventory] -> ShowS
show :: Inventory -> String
$cshow :: Inventory -> String
showsPrec :: Count -> Inventory -> ShowS
$cshowsPrec :: Count -> Inventory -> ShowS
Show, 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
$cto :: forall x. Rep Inventory x -> Inventory
$cfrom :: forall x. Inventory -> Rep Inventory x
Generic, Value -> Parser [Inventory]
Value -> Parser Inventory
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Inventory]
$cparseJSONList :: Value -> Parser [Inventory]
parseJSON :: Value -> Parser Inventory
$cparseJSON :: Value -> Parser Inventory
FromJSON, [Inventory] -> Encoding
[Inventory] -> Value
Inventory -> Encoding
Inventory -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Inventory] -> Encoding
$ctoEncodingList :: [Inventory] -> Encoding
toJSONList :: [Inventory] -> Value
$ctoJSONList :: [Inventory] -> Value
toEncoding :: Inventory -> Encoding
$ctoEncoding :: Inventory -> Encoding
toJSON :: Inventory -> Value
$ctoJSON :: Inventory -> Value
ToJSON)
instance Hashable Inventory where
hash :: Inventory -> Count
hash = Inventory -> Count
inventoryHash
hashWithSalt :: Count -> Inventory -> Count
hashWithSalt Count
s = forall a. Hashable a => Count -> a -> Count
hashWithSalt Count
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> Count
inventoryHash
instance Eq Inventory where
== :: Inventory -> Inventory -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Hashable a => a -> Count
hash
lookup :: Entity -> Inventory -> Count
lookup :: Entity -> Inventory -> Count
lookup Entity
e (Inventory IntMap (Count, Entity)
cs Map Text IntSet
_ Count
_) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Count
0 forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Count -> IntMap a -> Maybe a
IM.lookup (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) IntMap (Count, Entity)
cs
lookupByName :: Text -> Inventory -> [Entity]
lookupByName :: Text -> Inventory -> [Entity]
lookupByName Text
name (Inventory IntMap (Count, Entity)
cs Map Text IntSet
byN Count
_) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap (Count, Entity)
cs forall a. IntMap a -> Count -> a
IM.!)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Count]
IS.elems) (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 -> Count
countByName Text
name Inventory
inv =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Count
0 (Entity -> Inventory -> Count
`lookup` Inventory
inv) (forall a. [a] -> Maybe a
listToMaybe (Text -> Inventory -> [Entity]
lookupByName Text
name Inventory
inv))
empty :: Inventory
empty :: Inventory
empty = IntMap (Count, Entity) -> Map Text IntSet -> Count -> Inventory
Inventory forall a. IntMap a
IM.empty forall k a. Map k a
M.empty Count
0
singleton :: Entity -> Inventory
singleton :: Entity -> Inventory
singleton = 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 = Count -> Entity -> Inventory -> Inventory
insertCount Count
1
fromList :: [Entity] -> Inventory
fromList :: [Entity] -> Inventory
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Entity -> Inventory -> Inventory
insert) Inventory
empty
fromElems :: [(Count, Entity)] -> Inventory
fromElems :: [(Count, Entity)] -> Inventory
fromElems = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Count -> Entity -> Inventory -> Inventory
insertCount)) Inventory
empty
insertCount :: Count -> Entity -> Inventory -> Inventory
insertCount :: Count -> Entity -> Inventory -> Inventory
insertCount Count
k Entity
e (Inventory IntMap (Count, Entity)
cs Map Text IntSet
byN Count
h) =
IntMap (Count, Entity) -> Map Text IntSet -> Count -> Inventory
Inventory
(forall a. (a -> a -> a) -> Count -> a -> IntMap a -> IntMap a
IM.insertWith (\(Count
m, Entity
_) (Count
n, Entity
_) -> (Count
m forall a. Num a => a -> a -> a
+ Count
n, Entity
e)) (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) (Count
k, Entity
e) IntMap (Count, Entity)
cs)
(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 forall a b. (a -> b) -> a -> b
$ Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) (Count -> IntSet
IS.singleton (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash)) Map Text IntSet
byN)
(Count
h forall a. Num a => a -> a -> a
+ (Count
k forall a. Num a => a -> a -> a
+ Count
extra) forall a. Num a => a -> a -> a
* (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash))
where
extra :: Count
extra = if (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) forall a. Count -> IntMap a -> Bool
`IM.member` IntMap (Count, Entity)
cs then Count
0 else Count
1
contains :: Inventory -> Entity -> Bool
contains :: Inventory -> Entity -> Bool
contains Inventory
inv Entity
e = Entity -> Inventory -> Count
lookup Entity
e Inventory
inv forall a. Ord a => a -> a -> Bool
> Count
0
contains0plus :: Entity -> Inventory -> Bool
contains0plus :: Entity -> Inventory -> Bool
contains0plus Entity
e = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Count -> IntMap a -> Maybe a
IM.lookup (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> IntMap (Count, Entity)
counts
isSubsetOf :: Inventory -> Inventory -> Bool
isSubsetOf :: Inventory -> Inventory -> Bool
isSubsetOf Inventory
inv1 Inventory
inv2 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Count
n, Entity
e) -> Entity -> Inventory -> Count
lookup Entity
e Inventory
inv2 forall a. Ord a => a -> a -> Bool
>= Count
n) (Inventory -> [(Count, Entity)]
elems Inventory
inv1)
isEmpty :: Inventory -> Bool
isEmpty :: Inventory -> Bool
isEmpty = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== Count
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Count, Entity)]
elems
inventoryCapabilities :: Inventory -> Set Capability
inventoryCapabilities :: Inventory -> Set Capability
inventoryCapabilities = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [Entity]
nonzeroEntities
nonzeroEntities :: Inventory -> [Entity]
nonzeroEntities :: Inventory -> [Entity]
nonzeroEntities = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Count
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Count, Entity)]
elems
extantElemsWithCapability :: Capability -> Inventory -> [Entity]
extantElemsWithCapability :: Capability -> Inventory -> [Entity]
extantElemsWithCapability Capability
cap =
forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
Set.member Capability
cap forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities)) 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 =
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples [(Capability, Entity)]
entityCapabilityPairs
where
getCaps :: Entity -> [Capability]
getCaps = forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities)
entityCapabilityPairs :: [(Capability, Entity)]
entityCapabilityPairs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\Entity
e -> forall a b. (a -> b) -> [a] -> [b]
map (,Entity
e) forall a b. (a -> b) -> a -> b
$ Entity -> [Capability]
getCaps Entity
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ Inventory -> [(Count, Entity)]
elems Inventory
inv
delete :: Entity -> Inventory -> Inventory
delete :: Entity -> Inventory -> Inventory
delete = Count -> Entity -> Inventory -> Inventory
deleteCount Count
1
deleteCount :: Count -> Entity -> Inventory -> Inventory
deleteCount :: Count -> Entity -> Inventory -> Inventory
deleteCount Count
k Entity
e (Inventory IntMap (Count, Entity)
cs Map Text IntSet
byN Count
h) = IntMap (Count, Entity) -> Map Text IntSet -> Count -> Inventory
Inventory IntMap (Count, Entity)
cs' Map Text IntSet
byN Count
h'
where
m :: Count
m = (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Count -> IntMap a -> Maybe a
IM.lookup (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) IntMap (Count, Entity)
cs) forall a. Maybe a -> a -> a
? Count
0
cs' :: IntMap (Count, Entity)
cs' = forall a. (a -> a) -> Count -> IntMap a -> IntMap a
IM.adjust forall a. (Count, a) -> (Count, a)
removeCount (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) IntMap (Count, Entity)
cs
h' :: Count
h' = Count
h forall a. Num a => a -> a -> a
- forall a. Ord a => a -> a -> a
min Count
k Count
m forall a. Num a => a -> a -> a
* (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash)
removeCount :: (Count, a) -> (Count, a)
removeCount :: forall a. (Count, a) -> (Count, a)
removeCount (Count
n, a
a) = (forall a. Ord a => a -> a -> a
max Count
0 (Count
n forall a. Num a => a -> a -> a
- Count
k), a
a)
deleteAll :: Entity -> Inventory -> Inventory
deleteAll :: Entity -> Inventory -> Inventory
deleteAll Entity
e (Inventory IntMap (Count, Entity)
cs Map Text IntSet
byN Count
h) =
IntMap (Count, Entity) -> Map Text IntSet -> Count -> Inventory
Inventory
(forall a. (a -> a) -> Count -> IntMap a -> IntMap a
IM.adjust (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const Count
0)) (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) IntMap (Count, Entity)
cs)
Map Text IntSet
byN
(Count
h forall a. Num a => a -> a -> a
- Count
n forall a. Num a => a -> a -> a
* (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash))
where
n :: Count
n = (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Count -> IntMap a -> Maybe a
IM.lookup (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) IntMap (Count, Entity)
cs) forall a. Maybe a -> a -> a
? Count
0
elems :: Inventory -> [(Count, Entity)]
elems :: Inventory -> [(Count, Entity)]
elems (Inventory IntMap (Count, Entity)
cs Map Text IntSet
_ Count
_) = forall a. IntMap a -> [a]
IM.elems IntMap (Count, Entity)
cs
union :: Inventory -> Inventory -> Inventory
union :: Inventory -> Inventory -> Inventory
union (Inventory IntMap (Count, Entity)
cs1 Map Text IntSet
byN1 Count
h1) (Inventory IntMap (Count, Entity)
cs2 Map Text IntSet
byN2 Count
h2) =
IntMap (Count, Entity) -> Map Text IntSet -> Count -> Inventory
Inventory
(forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith (\(Count
c1, Entity
e) (Count
c2, Entity
_) -> (Count
c1 forall a. Num a => a -> a -> a
+ Count
c2, Entity
e)) IntMap (Count, Entity)
cs1 IntMap (Count, Entity)
cs2)
(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)
(Count
h1 forall a. Num a => a -> a -> a
+ Count
h2 forall a. Num a => a -> a -> a
- Count
common)
where
common :: Count
common = forall a. (a -> Count -> a) -> a -> IntSet -> a
IS.foldl' forall a. Num a => a -> a -> a
(+) Count
0 forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> IntSet
IM.keysSet IntMap (Count, Entity)
cs1 IntSet -> IntSet -> IntSet
`IS.intersection` forall a. IntMap a -> IntSet
IM.keysSet IntMap (Count, Entity)
cs2
difference :: Inventory -> Inventory -> Inventory
difference :: Inventory -> Inventory -> Inventory
difference Inventory
inv1 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Count -> Entity -> Inventory -> Inventory
deleteCount)) Inventory
inv1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Count, Entity)]
elems