{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      :  Swarm.Game.Entity
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- An 'Entity' represents an object that exists in the world.  Each
-- entity has a way to be displayed, some metadata such as a name and
-- description, some properties, and possibly an inventory of other
-- entities.
--
-- This module also defines the 'Inventory' type, since the two types
-- are mutually recursive (an inventory contains entities, which can
-- have inventories).
module Swarm.Game.Entity (
  -- * Properties
  EntityProperty (..),
  GrowthTime (..),
  defaultGrowthTime,

  -- * Entities
  Entity,
  mkEntity,

  -- ** Lenses
  -- $lenses
  entityDisplay,
  entityName,
  entityPlural,
  entityNameFor,
  entityDescription,
  entityOrientation,
  entityGrowth,
  entityYields,
  entityProperties,
  hasProperty,
  entityCapabilities,
  entityInventory,
  entityHash,

  -- ** Entity map
  EntityMap (..),
  buildEntityMap,
  loadEntities,
  lookupEntityName,
  deviceForCap,

  -- * Inventories
  Inventory,
  Count,

  -- ** Construction
  empty,
  singleton,
  fromList,
  fromElems,

  -- ** Lookup
  lookup,
  lookupByName,
  countByName,
  contains,
  contains0plus,
  elems,
  isSubsetOf,
  isEmpty,
  inventoryCapabilities,

  -- ** Modification
  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)

------------------------------------------------------------
-- Properties
------------------------------------------------------------

-- | Various properties that an entity can have, which affect how
--   robots can interact with it.
data EntityProperty
  = -- | Robots can't move onto a cell containing this entity.
    Unwalkable
  | -- | Robots can pick this up (via 'Swarm.Language.Syntax.Grab' or 'Swarm.Language.Syntax.Harvest').
    Portable
  | -- | Regrows from a seed after it is harvested.
    Growable
  | -- | Regenerates infinitely when grabbed or harvested.
    Infinite
  | -- | Robots drown if they walk on this without a boat.
    Liquid
  | -- | Robots automatically know what this is without having to scan it.
    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

-- | How long an entity takes to regrow.  This represents the minimum
--   and maximum amount of time taken by one growth stage (there are
--   two stages).  The actual time for each stage will be chosen
--   uniformly at random between these two values.
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)

------------------------------------------------------------
-- Entity
------------------------------------------------------------

-- | A record to hold information about an entity.
--
--   The constructor for 'Entity' is intentionally not exported.  To
--   construct one manually, use the 'mkEntity' function.
--
--   There are two main constraints on the way entities are stored:
--
--   1. We want to be able to easily modify an entity in one
--      particular cell of the world (for example, painting one
--      tree red).
--   2. In an inventory, we want to store identical entities only
--      once, along with a count.
--
--   We could get (2) nicely by storing only names of entities, and
--   having a global lookup table from names to entity records.
--   However, storing names instead of actual entity records in the
--   world makes (1) more complex: every time we modify an entity we
--   would have to generate a fresh name for the modified entity and
--   add it to the global entity table.  This approach is also
--   annoying because it means we can't just uses lenses to drill down
--   into the properties of an entity in the world or in an inventory,
--   but have to do an intermediate lookup in the global (mutable!)
--   entity table.
--
--   On the other hand, if we just store entity records everywhere,
--   checking them for equality becomes expensive.  Having an
--   inventory be a map with entities themselves as keys sounds awful.
--
--   The solution we adopt here is that every @Entity@ record carries
--   along a hash value of all the other fields.  We just assume that
--   these hashes are unique (a collision is of course possible but
--   extremely unlikely).  Entities can be efficiently compared just
--   by looking at their hashes; they can be stored in a map using
--   hash values as keys; and we provide lenses which automatically
--   recompute the hash value when modifying a field of an entity
--   record.  Note also that world storage is still efficient, too:
--   thanks to referential transparency, in practice most of the
--   entities stored in the world that are the same will literally
--   just be stored as pointers to the same shared record.
data Entity = Entity
  { -- | A hash value computed from the other fields
    Entity -> Count
_entityHash :: Int
  , -- | The way this entity should be displayed on the world map.
    Entity -> Display
_entityDisplay :: Display
  , -- | The name of the entity, used /e.g./ in an inventory display.
    Entity -> Text
_entityName :: Text
  , -- | The plural of the entity name, in case it is irregular.  If
    --   this field is @Nothing@, default pluralization heuristics
    --   will be used (see 'plural').
    Entity -> Maybe Text
_entityPlural :: Maybe Text
  , -- | A longer-form description. Each 'Text' value is one
    --   paragraph.
    Entity -> [Text]
_entityDescription :: [Text]
  , -- | The entity's orientation (if it has one).  For example, when
    --   a robot moves, it moves in the direction of its orientation.
    Entity -> Maybe (V2 Int64)
_entityOrientation :: Maybe (V2 Int64)
  , -- | If this entity grows, how long does it take?
    Entity -> Maybe GrowthTime
_entityGrowth :: Maybe GrowthTime
  , -- | The name of a different entity obtained when this entity is
    -- grabbed.
    Entity -> Maybe Text
_entityYields :: Maybe Text
  , -- | Properties of the entity.
    Entity -> Set EntityProperty
_entityProperties :: Set EntityProperty
  , -- | Capabilities provided by this entity.
    Entity -> [Capability]
_entityCapabilities :: [Capability]
  , -- | Inventory of other entities held by this entity.
    Entity -> Inventory
_entityInventory :: Inventory
  }
  -- Note that an entity does not have a location, because the
  -- location of an entity is implicit in the way it is stored (by
  -- location).

  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)

-- | The @Hashable@ instance for @Entity@ ignores the cached hash
--   value and simply combines the other fields.
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

-- | Entities are compared by hash for efficiency.
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

-- | Entities are compared by hash for efficiency.
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

-- | Recompute an entity's hash value.
rehashEntity :: Entity -> Entity
rehashEntity :: Entity -> Entity
rehashEntity Entity
e = Entity
e {_entityHash :: Count
_entityHash = forall a. Hashable a => a -> Count
hash Entity
e}

-- | Create an entity with no orientation, an empty inventory,
--   providing no capabilities (automatically filling in the hash
--   value).
mkEntity ::
  -- | Display
  Display ->
  -- | Entity name
  Text ->
  -- | Entity description
  [Text] ->
  -- | Properties
  [EntityProperty] ->
  -- | Capabilities
  [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

------------------------------------------------------------
-- Entity map
------------------------------------------------------------

-- | An 'EntityMap' is a data structure containing all the loaded
--   entities, allowing them to be looked up either by name or by what
--   capabilities they provide (if any).
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
(<>)

-- | Find an entity with the given name.
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

-- | Find all entities which are devices that provide the given
--   capability.
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

-- | Build an 'EntityMap' from a list of entities.  The idea is that
--   this will be called once at startup, when loading the entities
--   from a file; see 'loadEntities'.
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
    }

------------------------------------------------------------
-- Serialization
------------------------------------------------------------

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
          )

-- | If we have access to an 'EntityMap', we can parse the name of an
--   'Entity' as a string and look it up in the map.
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]

-- | Load entities from a data file called @entities.yaml@, producing
--   either an 'EntityMap' or a pretty-printed parse error.
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

------------------------------------------------------------
-- Entity lenses
------------------------------------------------------------

-- $lenses
-- Our own custom lenses which properly recompute the cached hash
-- value each time something gets updated.  See
-- https://byorgey.wordpress.com/2021/09/17/automatically-updated-cached-views-with-lens/
-- for the approach used here.

-- | Make a lens for Entity that recomputes the hash after setting.
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)

-- | Get the hash of an entity.  Note that this is a getter, not a
--   lens; the "Swarm.Game.Entity" module carefully maintains some
--   internal invariants ensuring that hashes work properly, and by
--   golly, no one else is going to mess that up.
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

-- | The 'Display' explaining how to draw this entity in the world display.
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})

-- | The name of the entity.
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})

-- | The irregular plural version of the entity's name, if there is
--   one.
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})

-- | Get a version of the entity's name appropriate to the
--   number---the singular name for 1, and a plural name for any other
--   number.  The plural name is obtained either by looking it up if
--   irregular, or by applying standard heuristics otherwise.
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)

-- | A longer, free-form description of the entity.  Each 'Text' value
--   represents a paragraph.
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})

-- | The direction this entity is facing (if it has one).
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})

-- | How long this entity takes to grow, if it regrows.
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})

-- | The name of a different entity yielded when this entity is
--   grabbed, if any.
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})

-- | The properties enjoyed by this entity.
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})

-- | Test whether an entity has a certain property.
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)

-- | The capabilities this entity provides when installed.
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})

-- | The inventory of other entities carried by this entity.
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})

------------------------------------------------------------
-- Inventory
------------------------------------------------------------

-- | A convenient synonym to remind us when an 'Int' is supposed to
--   represent /how many/ of something we have.
type Count = Int

-- | An inventory is really just a bag/multiset of entities.  That is,
--   it contains some entities, along with the number of times each
--   occurs.  Entities can be looked up directly, or by name.
data Inventory = Inventory
  { -- Main map
    Inventory -> IntMap (Count, Entity)
counts :: IntMap (Count, Entity)
  , -- Mirrors the main map; just caching the ability to look up by
    -- name.
    Inventory -> Map Text IntSet
byName :: Map Text IntSet
  , -- Cached hash of the inventory, using a homomorphic hashing scheme
    -- (see https://github.com/swarm-game/swarm/issues/229).
    --
    -- Invariant: equal to Sum_{(k,e) \in counts} (k+1) * (e ^. entityHash).
    -- The k+1 is so the hash distinguishes between having a 0 count of something
    -- and not having it as a key in the map at all.
    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
  -- Just return cached hash value.
  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

-- | Inventories are compared by hash for efficiency.
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

-- | Look up an entity in an inventory, returning the number of copies
--   contained.
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

-- | Look up an entity by name in an inventory, returning a list of
--   matching entities.  Note, if this returns some entities, it does
--   *not* mean we necessarily have any in our inventory!  It just
--   means we *know about* them.  If you want to know whether you have
--   any, use 'lookup' and see whether the resulting 'Count' is
--   positive, or just use 'countByName' in the first place.
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)

-- | Look up an entity by name and see how many there are in the
--   inventory.  If there are multiple entities with the same name, it
--   just picks the first one returned from 'lookupByName'.
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))

-- | The empty inventory.
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

-- | Create an inventory containing one entity.
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 an entity into an inventory.  If the inventory already
--   contains this entity, then only its count will be incremented.
insert :: Entity -> Inventory -> Inventory
insert :: Entity -> Inventory -> Inventory
insert = Count -> Entity -> Inventory -> Inventory
insertCount Count
1

-- | Create an inventory from a list of entities.
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

-- | Create an inventory from a list of entities and their counts.
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

-- | Insert a certain number of copies of an entity into an inventory.
--   If the inventory already contains this entity, then only its
--   count will be incremented.
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)) -- homomorphic hashing
 where
  -- Include the hash of an entity once just for "knowing about" it;
  -- then include the hash once per actual copy of the entity.  In
  -- other words, having k copies of e in the inventory contributes
  -- (k+1)*(e ^. entityHash) to the inventory hash.  The reason for
  -- doing this is so that the inventory hash changes even when we
  -- insert 0 copies of something, since having 0 copies of something
  -- is different than not having it as a key at all; having 0 copies
  -- signals that we at least "know about" the entity.
  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

-- | Check whether an inventory contains at least one of a given entity.
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

-- | Check whether an inventory has an entry for entity (used by robots).
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

-- | Check if the first inventory is a subset of the second.
--   Note that entities with a count of 0 are ignored.
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)

-- | Check whether an inventory is empty, meaning that it contains 0
--   total entities (although it may still /know about/ some entities, that
--   is, have them as keys with a count of 0).
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

-- | Compute the set of capabilities provided by the devices in an inventory.
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 a single copy of a certain entity from an inventory.
delete :: Entity -> Inventory -> Inventory
delete :: Entity -> Inventory -> Inventory
delete = Count -> Entity -> Inventory -> Inventory
deleteCount Count
1

-- | Delete a specified number of copies of an entity from an inventory.
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)

-- | Delete all copies of a certain entity from an inventory.
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

-- | Get the entities in an inventory and their associated counts.
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 two inventories.
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
  -- Need to subtract off the sum of the hashes in common, because
  -- of the way each entity with count k contributes (k+1) times its
  -- hash.  So if the two inventories share an entity e, just adding their
  -- hashes would mean e now contributes (k+2) times its hash.
  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

-- | Subtract the second inventory from the first.
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