{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Swarm.Game.Entity (
EntityProperty (..),
GrowthTime (..),
defaultGrowthTime,
Entity,
mkEntity,
entityDisplay,
entityName,
entityPlural,
entityNameFor,
entityDescription,
entityOrientation,
entityGrowth,
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,
insert,
insertCount,
delete,
deleteCount,
deleteAll,
union,
difference,
) where
import Control.Arrow ((&&&))
import Control.Lens (Getter, Lens', lens, to, view, (^.), _2)
import Control.Monad.IO.Class
import Data.Bifunctor (bimap, first)
import Data.Char (toLower)
import Data.Function (on)
import Data.Hashable
import Data.Int (Int64)
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.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)
import Data.Set.Lens (setOf)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml
import GHC.Generics (Generic)
import Linear (V2)
import Swarm.Game.Display
import Swarm.Language.Capability
import Swarm.Util (dataNotFound, getDataFileNameSafe, plural, reflow, (?))
import Swarm.Util.Yaml
import Text.Read (readMaybe)
import Witch
import Prelude hiding (lookup)
data EntityProperty
=
Unwalkable
|
Portable
|
Growable
|
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 => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown entity property " forall a. [a] -> [a] -> [a]
++ forall source target. From source target => source -> target
from 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 Entity = Entity
{
Entity -> Count
_entityHash :: Int
,
Entity -> Display
_entityDisplay :: Display
,
Entity -> Text
_entityName :: Text
,
Entity -> Maybe Text
_entityPlural :: Maybe Text
,
Entity -> [Text]
_entityDescription :: [Text]
,
Entity -> Maybe (V2 Int64)
_entityOrientation :: Maybe (V2 Int64)
,
Entity -> Maybe GrowthTime
_entityGrowth :: Maybe GrowthTime
,
Entity -> Maybe Text
_entityYields :: Maybe Text
,
Entity -> Set EntityProperty
_entityProperties :: Set EntityProperty
,
Entity -> [Capability]
_entityCapabilities :: [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 [Text]
descr Maybe (V2 Int64)
orient Maybe GrowthTime
grow Maybe Text
yld Set EntityProperty
props [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` [Text]
descr
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Maybe (V2 Int64)
orient
forall a. Hashable a => Count -> a -> Count
`hashWithSalt` Maybe GrowthTime
grow
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` [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 ->
[Text] ->
[EntityProperty] ->
[Capability] ->
Entity
mkEntity :: Display
-> Text -> [Text] -> [EntityProperty] -> [Capability] -> Entity
mkEntity Display
disp Text
nm [Text]
descr [EntityProperty]
props [Capability]
caps =
Entity -> Entity
rehashEntity forall a b. (a -> b) -> a -> b
$ Count
-> Display
-> Text
-> Maybe Text
-> [Text]
-> Maybe (V2 Int64)
-> Maybe GrowthTime
-> Maybe Text
-> Set EntityProperty
-> [Capability]
-> Inventory
-> Entity
Entity Count
0 Display
disp Text
nm forall a. Maybe a
Nothing [Text]
descr 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) [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) (Map Capability [Entity]
c1 forall a. Semigroup a => a -> a -> a
<> 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 :: [Entity] -> EntityMap
buildEntityMap :: [Entity] -> EntityMap
buildEntityMap [Entity]
es =
EntityMap
{ entitiesByName :: Map Text Entity
entitiesByName = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a b. (a -> b) -> a -> b
$ [Entity]
es
, 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]) (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity [Capability]
entityCapabilities)) forall a b. (a -> b) -> a -> b
$ [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
-> [Text]
-> Maybe (V2 Int64)
-> Maybe GrowthTime
-> Maybe Text
-> Set EntityProperty
-> [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
<*> (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
reflow forall (f :: * -> *) a b. Functor 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
"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 (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 => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown entity: " forall a. [a] -> [a] -> [a]
++ forall source target. From source target => source -> target
from @Text 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 [Text]
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 (V2 Int64))
entityOrientation) | forall a. Maybe a -> Bool
isJust (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe (V2 Int64))
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 [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 [Capability]
entityCapabilities]
loadEntities :: MonadIO m => m (Either Text EntityMap)
loadEntities :: forall (m :: * -> *). MonadIO m => m (Either Text EntityMap)
loadEntities = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let f :: String
f = String
"entities.yaml"
Maybe String
mayFileName <- String -> IO (Maybe String)
getDataFileNameSafe String
f
case Maybe String
mayFileName of
Maybe String
Nothing -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
dataNotFound String
f
Just String
fileName -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall source target. From source target => source -> target
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> String
prettyPrintParseException) [Entity] -> EntityMap
buildEntityMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
fileName
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 Text
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 [Text]
entityDescription :: Lens' Entity [Text]
entityDescription = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> [Text]
_entityDescription (\Entity
e [Text]
x -> Entity
e {_entityDescription :: [Text]
_entityDescription = [Text]
x})
entityOrientation :: Lens' Entity (Maybe (V2 Int64))
entityOrientation :: Lens' Entity (Maybe (V2 Int64))
entityOrientation = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe (V2 Int64)
_entityOrientation (\Entity
e Maybe (V2 Int64)
x -> Entity
e {_entityOrientation :: Maybe (V2 Int64)
_entityOrientation = Maybe (V2 Int64)
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})
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 [Capability]
entityCapabilities :: Lens' Entity [Capability]
entityCapabilities = forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> [Capability]
_entityCapabilities (\Entity
e [Capability]
x -> Entity
e {_entityCapabilities :: [Capability]
_entityCapabilities = [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 a s. Getting (Set a) s a -> s -> Set a
setOf (forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Inventory -> [(Count, Entity)]
elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity [Capability]
entityCapabilities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
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