{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Object that exists in the world
--
-- 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 (
  -- * Entity properties
  EntityName,
  EntityProperty (..),
  GrowthTime (..),
  GrowthSpread (..),
  Growth (..),
  defaultGrowth,
  Combustibility (..),
  defaultCombustibility,

  -- * Entities
  Entity,
  mkEntity,

  -- ** Fields
  -- $lenses
  entityDisplay,
  entityName,
  entityPlural,
  entityNameFor,
  entityDescription,
  entityTags,
  entityOrientation,
  entityGrowth,
  entityCombustion,
  entityYields,
  entityProperties,
  hasProperty,
  entityCapabilities,
  entityBiomes,
  entityInventory,
  entityHash,

  -- ** Entity map
  EntityMap (..),
  buildEntityMap,
  lookupEntityE,
  validateEntityAttrRefs,
  loadEntities,
  allEntities,
  lookupEntityName,
  devicesForCap,

  -- * Inventories
  Inventory,

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

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

  -- ** Modification
  insert,
  insertCount,
  delete,
  deleteCount,
  deleteAll,
  union,
  difference,
) where

import Control.Algebra (Has)
import Control.Applicative ((<|>))
import Control.Arrow ((&&&))
import Control.Carrier.Throw.Either (liftEither)
import Control.Effect.Lift (Lift, sendIO)
import Control.Effect.Throw (Throw, throwError)
import Control.Lens (Getter, Lens', lens, to, view, (^.))
import Control.Monad (forM_, unless, (<=<))
import Data.Bifunctor (first)
import Data.Char (toLower)
import Data.Either.Extra (maybeToEither)
import Data.Function (on)
import Data.Hashable
import Data.IntMap (IntMap)
import Data.IntMap qualified as IM
import Data.IntSet (IntSet)
import Data.IntSet qualified as IS
import Data.List (foldl')
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (isJust, listToMaybe)
import Data.Set (Set)
import Data.Set qualified as Set (fromList, member)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml
import GHC.Generics (Generic)
import Swarm.Game.Device
import Swarm.Game.Display
import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
import Swarm.Game.Entity.Cosmetic.Assignment (worldAttributes)
import Swarm.Game.Failure
import Swarm.Game.Ingredients
import Swarm.Game.Location
import Swarm.Game.ResourceLoading (getDataFileNameSafe)
import Swarm.Game.Terrain (TerrainType)
import Swarm.Language.Capability
import Swarm.Language.Syntax (Syntax)
import Swarm.Language.Text.Markdown (Document, docToText)
import Swarm.Util (binTuples, failT, findDup, plural, quote, (?))
import Swarm.Util.Effect (withThrow)
import Swarm.Util.Yaml
import Text.Read (readMaybe)
import Witch
import Prelude hiding (lookup)

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

-- | A type representing entity names, currently a synonym for 'Text'.
--   In the future it is conceivable that it might become more complex.
type EntityName = Text

-- | 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').
    Pickable
  | -- | Robots can 'Swarm.Language.Syntax.Push' this
    Pushable
  | -- | Obstructs the view of robots that attempt to "scout"
    Opaque
  | -- | Regrows from a seed after it is harvested.
    Growable
  | -- | Can burn when ignited (either via 'Swarm.Language.Syntax.Ignite' or by
    --   an adjacent burning entity).
    Combustible
  | -- | 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
(EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool) -> Eq EntityProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityProperty -> EntityProperty -> Bool
== :: EntityProperty -> EntityProperty -> Bool
$c/= :: EntityProperty -> EntityProperty -> Bool
/= :: EntityProperty -> EntityProperty -> Bool
Eq, Eq EntityProperty
Eq EntityProperty =>
(EntityProperty -> EntityProperty -> Ordering)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> Bool)
-> (EntityProperty -> EntityProperty -> EntityProperty)
-> (EntityProperty -> EntityProperty -> EntityProperty)
-> Ord EntityProperty
EntityProperty -> EntityProperty -> Bool
EntityProperty -> EntityProperty -> Ordering
EntityProperty -> EntityProperty -> EntityProperty
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EntityProperty -> EntityProperty -> Ordering
compare :: EntityProperty -> EntityProperty -> Ordering
$c< :: EntityProperty -> EntityProperty -> Bool
< :: EntityProperty -> EntityProperty -> Bool
$c<= :: EntityProperty -> EntityProperty -> Bool
<= :: EntityProperty -> EntityProperty -> Bool
$c> :: EntityProperty -> EntityProperty -> Bool
> :: EntityProperty -> EntityProperty -> Bool
$c>= :: EntityProperty -> EntityProperty -> Bool
>= :: EntityProperty -> EntityProperty -> Bool
$cmax :: EntityProperty -> EntityProperty -> EntityProperty
max :: EntityProperty -> EntityProperty -> EntityProperty
$cmin :: EntityProperty -> EntityProperty -> EntityProperty
min :: EntityProperty -> EntityProperty -> EntityProperty
Ord, Int -> EntityProperty -> ShowS
[EntityProperty] -> ShowS
EntityProperty -> String
(Int -> EntityProperty -> ShowS)
-> (EntityProperty -> String)
-> ([EntityProperty] -> ShowS)
-> Show EntityProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityProperty -> ShowS
showsPrec :: Int -> EntityProperty -> ShowS
$cshow :: EntityProperty -> String
show :: EntityProperty -> String
$cshowList :: [EntityProperty] -> ShowS
showList :: [EntityProperty] -> ShowS
Show, ReadPrec [EntityProperty]
ReadPrec EntityProperty
Int -> ReadS EntityProperty
ReadS [EntityProperty]
(Int -> ReadS EntityProperty)
-> ReadS [EntityProperty]
-> ReadPrec EntityProperty
-> ReadPrec [EntityProperty]
-> Read EntityProperty
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EntityProperty
readsPrec :: Int -> ReadS EntityProperty
$creadList :: ReadS [EntityProperty]
readList :: ReadS [EntityProperty]
$creadPrec :: ReadPrec EntityProperty
readPrec :: ReadPrec EntityProperty
$creadListPrec :: ReadPrec [EntityProperty]
readListPrec :: ReadPrec [EntityProperty]
Read, Int -> EntityProperty
EntityProperty -> Int
EntityProperty -> [EntityProperty]
EntityProperty -> EntityProperty
EntityProperty -> EntityProperty -> [EntityProperty]
EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
(EntityProperty -> EntityProperty)
-> (EntityProperty -> EntityProperty)
-> (Int -> EntityProperty)
-> (EntityProperty -> Int)
-> (EntityProperty -> [EntityProperty])
-> (EntityProperty -> EntityProperty -> [EntityProperty])
-> (EntityProperty -> EntityProperty -> [EntityProperty])
-> (EntityProperty
    -> EntityProperty -> EntityProperty -> [EntityProperty])
-> Enum EntityProperty
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EntityProperty -> EntityProperty
succ :: EntityProperty -> EntityProperty
$cpred :: EntityProperty -> EntityProperty
pred :: EntityProperty -> EntityProperty
$ctoEnum :: Int -> EntityProperty
toEnum :: Int -> EntityProperty
$cfromEnum :: EntityProperty -> Int
fromEnum :: EntityProperty -> Int
$cenumFrom :: EntityProperty -> [EntityProperty]
enumFrom :: EntityProperty -> [EntityProperty]
$cenumFromThen :: EntityProperty -> EntityProperty -> [EntityProperty]
enumFromThen :: EntityProperty -> EntityProperty -> [EntityProperty]
$cenumFromTo :: EntityProperty -> EntityProperty -> [EntityProperty]
enumFromTo :: EntityProperty -> EntityProperty -> [EntityProperty]
$cenumFromThenTo :: EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
enumFromThenTo :: EntityProperty
-> EntityProperty -> EntityProperty -> [EntityProperty]
Enum, EntityProperty
EntityProperty -> EntityProperty -> Bounded EntityProperty
forall a. a -> a -> Bounded a
$cminBound :: EntityProperty
minBound :: EntityProperty
$cmaxBound :: EntityProperty
maxBound :: EntityProperty
Bounded, (forall x. EntityProperty -> Rep EntityProperty x)
-> (forall x. Rep EntityProperty x -> EntityProperty)
-> Generic EntityProperty
forall x. Rep EntityProperty x -> EntityProperty
forall x. EntityProperty -> Rep EntityProperty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EntityProperty -> Rep EntityProperty x
from :: forall x. EntityProperty -> Rep EntityProperty x
$cto :: forall x. Rep EntityProperty x -> EntityProperty
to :: forall x. Rep EntityProperty x -> EntityProperty
Generic, Eq EntityProperty
Eq EntityProperty =>
(Int -> EntityProperty -> Int)
-> (EntityProperty -> Int) -> Hashable EntityProperty
Int -> EntityProperty -> Int
EntityProperty -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EntityProperty -> Int
hashWithSalt :: Int -> EntityProperty -> Int
$chash :: EntityProperty -> Int
hash :: EntityProperty -> Int
Hashable)

instance ToJSON EntityProperty where
  toJSON :: EntityProperty -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (EntityProperty -> Text) -> EntityProperty -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall source target. From source target => source -> target
from (String -> Text)
-> (EntityProperty -> String) -> EntityProperty -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> (EntityProperty -> String) -> EntityProperty -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityProperty -> String
forall a. Show a => a -> String
show

instance FromJSON EntityProperty where
  parseJSON :: Value -> Parser EntityProperty
parseJSON = String
-> (Text -> Parser EntityProperty)
-> Value
-> Parser EntityProperty
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"EntityProperty" Text -> Parser EntityProperty
tryRead
   where
    tryRead :: Text -> Parser EntityProperty
    tryRead :: Text -> Parser EntityProperty
tryRead Text
t = case String -> Maybe EntityProperty
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe EntityProperty)
-> (Text -> String) -> Text -> Maybe EntityProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall source target. From source target => source -> target
from (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toTitle (Text -> Maybe EntityProperty) -> Text -> Maybe EntityProperty
forall a b. (a -> b) -> a -> b
$ Text
t of
      Just EntityProperty
c -> EntityProperty -> Parser EntityProperty
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityProperty
c
      Maybe EntityProperty
Nothing -> [Text] -> Parser EntityProperty
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown entity property", Text
t]

data GrowthSpread = GrowthSpread
  { GrowthSpread -> Int
spreadRadius :: Int
  -- ^ in terms of manhattan distance
  , GrowthSpread -> Float
spreadDensity :: Float
  -- ^ average number of tiles within the
  -- radius that will be seeded per
  -- growth cycle
  }
  deriving (GrowthSpread -> GrowthSpread -> Bool
(GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool) -> Eq GrowthSpread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrowthSpread -> GrowthSpread -> Bool
== :: GrowthSpread -> GrowthSpread -> Bool
$c/= :: GrowthSpread -> GrowthSpread -> Bool
/= :: GrowthSpread -> GrowthSpread -> Bool
Eq, Eq GrowthSpread
Eq GrowthSpread =>
(GrowthSpread -> GrowthSpread -> Ordering)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> Bool)
-> (GrowthSpread -> GrowthSpread -> GrowthSpread)
-> (GrowthSpread -> GrowthSpread -> GrowthSpread)
-> Ord GrowthSpread
GrowthSpread -> GrowthSpread -> Bool
GrowthSpread -> GrowthSpread -> Ordering
GrowthSpread -> GrowthSpread -> GrowthSpread
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GrowthSpread -> GrowthSpread -> Ordering
compare :: GrowthSpread -> GrowthSpread -> Ordering
$c< :: GrowthSpread -> GrowthSpread -> Bool
< :: GrowthSpread -> GrowthSpread -> Bool
$c<= :: GrowthSpread -> GrowthSpread -> Bool
<= :: GrowthSpread -> GrowthSpread -> Bool
$c> :: GrowthSpread -> GrowthSpread -> Bool
> :: GrowthSpread -> GrowthSpread -> Bool
$c>= :: GrowthSpread -> GrowthSpread -> Bool
>= :: GrowthSpread -> GrowthSpread -> Bool
$cmax :: GrowthSpread -> GrowthSpread -> GrowthSpread
max :: GrowthSpread -> GrowthSpread -> GrowthSpread
$cmin :: GrowthSpread -> GrowthSpread -> GrowthSpread
min :: GrowthSpread -> GrowthSpread -> GrowthSpread
Ord, Int -> GrowthSpread -> ShowS
[GrowthSpread] -> ShowS
GrowthSpread -> String
(Int -> GrowthSpread -> ShowS)
-> (GrowthSpread -> String)
-> ([GrowthSpread] -> ShowS)
-> Show GrowthSpread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrowthSpread -> ShowS
showsPrec :: Int -> GrowthSpread -> ShowS
$cshow :: GrowthSpread -> String
show :: GrowthSpread -> String
$cshowList :: [GrowthSpread] -> ShowS
showList :: [GrowthSpread] -> ShowS
Show, ReadPrec [GrowthSpread]
ReadPrec GrowthSpread
Int -> ReadS GrowthSpread
ReadS [GrowthSpread]
(Int -> ReadS GrowthSpread)
-> ReadS [GrowthSpread]
-> ReadPrec GrowthSpread
-> ReadPrec [GrowthSpread]
-> Read GrowthSpread
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GrowthSpread
readsPrec :: Int -> ReadS GrowthSpread
$creadList :: ReadS [GrowthSpread]
readList :: ReadS [GrowthSpread]
$creadPrec :: ReadPrec GrowthSpread
readPrec :: ReadPrec GrowthSpread
$creadListPrec :: ReadPrec [GrowthSpread]
readListPrec :: ReadPrec [GrowthSpread]
Read, (forall x. GrowthSpread -> Rep GrowthSpread x)
-> (forall x. Rep GrowthSpread x -> GrowthSpread)
-> Generic GrowthSpread
forall x. Rep GrowthSpread x -> GrowthSpread
forall x. GrowthSpread -> Rep GrowthSpread x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GrowthSpread -> Rep GrowthSpread x
from :: forall x. GrowthSpread -> Rep GrowthSpread x
$cto :: forall x. Rep GrowthSpread x -> GrowthSpread
to :: forall x. Rep GrowthSpread x -> GrowthSpread
Generic, Eq GrowthSpread
Eq GrowthSpread =>
(Int -> GrowthSpread -> Int)
-> (GrowthSpread -> Int) -> Hashable GrowthSpread
Int -> GrowthSpread -> Int
GrowthSpread -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GrowthSpread -> Int
hashWithSalt :: Int -> GrowthSpread -> Int
$chash :: GrowthSpread -> Int
hash :: GrowthSpread -> Int
Hashable, [GrowthSpread] -> Value
[GrowthSpread] -> Encoding
GrowthSpread -> Bool
GrowthSpread -> Value
GrowthSpread -> Encoding
(GrowthSpread -> Value)
-> (GrowthSpread -> Encoding)
-> ([GrowthSpread] -> Value)
-> ([GrowthSpread] -> Encoding)
-> (GrowthSpread -> Bool)
-> ToJSON GrowthSpread
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GrowthSpread -> Value
toJSON :: GrowthSpread -> Value
$ctoEncoding :: GrowthSpread -> Encoding
toEncoding :: GrowthSpread -> Encoding
$ctoJSONList :: [GrowthSpread] -> Value
toJSONList :: [GrowthSpread] -> Value
$ctoEncodingList :: [GrowthSpread] -> Encoding
toEncodingList :: [GrowthSpread] -> Encoding
$comitField :: GrowthSpread -> Bool
omitField :: GrowthSpread -> Bool
ToJSON)

instance FromJSON GrowthSpread where
  parseJSON :: Value -> Parser GrowthSpread
parseJSON = String
-> (Object -> Parser GrowthSpread) -> Value -> Parser GrowthSpread
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GrowthSpread" ((Object -> Parser GrowthSpread) -> Value -> Parser GrowthSpread)
-> (Object -> Parser GrowthSpread) -> Value -> Parser GrowthSpread
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Int
spreadRadius <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"radius"
    Float
spreadDensity <- Object
v Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"density"
    GrowthSpread -> Parser GrowthSpread
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GrowthSpread {Float
Int
spreadRadius :: Int
spreadDensity :: Float
spreadRadius :: Int
spreadDensity :: Float
..}

data Growth = Growth
  { Growth -> Maybe Text
maturesTo :: Maybe EntityName
  -- ^ Entity this turns into after growth is complete,
  -- if something different than self
  , Growth -> Maybe GrowthSpread
growthSpread :: Maybe GrowthSpread
  , Growth -> GrowthTime
growthTime :: GrowthTime
  }
  deriving (Growth -> Growth -> Bool
(Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool) -> Eq Growth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Growth -> Growth -> Bool
== :: Growth -> Growth -> Bool
$c/= :: Growth -> Growth -> Bool
/= :: Growth -> Growth -> Bool
Eq, Eq Growth
Eq Growth =>
(Growth -> Growth -> Ordering)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Bool)
-> (Growth -> Growth -> Growth)
-> (Growth -> Growth -> Growth)
-> Ord Growth
Growth -> Growth -> Bool
Growth -> Growth -> Ordering
Growth -> Growth -> Growth
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Growth -> Growth -> Ordering
compare :: Growth -> Growth -> Ordering
$c< :: Growth -> Growth -> Bool
< :: Growth -> Growth -> Bool
$c<= :: Growth -> Growth -> Bool
<= :: Growth -> Growth -> Bool
$c> :: Growth -> Growth -> Bool
> :: Growth -> Growth -> Bool
$c>= :: Growth -> Growth -> Bool
>= :: Growth -> Growth -> Bool
$cmax :: Growth -> Growth -> Growth
max :: Growth -> Growth -> Growth
$cmin :: Growth -> Growth -> Growth
min :: Growth -> Growth -> Growth
Ord, Int -> Growth -> ShowS
[Growth] -> ShowS
Growth -> String
(Int -> Growth -> ShowS)
-> (Growth -> String) -> ([Growth] -> ShowS) -> Show Growth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Growth -> ShowS
showsPrec :: Int -> Growth -> ShowS
$cshow :: Growth -> String
show :: Growth -> String
$cshowList :: [Growth] -> ShowS
showList :: [Growth] -> ShowS
Show, ReadPrec [Growth]
ReadPrec Growth
Int -> ReadS Growth
ReadS [Growth]
(Int -> ReadS Growth)
-> ReadS [Growth]
-> ReadPrec Growth
-> ReadPrec [Growth]
-> Read Growth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Growth
readsPrec :: Int -> ReadS Growth
$creadList :: ReadS [Growth]
readList :: ReadS [Growth]
$creadPrec :: ReadPrec Growth
readPrec :: ReadPrec Growth
$creadListPrec :: ReadPrec [Growth]
readListPrec :: ReadPrec [Growth]
Read, (forall x. Growth -> Rep Growth x)
-> (forall x. Rep Growth x -> Growth) -> Generic Growth
forall x. Rep Growth x -> Growth
forall x. Growth -> Rep Growth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Growth -> Rep Growth x
from :: forall x. Growth -> Rep Growth x
$cto :: forall x. Rep Growth x -> Growth
to :: forall x. Rep Growth x -> Growth
Generic, Eq Growth
Eq Growth =>
(Int -> Growth -> Int) -> (Growth -> Int) -> Hashable Growth
Int -> Growth -> Int
Growth -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Growth -> Int
hashWithSalt :: Int -> Growth -> Int
$chash :: Growth -> Int
hash :: Growth -> Int
Hashable, [Growth] -> Value
[Growth] -> Encoding
Growth -> Bool
Growth -> Value
Growth -> Encoding
(Growth -> Value)
-> (Growth -> Encoding)
-> ([Growth] -> Value)
-> ([Growth] -> Encoding)
-> (Growth -> Bool)
-> ToJSON Growth
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Growth -> Value
toJSON :: Growth -> Value
$ctoEncoding :: Growth -> Encoding
toEncoding :: Growth -> Encoding
$ctoJSONList :: [Growth] -> Value
toJSONList :: [Growth] -> Value
$ctoEncodingList :: [Growth] -> Encoding
toEncodingList :: [Growth] -> Encoding
$comitField :: Growth -> Bool
omitField :: Growth -> Bool
ToJSON)

instance FromJSON Growth where
  parseJSON :: Value -> Parser Growth
parseJSON Value
x =
    (Maybe Text -> Maybe GrowthSpread -> GrowthTime -> Growth
Growth Maybe Text
forall a. Maybe a
Nothing Maybe GrowthSpread
forall a. Maybe a
Nothing (GrowthTime -> Growth) -> Parser GrowthTime -> Parser Growth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GrowthTime
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x)
      Parser Growth -> Parser Growth -> Parser Growth
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser Growth
parseFullGrowth Value
x
   where
    parseFullGrowth :: Value -> Parser Growth
parseFullGrowth = String -> (Object -> Parser Growth) -> Value -> Parser Growth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Growth" ((Object -> Parser Growth) -> Value -> Parser Growth)
-> (Object -> Parser Growth) -> Value -> Parser Growth
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Maybe Text
maturesTo <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mature"
      Maybe GrowthSpread
growthSpread <- Object
v Object -> Key -> Parser (Maybe GrowthSpread)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"spread"
      GrowthTime
growthTime <- Object
v Object -> Key -> Parser GrowthTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration"
      Growth -> Parser Growth
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Growth {Maybe Text
Maybe GrowthSpread
GrowthTime
maturesTo :: Maybe Text
growthSpread :: Maybe GrowthSpread
growthTime :: GrowthTime
maturesTo :: Maybe Text
growthSpread :: Maybe GrowthSpread
growthTime :: GrowthTime
..}

-- | 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
(GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool) -> Eq GrowthTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrowthTime -> GrowthTime -> Bool
== :: GrowthTime -> GrowthTime -> Bool
$c/= :: GrowthTime -> GrowthTime -> Bool
/= :: GrowthTime -> GrowthTime -> Bool
Eq, Eq GrowthTime
Eq GrowthTime =>
(GrowthTime -> GrowthTime -> Ordering)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> Bool)
-> (GrowthTime -> GrowthTime -> GrowthTime)
-> (GrowthTime -> GrowthTime -> GrowthTime)
-> Ord GrowthTime
GrowthTime -> GrowthTime -> Bool
GrowthTime -> GrowthTime -> Ordering
GrowthTime -> GrowthTime -> GrowthTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GrowthTime -> GrowthTime -> Ordering
compare :: GrowthTime -> GrowthTime -> Ordering
$c< :: GrowthTime -> GrowthTime -> Bool
< :: GrowthTime -> GrowthTime -> Bool
$c<= :: GrowthTime -> GrowthTime -> Bool
<= :: GrowthTime -> GrowthTime -> Bool
$c> :: GrowthTime -> GrowthTime -> Bool
> :: GrowthTime -> GrowthTime -> Bool
$c>= :: GrowthTime -> GrowthTime -> Bool
>= :: GrowthTime -> GrowthTime -> Bool
$cmax :: GrowthTime -> GrowthTime -> GrowthTime
max :: GrowthTime -> GrowthTime -> GrowthTime
$cmin :: GrowthTime -> GrowthTime -> GrowthTime
min :: GrowthTime -> GrowthTime -> GrowthTime
Ord, Int -> GrowthTime -> ShowS
[GrowthTime] -> ShowS
GrowthTime -> String
(Int -> GrowthTime -> ShowS)
-> (GrowthTime -> String)
-> ([GrowthTime] -> ShowS)
-> Show GrowthTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrowthTime -> ShowS
showsPrec :: Int -> GrowthTime -> ShowS
$cshow :: GrowthTime -> String
show :: GrowthTime -> String
$cshowList :: [GrowthTime] -> ShowS
showList :: [GrowthTime] -> ShowS
Show, ReadPrec [GrowthTime]
ReadPrec GrowthTime
Int -> ReadS GrowthTime
ReadS [GrowthTime]
(Int -> ReadS GrowthTime)
-> ReadS [GrowthTime]
-> ReadPrec GrowthTime
-> ReadPrec [GrowthTime]
-> Read GrowthTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GrowthTime
readsPrec :: Int -> ReadS GrowthTime
$creadList :: ReadS [GrowthTime]
readList :: ReadS [GrowthTime]
$creadPrec :: ReadPrec GrowthTime
readPrec :: ReadPrec GrowthTime
$creadListPrec :: ReadPrec [GrowthTime]
readListPrec :: ReadPrec [GrowthTime]
Read, (forall x. GrowthTime -> Rep GrowthTime x)
-> (forall x. Rep GrowthTime x -> GrowthTime) -> Generic GrowthTime
forall x. Rep GrowthTime x -> GrowthTime
forall x. GrowthTime -> Rep GrowthTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GrowthTime -> Rep GrowthTime x
from :: forall x. GrowthTime -> Rep GrowthTime x
$cto :: forall x. Rep GrowthTime x -> GrowthTime
to :: forall x. Rep GrowthTime x -> GrowthTime
Generic, Eq GrowthTime
Eq GrowthTime =>
(Int -> GrowthTime -> Int)
-> (GrowthTime -> Int) -> Hashable GrowthTime
Int -> GrowthTime -> Int
GrowthTime -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GrowthTime -> Int
hashWithSalt :: Int -> GrowthTime -> Int
$chash :: GrowthTime -> Int
hash :: GrowthTime -> Int
Hashable, Maybe GrowthTime
Value -> Parser [GrowthTime]
Value -> Parser GrowthTime
(Value -> Parser GrowthTime)
-> (Value -> Parser [GrowthTime])
-> Maybe GrowthTime
-> FromJSON GrowthTime
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GrowthTime
parseJSON :: Value -> Parser GrowthTime
$cparseJSONList :: Value -> Parser [GrowthTime]
parseJSONList :: Value -> Parser [GrowthTime]
$comittedField :: Maybe GrowthTime
omittedField :: Maybe GrowthTime
FromJSON, [GrowthTime] -> Value
[GrowthTime] -> Encoding
GrowthTime -> Bool
GrowthTime -> Value
GrowthTime -> Encoding
(GrowthTime -> Value)
-> (GrowthTime -> Encoding)
-> ([GrowthTime] -> Value)
-> ([GrowthTime] -> Encoding)
-> (GrowthTime -> Bool)
-> ToJSON GrowthTime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GrowthTime -> Value
toJSON :: GrowthTime -> Value
$ctoEncoding :: GrowthTime -> Encoding
toEncoding :: GrowthTime -> Encoding
$ctoJSONList :: [GrowthTime] -> Value
toJSONList :: [GrowthTime] -> Value
$ctoEncodingList :: [GrowthTime] -> Encoding
toEncodingList :: [GrowthTime] -> Encoding
$comitField :: GrowthTime -> Bool
omitField :: GrowthTime -> Bool
ToJSON)

-- | The default growth time (100, 200) for a growable entity with no
--   growth time specification.
defaultGrowthTime :: GrowthTime
defaultGrowthTime :: GrowthTime
defaultGrowthTime = (Integer, Integer) -> GrowthTime
GrowthTime (Integer
100, Integer
200)

defaultGrowth :: Growth
defaultGrowth :: Growth
defaultGrowth = Maybe Text -> Maybe GrowthSpread -> GrowthTime -> Growth
Growth Maybe Text
forall a. Maybe a
Nothing Maybe GrowthSpread
forall a. Maybe a
Nothing GrowthTime
defaultGrowthTime

-- | Properties of combustion.
data Combustibility = Combustibility
  { Combustibility -> Double
ignition :: Double
  -- ^ Rate of ignition by a neighbor, per tick.
  --   If this rate is denoted \(\lambda\), the probability of
  --   ignition over a period of \(t\) ticks is \(1 - e^{-\lambda t}\).
  --   See <https://math.stackexchange.com/a/1243629>.
  , Combustibility -> (Integer, Integer)
duration :: (Integer, Integer)
  -- ^ min and max tick counts for combustion to persist
  , Combustibility -> Maybe Text
product :: Maybe EntityName
  -- ^ what entity, if any, is left over after combustion
  }
  deriving (Combustibility -> Combustibility -> Bool
(Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool) -> Eq Combustibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Combustibility -> Combustibility -> Bool
== :: Combustibility -> Combustibility -> Bool
$c/= :: Combustibility -> Combustibility -> Bool
/= :: Combustibility -> Combustibility -> Bool
Eq, Eq Combustibility
Eq Combustibility =>
(Combustibility -> Combustibility -> Ordering)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Bool)
-> (Combustibility -> Combustibility -> Combustibility)
-> (Combustibility -> Combustibility -> Combustibility)
-> Ord Combustibility
Combustibility -> Combustibility -> Bool
Combustibility -> Combustibility -> Ordering
Combustibility -> Combustibility -> Combustibility
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Combustibility -> Combustibility -> Ordering
compare :: Combustibility -> Combustibility -> Ordering
$c< :: Combustibility -> Combustibility -> Bool
< :: Combustibility -> Combustibility -> Bool
$c<= :: Combustibility -> Combustibility -> Bool
<= :: Combustibility -> Combustibility -> Bool
$c> :: Combustibility -> Combustibility -> Bool
> :: Combustibility -> Combustibility -> Bool
$c>= :: Combustibility -> Combustibility -> Bool
>= :: Combustibility -> Combustibility -> Bool
$cmax :: Combustibility -> Combustibility -> Combustibility
max :: Combustibility -> Combustibility -> Combustibility
$cmin :: Combustibility -> Combustibility -> Combustibility
min :: Combustibility -> Combustibility -> Combustibility
Ord, Int -> Combustibility -> ShowS
[Combustibility] -> ShowS
Combustibility -> String
(Int -> Combustibility -> ShowS)
-> (Combustibility -> String)
-> ([Combustibility] -> ShowS)
-> Show Combustibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Combustibility -> ShowS
showsPrec :: Int -> Combustibility -> ShowS
$cshow :: Combustibility -> String
show :: Combustibility -> String
$cshowList :: [Combustibility] -> ShowS
showList :: [Combustibility] -> ShowS
Show, ReadPrec [Combustibility]
ReadPrec Combustibility
Int -> ReadS Combustibility
ReadS [Combustibility]
(Int -> ReadS Combustibility)
-> ReadS [Combustibility]
-> ReadPrec Combustibility
-> ReadPrec [Combustibility]
-> Read Combustibility
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Combustibility
readsPrec :: Int -> ReadS Combustibility
$creadList :: ReadS [Combustibility]
readList :: ReadS [Combustibility]
$creadPrec :: ReadPrec Combustibility
readPrec :: ReadPrec Combustibility
$creadListPrec :: ReadPrec [Combustibility]
readListPrec :: ReadPrec [Combustibility]
Read, (forall x. Combustibility -> Rep Combustibility x)
-> (forall x. Rep Combustibility x -> Combustibility)
-> Generic Combustibility
forall x. Rep Combustibility x -> Combustibility
forall x. Combustibility -> Rep Combustibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Combustibility -> Rep Combustibility x
from :: forall x. Combustibility -> Rep Combustibility x
$cto :: forall x. Rep Combustibility x -> Combustibility
to :: forall x. Rep Combustibility x -> Combustibility
Generic, Eq Combustibility
Eq Combustibility =>
(Int -> Combustibility -> Int)
-> (Combustibility -> Int) -> Hashable Combustibility
Int -> Combustibility -> Int
Combustibility -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Combustibility -> Int
hashWithSalt :: Int -> Combustibility -> Int
$chash :: Combustibility -> Int
hash :: Combustibility -> Int
Hashable, Maybe Combustibility
Value -> Parser [Combustibility]
Value -> Parser Combustibility
(Value -> Parser Combustibility)
-> (Value -> Parser [Combustibility])
-> Maybe Combustibility
-> FromJSON Combustibility
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Combustibility
parseJSON :: Value -> Parser Combustibility
$cparseJSONList :: Value -> Parser [Combustibility]
parseJSONList :: Value -> Parser [Combustibility]
$comittedField :: Maybe Combustibility
omittedField :: Maybe Combustibility
FromJSON, [Combustibility] -> Value
[Combustibility] -> Encoding
Combustibility -> Bool
Combustibility -> Value
Combustibility -> Encoding
(Combustibility -> Value)
-> (Combustibility -> Encoding)
-> ([Combustibility] -> Value)
-> ([Combustibility] -> Encoding)
-> (Combustibility -> Bool)
-> ToJSON Combustibility
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Combustibility -> Value
toJSON :: Combustibility -> Value
$ctoEncoding :: Combustibility -> Encoding
toEncoding :: Combustibility -> Encoding
$ctoJSONList :: [Combustibility] -> Value
toJSONList :: [Combustibility] -> Value
$ctoEncodingList :: [Combustibility] -> Encoding
toEncodingList :: [Combustibility] -> Encoding
$comitField :: Combustibility -> Bool
omitField :: Combustibility -> Bool
ToJSON)

-- | The default combustion specification for a combustible entity
--   with no combustion specification:
--
--   * ignition rate 0.5
--   * duration (100, 200)
--   * product @ash@
defaultCombustibility :: Combustibility
defaultCombustibility :: Combustibility
defaultCombustibility = Double -> (Integer, Integer) -> Maybe Text -> Combustibility
Combustibility Double
0.5 (Integer
100, Integer
200) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ash")

------------------------------------------------------------
-- 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
  { Entity -> Int
_entityHash :: Int
  -- ^ A hash value computed from the other fields
  , Entity -> Display
_entityDisplay :: Display
  -- ^ The way this entity should be displayed on the world map.
  , Entity -> Text
_entityName :: EntityName
  -- ^ The name of the entity, used /e.g./ in an inventory display.
  , Entity -> Maybe Text
_entityPlural :: Maybe 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 -> Document Syntax
_entityDescription :: Document Syntax
  -- ^ A longer-form description. Each 'Text' value is one
  --   paragraph.
  , Entity -> Set Text
_entityTags :: Set Text
  -- ^ A set of categories to which the entity belongs
  , Entity -> Maybe Heading
_entityOrientation :: Maybe Heading
  -- ^ The entity's orientation (if it has one).  For example, when
  --   a robot moves, it moves in the direction of its orientation.
  , Entity -> Maybe Growth
_entityGrowth :: Maybe Growth
  -- ^ If this entity grows, how long does it take?
  , Entity -> Maybe Combustibility
_entityCombustion :: Maybe Combustibility
  -- ^ If this entity is combustible, how spreadable is it?
  , Entity -> Maybe Text
_entityYields :: Maybe Text
  -- ^ The name of a different entity obtained when this entity is
  -- grabbed.
  , Entity -> Set EntityProperty
_entityProperties :: Set EntityProperty
  -- ^ Properties of the entity.
  , Entity -> Set TerrainType
_entityBiomes :: Set TerrainType
  -- ^ Terrain in which growth may occur. Empty means no restrictions.
  , Entity -> Capabilities (ExerciseCost Text)
_entityCapabilities :: SingleEntityCapabilities EntityName
  -- ^ Capabilities provided by this entity.
  , Entity -> Inventory
_entityInventory :: Inventory
  -- ^ Inventory of other entities held by this entity.
  }
  -- 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 (Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
(Int -> Entity -> ShowS)
-> (Entity -> String) -> ([Entity] -> ShowS) -> Show Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entity -> ShowS
showsPrec :: Int -> Entity -> ShowS
$cshow :: Entity -> String
show :: Entity -> String
$cshowList :: [Entity] -> ShowS
showList :: [Entity] -> ShowS
Show, (forall x. Entity -> Rep Entity x)
-> (forall x. Rep Entity x -> Entity) -> Generic Entity
forall x. Rep Entity x -> Entity
forall x. Entity -> Rep Entity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Entity -> Rep Entity x
from :: forall x. Entity -> Rep Entity x
$cto :: forall x. Rep Entity x -> Entity
to :: forall x. Rep Entity x -> Entity
Generic)

-- | The @Hashable@ instance for @Entity@ ignores the cached hash
--   value and simply combines the other fields.
instance Hashable Entity where
  hashWithSalt :: Int -> Entity -> Int
hashWithSalt Int
s (Entity Int
_ Display
disp Text
nm Maybe Text
pl Document Syntax
descr Set Text
tags Maybe Heading
orient Maybe Growth
grow Maybe Combustibility
combust Maybe Text
yld Set EntityProperty
props Set TerrainType
biomes Capabilities (ExerciseCost Text)
caps Inventory
inv) =
    Int
s
      Int -> Display -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Display
disp
      Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
nm
      Int -> Maybe Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Text
pl
      Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Document Syntax -> Text
forall a. PrettyPrec a => Document a -> Text
docToText Document Syntax
descr
      Int -> Set Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Set Text
tags
      Int -> Maybe Heading -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Heading
orient
      Int -> Maybe Growth -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Growth
grow
      Int -> Maybe Combustibility -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Combustibility
combust
      Int -> Maybe Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe Text
yld
      Int -> Set EntityProperty -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Set EntityProperty
props
      Int -> Set TerrainType -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Set TerrainType
biomes
      Int -> Capabilities (ExerciseCost Text) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Capabilities (ExerciseCost Text)
caps
      Int -> Inventory -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Inventory
inv

-- | Entities are compared by hash for efficiency.
instance Eq Entity where
  == :: Entity -> Entity -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> (Entity -> Int) -> Entity -> Entity -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entity -> Int
_entityHash

-- | Entities are compared by hash for efficiency.
instance Ord Entity where
  compare :: Entity -> Entity -> Ordering
compare = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Entity -> Int) -> Entity -> Entity -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entity -> Int
_entityHash

-- | Recompute an entity's hash value.
rehashEntity :: Entity -> Entity
rehashEntity :: Entity -> Entity
rehashEntity Entity
e = Entity
e {_entityHash = hash 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
  Document Syntax ->
  -- | Properties
  [EntityProperty] ->
  -- | Capabilities
  Set Capability ->
  Entity
mkEntity :: Display
-> Text
-> Document Syntax
-> [EntityProperty]
-> Set Capability
-> Entity
mkEntity Display
disp Text
nm Document Syntax
descr [EntityProperty]
props Set Capability
caps =
  Entity -> Entity
rehashEntity (Entity -> Entity) -> Entity -> Entity
forall a b. (a -> b) -> a -> b
$
    Int
-> Display
-> Text
-> Maybe Text
-> Document Syntax
-> Set Text
-> Maybe Heading
-> Maybe Growth
-> Maybe Combustibility
-> Maybe Text
-> Set EntityProperty
-> Set TerrainType
-> Capabilities (ExerciseCost Text)
-> Inventory
-> Entity
Entity
      Int
0
      Display
disp
      Text
nm
      Maybe Text
forall a. Maybe a
Nothing
      Document Syntax
descr
      Set Text
forall a. Monoid a => a
mempty
      Maybe Heading
forall a. Maybe a
Nothing
      Maybe Growth
forall a. Maybe a
Nothing
      Maybe Combustibility
forall a. Maybe a
Nothing
      Maybe Text
forall a. Maybe a
Nothing
      ([EntityProperty] -> Set EntityProperty
forall a. Ord a => [a] -> Set a
Set.fromList [EntityProperty]
props)
      Set TerrainType
forall a. Monoid a => a
mempty
      (Set Capability -> Capabilities (ExerciseCost Text)
forall e. Set Capability -> SingleEntityCapabilities e
zeroCostCapabilities Set Capability
caps)
      Inventory
empty

------------------------------------------------------------
-- 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).
--
--   Also preserves the original definition order from the scenario
--   file and canonical definition list.
--   This enables scenario authors to specify iteration order of
--   the 'Swarm.Language.Syntax.TagMembers' command.
data EntityMap = EntityMap
  { EntityMap -> Map Text Entity
entitiesByName :: Map EntityName Entity
  , EntityMap -> MultiEntityCapabilities Entity Entity
entitiesByCap :: MultiEntityCapabilities Entity Entity
  , EntityMap -> [Entity]
entityDefinitionOrder :: [Entity]
  }
  deriving (EntityMap -> EntityMap -> Bool
(EntityMap -> EntityMap -> Bool)
-> (EntityMap -> EntityMap -> Bool) -> Eq EntityMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityMap -> EntityMap -> Bool
== :: EntityMap -> EntityMap -> Bool
$c/= :: EntityMap -> EntityMap -> Bool
/= :: EntityMap -> EntityMap -> Bool
Eq, Int -> EntityMap -> ShowS
[EntityMap] -> ShowS
EntityMap -> String
(Int -> EntityMap -> ShowS)
-> (EntityMap -> String)
-> ([EntityMap] -> ShowS)
-> Show EntityMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityMap -> ShowS
showsPrec :: Int -> EntityMap -> ShowS
$cshow :: EntityMap -> String
show :: EntityMap -> String
$cshowList :: [EntityMap] -> ShowS
showList :: [EntityMap] -> ShowS
Show, (forall x. EntityMap -> Rep EntityMap x)
-> (forall x. Rep EntityMap x -> EntityMap) -> Generic EntityMap
forall x. Rep EntityMap x -> EntityMap
forall x. EntityMap -> Rep EntityMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EntityMap -> Rep EntityMap x
from :: forall x. EntityMap -> Rep EntityMap x
$cto :: forall x. Rep EntityMap x -> EntityMap
to :: forall x. Rep EntityMap x -> EntityMap
Generic, [EntityMap] -> Value
[EntityMap] -> Encoding
EntityMap -> Bool
EntityMap -> Value
EntityMap -> Encoding
(EntityMap -> Value)
-> (EntityMap -> Encoding)
-> ([EntityMap] -> Value)
-> ([EntityMap] -> Encoding)
-> (EntityMap -> Bool)
-> ToJSON EntityMap
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: EntityMap -> Value
toJSON :: EntityMap -> Value
$ctoEncoding :: EntityMap -> Encoding
toEncoding :: EntityMap -> Encoding
$ctoJSONList :: [EntityMap] -> Value
toJSONList :: [EntityMap] -> Value
$ctoEncodingList :: [EntityMap] -> Encoding
toEncodingList :: [EntityMap] -> Encoding
$comitField :: EntityMap -> Bool
omitField :: EntityMap -> Bool
ToJSON)

-- |
-- Note that duplicates in a single 'EntityMap' are precluded by the
-- 'buildEntityMap' function.
-- But it is possible for the latter 'EntityMap' to override
-- members of the former with the same name.
-- This replacement happens automatically with 'Map', but needs
-- to be explicitly handled for the list concatenation
-- of 'entityDefinitionOrder' (overridden entries are removed
-- from the former 'EntityMap').
instance Semigroup EntityMap where
  EntityMap Map Text Entity
n1 MultiEntityCapabilities Entity Entity
c1 [Entity]
d1 <> :: EntityMap -> EntityMap -> EntityMap
<> EntityMap Map Text Entity
n2 MultiEntityCapabilities Entity Entity
c2 [Entity]
d2 =
    Map Text Entity
-> MultiEntityCapabilities Entity Entity -> [Entity] -> EntityMap
EntityMap
      (Map Text Entity
n1 Map Text Entity -> Map Text Entity -> Map Text Entity
forall a. Semigroup a => a -> a -> a
<> Map Text Entity
n2)
      (MultiEntityCapabilities Entity Entity
c1 MultiEntityCapabilities Entity Entity
-> MultiEntityCapabilities Entity Entity
-> MultiEntityCapabilities Entity Entity
forall a. Semigroup a => a -> a -> a
<> MultiEntityCapabilities Entity Entity
c2)
      ((Entity -> Bool) -> [Entity] -> [Entity]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Map Text Entity -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map Text Entity
n2) (Text -> Bool) -> (Entity -> Text) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName) [Entity]
d1 [Entity] -> [Entity] -> [Entity]
forall a. Semigroup a => a -> a -> a
<> [Entity]
d2)

instance Monoid EntityMap where
  mempty :: EntityMap
mempty = Map Text Entity
-> MultiEntityCapabilities Entity Entity -> [Entity] -> EntityMap
EntityMap Map Text Entity
forall k a. Map k a
M.empty MultiEntityCapabilities Entity Entity
forall a. Monoid a => a
mempty []
  mappend :: EntityMap -> EntityMap -> EntityMap
mappend = EntityMap -> EntityMap -> EntityMap
forall a. Semigroup a => a -> a -> a
(<>)

-- | Get a list of all the entities in the entity map.
allEntities :: EntityMap -> [Entity]
allEntities :: EntityMap -> [Entity]
allEntities (EntityMap Map Text Entity
_ MultiEntityCapabilities Entity Entity
_ [Entity]
x) = [Entity]
x

-- | Find an entity with the given name.
lookupEntityName :: Text -> EntityMap -> Maybe Entity
lookupEntityName :: Text -> EntityMap -> Maybe Entity
lookupEntityName Text
nm = Text -> Map Text Entity -> Maybe Entity
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
nm (Map Text Entity -> Maybe Entity)
-> (EntityMap -> Map Text Entity) -> EntityMap -> Maybe Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap -> Map Text Entity
entitiesByName

-- | Find all entities which are devices that provide the given
--   capability.
devicesForCap :: Capability -> EntityMap -> [Entity]
devicesForCap :: Capability -> EntityMap -> [Entity]
devicesForCap Capability
cap = [Entity]
-> (NonEmpty (DeviceUseCost Entity Entity) -> [Entity])
-> Maybe (NonEmpty (DeviceUseCost Entity Entity))
-> [Entity]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (NonEmpty Entity -> [Entity]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Entity -> [Entity])
-> (NonEmpty (DeviceUseCost Entity Entity) -> NonEmpty Entity)
-> NonEmpty (DeviceUseCost Entity Entity)
-> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceUseCost Entity Entity -> Entity)
-> NonEmpty (DeviceUseCost Entity Entity) -> NonEmpty Entity
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DeviceUseCost Entity Entity -> Entity
forall e en. DeviceUseCost e en -> e
device) (Maybe (NonEmpty (DeviceUseCost Entity Entity)) -> [Entity])
-> (EntityMap -> Maybe (NonEmpty (DeviceUseCost Entity Entity)))
-> EntityMap
-> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity))
-> Maybe (NonEmpty (DeviceUseCost Entity Entity))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Capability
cap (Map Capability (NonEmpty (DeviceUseCost Entity Entity))
 -> Maybe (NonEmpty (DeviceUseCost Entity Entity)))
-> (EntityMap
    -> Map Capability (NonEmpty (DeviceUseCost Entity Entity)))
-> EntityMap
-> Maybe (NonEmpty (DeviceUseCost Entity Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiEntityCapabilities Entity Entity
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity))
forall e. Capabilities e -> Map Capability e
getMap (MultiEntityCapabilities Entity Entity
 -> Map Capability (NonEmpty (DeviceUseCost Entity Entity)))
-> (EntityMap -> MultiEntityCapabilities Entity Entity)
-> EntityMap
-> Map Capability (NonEmpty (DeviceUseCost Entity Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap -> MultiEntityCapabilities Entity Entity
entitiesByCap

-- | Validates references to 'Display' attributes
validateEntityAttrRefs :: Has (Throw LoadingFailure) sig m => Set WorldAttr -> [Entity] -> m ()
validateEntityAttrRefs :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
Set WorldAttr -> [Entity] -> m ()
validateEntityAttrRefs Set WorldAttr
validAttrs [Entity]
es =
  [(Text, Entity)] -> ((Text, Entity) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Entity)]
namedEntities (((Text, Entity) -> m ()) -> m ())
-> ((Text, Entity) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Text
eName, Entity
ent) ->
    case Entity
ent Entity -> Getting Attribute Entity Attribute -> Attribute
forall s a. s -> Getting a s a -> a
^. (Display -> Const Attribute Display)
-> Entity -> Const Attribute Entity
Lens' Entity Display
entityDisplay ((Display -> Const Attribute Display)
 -> Entity -> Const Attribute Entity)
-> ((Attribute -> Const Attribute Attribute)
    -> Display -> Const Attribute Display)
-> Getting Attribute Entity Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> Const Attribute Attribute)
-> Display -> Const Attribute Display
Lens' Display Attribute
displayAttr of
      AWorld Text
n ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorldAttr -> Set WorldAttr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (String -> WorldAttr
WorldAttr (String -> WorldAttr) -> String -> WorldAttr
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
n) Set WorldAttr
validAttrs)
          (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadingFailure -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError
          (LoadingFailure -> m ())
-> (Text -> LoadingFailure) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LoadingFailure
CustomMessage
          (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
            [ Text
"Nonexistent attribute"
            , Text -> Text
quote Text
n
            , Text
"referenced by entity"
            , Text -> Text
quote Text
eName
            ]
      Attribute
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  namedEntities :: [(Text, Entity)]
namedEntities = (Entity -> (Text, Entity)) -> [Entity] -> [(Text, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName (Entity -> Text) -> (Entity -> Entity) -> Entity -> (Text, Entity)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Entity -> Entity
forall a. a -> a
id) [Entity]
es

-- | 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 :: Has (Throw LoadingFailure) sig m => [Entity] -> m EntityMap
buildEntityMap :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
[Entity] -> m EntityMap
buildEntityMap [Entity]
es = do
  case [Text] -> Maybe Text
forall a. Ord a => [a] -> Maybe a
findDup (((Text, Entity) -> Text) -> [(Text, Entity)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Entity) -> Text
forall a b. (a, b) -> a
fst [(Text, Entity)]
namedEntities) of
    Maybe Text
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Text
duped -> LoadingFailure -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (LoadingFailure -> m ()) -> LoadingFailure -> m ()
forall a b. (a -> b) -> a -> b
$ AssetData -> Text -> LoadingFailure
Duplicate AssetData
Entities Text
duped
  case Map Text Entity
-> [Entity] -> Either Text (MultiEntityCapabilities Entity Entity)
combineEntityCapsM Map Text Entity
entsByName [Entity]
es of
    Left Text
x -> LoadingFailure -> m EntityMap
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (LoadingFailure -> m EntityMap) -> LoadingFailure -> m EntityMap
forall a b. (a -> b) -> a -> b
$ Text -> LoadingFailure
CustomMessage Text
x
    Right MultiEntityCapabilities Entity Entity
ebc ->
      EntityMap -> m EntityMap
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EntityMap -> m EntityMap) -> EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$
        EntityMap
          { entitiesByName :: Map Text Entity
entitiesByName = Map Text Entity
entsByName
          , entitiesByCap :: MultiEntityCapabilities Entity Entity
entitiesByCap = MultiEntityCapabilities Entity Entity
ebc
          , entityDefinitionOrder :: [Entity]
entityDefinitionOrder = [Entity]
es
          }
 where
  namedEntities :: [(Text, Entity)]
namedEntities = (Entity -> (Text, Entity)) -> [Entity] -> [(Text, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text Entity Text -> Entity -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName (Entity -> Text) -> (Entity -> Entity) -> Entity -> (Text, Entity)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Entity -> Entity
forall a. a -> a
id) [Entity]
es
  entsByName :: Map Text Entity
entsByName = [(Text, Entity)] -> Map Text Entity
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Entity)]
namedEntities

-- Compare to 'combineEntityCapsM'
combineEntityCaps ::
  [Entity] ->
  MultiEntityCapabilities Entity EntityName
combineEntityCaps :: [Entity] -> MultiEntityCapabilities Entity Text
combineEntityCaps = [MultiEntityCapabilities Entity Text]
-> MultiEntityCapabilities Entity Text
forall a. Monoid a => [a] -> a
mconcat ([MultiEntityCapabilities Entity Text]
 -> MultiEntityCapabilities Entity Text)
-> ([Entity] -> [MultiEntityCapabilities Entity Text])
-> [Entity]
-> MultiEntityCapabilities Entity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> MultiEntityCapabilities Entity Text)
-> [Entity] -> [MultiEntityCapabilities Entity Text]
forall a b. (a -> b) -> [a] -> [b]
map Entity -> MultiEntityCapabilities Entity Text
forall {f :: * -> *}.
Applicative f =>
Entity -> Capabilities (f (DeviceUseCost Entity Text))
mkForEntity
 where
  mkForEntity :: Entity -> Capabilities (f (DeviceUseCost Entity Text))
mkForEntity Entity
e = ExerciseCost Text -> f (DeviceUseCost Entity Text)
f (ExerciseCost Text -> f (DeviceUseCost Entity Text))
-> Capabilities (ExerciseCost Text)
-> Capabilities (f (DeviceUseCost Entity Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entity
e Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities
   where
    f :: ExerciseCost Text -> f (DeviceUseCost Entity Text)
f = DeviceUseCost Entity Text -> f (DeviceUseCost Entity Text)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceUseCost Entity Text -> f (DeviceUseCost Entity Text))
-> (ExerciseCost Text -> DeviceUseCost Entity Text)
-> ExerciseCost Text
-> f (DeviceUseCost Entity Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> ExerciseCost Text -> DeviceUseCost Entity Text
forall e en. e -> ExerciseCost en -> DeviceUseCost e en
DeviceUseCost Entity
e

lookupEntityE :: Map Text b -> Text -> Either Text b
lookupEntityE :: forall b. Map Text b -> Text -> Either Text b
lookupEntityE Map Text b
em Text
en =
  Text -> Maybe b -> Either Text b
forall a b. a -> Maybe b -> Either a b
maybeToEither Text
err (Maybe b -> Either Text b) -> Maybe b -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text -> Map Text b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
en Map Text b
em
 where
  err :: Text
err = [Text] -> Text
T.unwords [Text -> Text
quote Text
en, Text
"is not a valid entity name"]

combineEntityCapsM ::
  Map EntityName Entity ->
  [Entity] ->
  Either Text (MultiEntityCapabilities Entity Entity)
combineEntityCapsM :: Map Text Entity
-> [Entity] -> Either Text (MultiEntityCapabilities Entity Entity)
combineEntityCapsM Map Text Entity
em =
  ([MultiEntityCapabilities Entity Entity]
 -> MultiEntityCapabilities Entity Entity)
-> Either Text [MultiEntityCapabilities Entity Entity]
-> Either Text (MultiEntityCapabilities Entity Entity)
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MultiEntityCapabilities Entity Entity]
-> MultiEntityCapabilities Entity Entity
forall a. Monoid a => [a] -> a
mconcat (Either Text [MultiEntityCapabilities Entity Entity]
 -> Either Text (MultiEntityCapabilities Entity Entity))
-> ([Entity]
    -> Either Text [MultiEntityCapabilities Entity Entity])
-> [Entity]
-> Either Text (MultiEntityCapabilities Entity Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Either Text (MultiEntityCapabilities Entity Entity))
-> [Entity] -> Either Text [MultiEntityCapabilities Entity Entity]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Entity -> Either Text (MultiEntityCapabilities Entity Entity)
mkForEntity
 where
  transformCaps :: Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
transformCaps = ((ExerciseCost Text -> Either Text (ExerciseCost Entity))
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Capabilities a -> f (Capabilities b)
traverse ((ExerciseCost Text -> Either Text (ExerciseCost Entity))
 -> Capabilities (ExerciseCost Text)
 -> Either Text (Capabilities (ExerciseCost Entity)))
-> ((Text -> Either Text Entity)
    -> ExerciseCost Text -> Either Text (ExerciseCost Entity))
-> (Text -> Either Text Entity)
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text Entity)
-> ExerciseCost Text -> Either Text (ExerciseCost Entity)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExerciseCost a -> f (ExerciseCost b)
traverse) (Map Text Entity -> Text -> Either Text Entity
forall b. Map Text b -> Text -> Either Text b
lookupEntityE Map Text Entity
em)

  mkForEntity :: Entity -> Either Text (MultiEntityCapabilities Entity Entity)
mkForEntity Entity
e =
    (ExerciseCost Entity -> NonEmpty (DeviceUseCost Entity Entity))
-> Capabilities (ExerciseCost Entity)
-> MultiEntityCapabilities Entity Entity
forall a b. (a -> b) -> Capabilities a -> Capabilities b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExerciseCost Entity -> NonEmpty (DeviceUseCost Entity Entity)
f (Capabilities (ExerciseCost Entity)
 -> MultiEntityCapabilities Entity Entity)
-> Either Text (Capabilities (ExerciseCost Entity))
-> Either Text (MultiEntityCapabilities Entity Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
transformCaps (Entity
e Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)
   where
    f :: ExerciseCost Entity -> NonEmpty (DeviceUseCost Entity Entity)
f = DeviceUseCost Entity Entity
-> NonEmpty (DeviceUseCost Entity Entity)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceUseCost Entity Entity
 -> NonEmpty (DeviceUseCost Entity Entity))
-> (ExerciseCost Entity -> DeviceUseCost Entity Entity)
-> ExerciseCost Entity
-> NonEmpty (DeviceUseCost Entity Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity -> ExerciseCost Entity -> DeviceUseCost Entity Entity
forall e en. e -> ExerciseCost en -> DeviceUseCost e en
DeviceUseCost Entity
e

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

instance FromJSON Entity where
  parseJSON :: Value -> Parser Entity
parseJSON = String -> (Object -> Parser Entity) -> Value -> Parser Entity
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Entity" ((Object -> Parser Entity) -> Value -> Parser Entity)
-> (Object -> Parser Entity) -> Value -> Parser Entity
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    let _entityHash :: Int
_entityHash = Int
0
    Display
_entityDisplay <- Object
v Object -> Key -> Parser Display
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"display"
    Text
_entityName <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe Text
_entityPlural <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"plural"
    Document Syntax
_entityDescription <- Object
v Object -> Key -> Parser (Document Syntax)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
    Set Text
_entityTags <- Object
v Object -> Key -> Parser (Maybe (Set Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags" Parser (Maybe (Set Text)) -> Set Text -> Parser (Set Text)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Set Text
forall a. Monoid a => a
mempty
    Maybe Heading
_entityOrientation <- Object
v Object -> Key -> Parser (Maybe Heading)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"orientation"
    Maybe Growth
_entityGrowth <- Object
v Object -> Key -> Parser (Maybe Growth)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"growth"
    Maybe Combustibility
_entityCombustion <- Object
v Object -> Key -> Parser (Maybe Combustibility)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"combustion"
    Maybe Text
_entityYields <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"yields"
    Set EntityProperty
_entityProperties <- Object
v Object -> Key -> Parser (Maybe (Set EntityProperty))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"properties" Parser (Maybe (Set EntityProperty))
-> Set EntityProperty -> Parser (Set EntityProperty)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Set EntityProperty
forall a. Monoid a => a
mempty
    Set TerrainType
_entityBiomes <- Object
v Object -> Key -> Parser (Maybe (Set TerrainType))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"biomes" Parser (Maybe (Set TerrainType))
-> Set TerrainType -> Parser (Set TerrainType)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Set TerrainType
forall a. Monoid a => a
mempty
    Capabilities (ExerciseCost Text)
_entityCapabilities <- Object
v Object -> Key -> Parser (Maybe (Capabilities (ExerciseCost Text)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"capabilities" Parser (Maybe (Capabilities (ExerciseCost Text)))
-> Capabilities (ExerciseCost Text)
-> Parser (Capabilities (ExerciseCost Text))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Capability (ExerciseCost Text)
-> Capabilities (ExerciseCost Text)
forall e. Map Capability e -> Capabilities e
Capabilities Map Capability (ExerciseCost Text)
forall a. Monoid a => a
mempty
    let _entityInventory :: Inventory
_entityInventory = Inventory
empty
    Entity -> Parser Entity
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Entity -> Parser Entity) -> Entity -> Parser Entity
forall a b. (a -> b) -> a -> b
$ Entity -> Entity
rehashEntity Entity {Int
Maybe Text
Maybe Heading
Maybe Combustibility
Maybe Growth
Text
Set Text
Set TerrainType
Set EntityProperty
Document Syntax
Display
Capabilities (ExerciseCost Text)
Inventory
_entityHash :: Int
_entityDisplay :: Display
_entityName :: Text
_entityPlural :: Maybe Text
_entityDescription :: Document Syntax
_entityTags :: Set Text
_entityOrientation :: Maybe Heading
_entityGrowth :: Maybe Growth
_entityCombustion :: Maybe Combustibility
_entityYields :: Maybe Text
_entityProperties :: Set EntityProperty
_entityBiomes :: Set TerrainType
_entityCapabilities :: Capabilities (ExerciseCost Text)
_entityInventory :: Inventory
_entityHash :: Int
_entityDisplay :: Display
_entityName :: Text
_entityPlural :: Maybe Text
_entityDescription :: Document Syntax
_entityTags :: Set Text
_entityOrientation :: Maybe Heading
_entityGrowth :: Maybe Growth
_entityCombustion :: Maybe Combustibility
_entityYields :: Maybe Text
_entityProperties :: Set EntityProperty
_entityBiomes :: Set TerrainType
_entityCapabilities :: Capabilities (ExerciseCost Text)
_entityInventory :: Inventory
..}

-- | 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 = String
-> (Text -> ParserE EntityMap Entity)
-> Value
-> ParserE EntityMap Entity
forall e a. String -> (Text -> ParserE e a) -> Value -> ParserE e a
withTextE String
"entity name" ((Text -> ParserE EntityMap Entity)
 -> Value -> ParserE EntityMap Entity)
-> (Text -> ParserE EntityMap Entity)
-> Value
-> ParserE EntityMap Entity
forall a b. (a -> b) -> a -> b
$ \Text
name ->
    (EntityMap -> Parser Entity) -> ParserE EntityMap Entity
forall e (f :: * -> *) a. (e -> f a) -> With e f a
E ((EntityMap -> Parser Entity) -> ParserE EntityMap Entity)
-> (EntityMap -> Parser Entity) -> ParserE EntityMap Entity
forall a b. (a -> b) -> a -> b
$ \EntityMap
em -> case Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em of
      Maybe Entity
Nothing -> [Text] -> Parser Entity
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown entity:", Text
name]
      Just Entity
e -> Entity -> Parser Entity
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e

instance ToJSON Entity where
  toJSON :: Entity -> Value
toJSON Entity
e =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"display" Key -> Display -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting Display Entity Display -> Display
forall s a. s -> Getting a s a -> a
^. Getting Display Entity Display
Lens' Entity Display
entityDisplay)
      , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName)
      , Key
"description" Key -> Document Syntax -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Document Syntax) Entity (Document Syntax)
-> Document Syntax
forall s a. s -> Getting a s a -> a
^. Getting (Document Syntax) Entity (Document Syntax)
Lens' Entity (Document Syntax)
entityDescription)
      , Key
"tags" Key -> Set Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting (Set Text) Entity (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^. Getting (Set Text) Entity (Set Text)
Lens' Entity (Set Text)
entityTags)
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"plural" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityPlural) | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityPlural)]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"orientation" Key -> Maybe Heading -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Maybe Heading) Entity (Maybe Heading) -> Maybe Heading
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Heading) Entity (Maybe Heading)
Lens' Entity (Maybe Heading)
entityOrientation) | Maybe Heading -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity
-> Getting (Maybe Heading) Entity (Maybe Heading) -> Maybe Heading
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Heading) Entity (Maybe Heading)
Lens' Entity (Maybe Heading)
entityOrientation)]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"growth" Key -> Maybe Growth -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Maybe Growth) Entity (Maybe Growth) -> Maybe Growth
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Growth) Entity (Maybe Growth)
Lens' Entity (Maybe Growth)
entityGrowth) | Maybe Growth -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity
-> Getting (Maybe Growth) Entity (Maybe Growth) -> Maybe Growth
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Growth) Entity (Maybe Growth)
Lens' Entity (Maybe Growth)
entityGrowth)]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"yields" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityYields) | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityYields)]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"properties" Key -> Set EntityProperty -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties) | Bool -> Bool
not (Bool -> Bool)
-> (Set EntityProperty -> Bool) -> Set EntityProperty -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EntityProperty -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set EntityProperty -> Bool) -> Set EntityProperty -> Bool
forall a b. (a -> b) -> a -> b
$ Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"capabilities" Key -> Capabilities (ExerciseCost Text) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Entity
e Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities) | Bool -> Bool
not (Bool -> Bool)
-> (Capabilities (ExerciseCost Text) -> Bool)
-> Capabilities (ExerciseCost Text)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Capability (ExerciseCost Text) -> Bool
forall k a. Map k a -> Bool
M.null (Map Capability (ExerciseCost Text) -> Bool)
-> (Capabilities (ExerciseCost Text)
    -> Map Capability (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Capabilities (ExerciseCost Text) -> Bool)
-> Capabilities (ExerciseCost Text) -> Bool
forall a b. (a -> b) -> a -> b
$ Entity
e Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities]

-- | Load entities from a data file called @entities.yaml@, producing
--   either an 'EntityMap' or a parse error.
loadEntities ::
  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
  m EntityMap
loadEntities :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m EntityMap
loadEntities = do
  let entityFile :: String
entityFile = String
"entities.yaml"
      entityFailure :: LoadingFailure -> SystemFailure
entityFailure = Asset -> String -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
Entities) String
entityFile
  String
fileName <- AssetData -> String -> m String
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Entities String
entityFile
  [Entity]
decoded <-
    (ParseException -> SystemFailure)
-> ThrowC ParseException m [Entity] -> m [Entity]
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow (LoadingFailure -> SystemFailure
entityFailure (LoadingFailure -> SystemFailure)
-> (ParseException -> LoadingFailure)
-> ParseException
-> SystemFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml) (ThrowC ParseException m [Entity] -> m [Entity])
-> (IO (Either ParseException [Entity])
    -> ThrowC ParseException m [Entity])
-> IO (Either ParseException [Entity])
-> m [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ParseException [Entity] -> ThrowC ParseException m [Entity]
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither (Either ParseException [Entity]
 -> ThrowC ParseException m [Entity])
-> (IO (Either ParseException [Entity])
    -> ThrowC ParseException m (Either ParseException [Entity]))
-> IO (Either ParseException [Entity])
-> ThrowC ParseException m [Entity]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Either ParseException [Entity])
-> ThrowC ParseException m (Either ParseException [Entity])
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO) (IO (Either ParseException [Entity]) -> m [Entity])
-> IO (Either ParseException [Entity]) -> m [Entity]
forall a b. (a -> b) -> a -> b
$
      String -> IO (Either ParseException [Entity])
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
fileName

  (LoadingFailure -> SystemFailure)
-> ThrowC LoadingFailure m () -> m ()
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow LoadingFailure -> SystemFailure
entityFailure (ThrowC LoadingFailure m () -> m ())
-> ThrowC LoadingFailure m () -> m ()
forall a b. (a -> b) -> a -> b
$ Set WorldAttr -> [Entity] -> ThrowC LoadingFailure m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
Set WorldAttr -> [Entity] -> m ()
validateEntityAttrRefs (Map WorldAttr PreservableColor -> Set WorldAttr
forall k a. Map k a -> Set k
M.keysSet Map WorldAttr PreservableColor
worldAttributes) [Entity]
decoded
  (LoadingFailure -> SystemFailure)
-> ThrowC LoadingFailure m EntityMap -> m EntityMap
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow LoadingFailure -> SystemFailure
entityFailure (ThrowC LoadingFailure m EntityMap -> m EntityMap)
-> ThrowC LoadingFailure m EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ [Entity] -> ThrowC LoadingFailure m EntityMap
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
[Entity] -> m EntityMap
buildEntityMap [Entity]
decoded

------------------------------------------------------------
-- 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 = (Entity -> a) -> (Entity -> a -> Entity) -> Lens Entity Entity a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Entity -> a
get (\Entity
e a
a -> Entity -> Entity
rehashEntity (Entity -> Entity) -> Entity -> Entity
forall a b. (a -> b) -> a -> b
$ Entity -> a -> Entity
set Entity
e a
a)

-- | 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 Int
entityHash = (Entity -> Int) -> (Int -> f Int) -> Entity -> f Entity
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Entity -> Int
_entityHash

-- | The 'Display' explaining how to draw this entity in the world display.
entityDisplay :: Lens' Entity Display
entityDisplay :: Lens' Entity Display
entityDisplay = (Entity -> Display)
-> (Entity -> Display -> Entity) -> Lens' Entity Display
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Display
_entityDisplay (\Entity
e Display
x -> Entity
e {_entityDisplay = x})

-- | The name of the entity.
entityName :: Lens' Entity EntityName
entityName :: Lens' Entity Text
entityName = (Entity -> Text) -> (Entity -> Text -> Entity) -> Lens' Entity Text
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Text
_entityName (\Entity
e Text
x -> Entity
e {_entityName = x})

-- | The irregular plural version of the entity's name, if there is
--   one.
entityPlural :: Lens' Entity (Maybe Text)
entityPlural :: Lens' Entity (Maybe Text)
entityPlural = (Entity -> Maybe Text)
-> (Entity -> Maybe Text -> Entity) -> Lens' Entity (Maybe Text)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Text
_entityPlural (\Entity
e Maybe Text
x -> Entity
e {_entityPlural = x})

-- | 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 :: Int -> Getter Entity Text
entityNameFor Int
1 = (Text -> f Text) -> Entity -> f Entity
Lens' Entity Text
entityName
entityNameFor Int
_ = (Entity -> Text) -> (Text -> f Text) -> Entity -> f Entity
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Entity -> Text) -> (Text -> f Text) -> Entity -> f Entity)
-> (Entity -> Text) -> (Text -> f Text) -> Entity -> f Entity
forall a b. (a -> b) -> a -> b
$ \Entity
e ->
  case Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityPlural of
    Just Text
pl -> Text
pl
    Maybe Text
Nothing -> Text -> Text
plural (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName)

-- | A longer, free-form description of the entity.  Each 'Text' value
--   represents a paragraph.
entityDescription :: Lens' Entity (Document Syntax)
entityDescription :: Lens' Entity (Document Syntax)
entityDescription = (Entity -> Document Syntax)
-> (Entity -> Document Syntax -> Entity)
-> Lens' Entity (Document Syntax)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Document Syntax
_entityDescription (\Entity
e Document Syntax
x -> Entity
e {_entityDescription = x})

-- | A set of categories to which the entity belongs
entityTags :: Lens' Entity (Set Text)
entityTags :: Lens' Entity (Set Text)
entityTags = (Entity -> Set Text)
-> (Entity -> Set Text -> Entity) -> Lens' Entity (Set Text)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set Text
_entityTags (\Entity
e Set Text
x -> Entity
e {_entityTags = x})

-- | The direction this entity is facing (if it has one).
entityOrientation :: Lens' Entity (Maybe Heading)
entityOrientation :: Lens' Entity (Maybe Heading)
entityOrientation = (Entity -> Maybe Heading)
-> (Entity -> Maybe Heading -> Entity)
-> Lens' Entity (Maybe Heading)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Heading
_entityOrientation (\Entity
e Maybe Heading
x -> Entity
e {_entityOrientation = x})

-- | How long this entity takes to grow, if it regrows.
entityGrowth :: Lens' Entity (Maybe Growth)
entityGrowth :: Lens' Entity (Maybe Growth)
entityGrowth = (Entity -> Maybe Growth)
-> (Entity -> Maybe Growth -> Entity)
-> Lens' Entity (Maybe Growth)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Growth
_entityGrowth (\Entity
e Maybe Growth
x -> Entity
e {_entityGrowth = x})

-- | Susceptibility to and duration of combustion
entityCombustion :: Lens' Entity (Maybe Combustibility)
entityCombustion :: Lens' Entity (Maybe Combustibility)
entityCombustion = (Entity -> Maybe Combustibility)
-> (Entity -> Maybe Combustibility -> Entity)
-> Lens' Entity (Maybe Combustibility)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Combustibility
_entityCombustion (\Entity
e Maybe Combustibility
x -> Entity
e {_entityCombustion = x})

-- | 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 = (Entity -> Maybe Text)
-> (Entity -> Maybe Text -> Entity) -> Lens' Entity (Maybe Text)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Maybe Text
_entityYields (\Entity
e Maybe Text
x -> Entity
e {_entityYields = x})

-- | The properties enjoyed by this entity.
entityProperties :: Lens' Entity (Set EntityProperty)
entityProperties :: Lens' Entity (Set EntityProperty)
entityProperties = (Entity -> Set EntityProperty)
-> (Entity -> Set EntityProperty -> Entity)
-> Lens' Entity (Set EntityProperty)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set EntityProperty
_entityProperties (\Entity
e Set EntityProperty
x -> Entity
e {_entityProperties = x})

-- | Test whether an entity has a certain property.
hasProperty :: Entity -> EntityProperty -> Bool
hasProperty :: Entity -> EntityProperty -> Bool
hasProperty Entity
e EntityProperty
p = EntityProperty
p EntityProperty -> Set EntityProperty -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties)

-- | The capabilities this entity provides when equipped.
entityCapabilities :: Lens' Entity (SingleEntityCapabilities EntityName)
entityCapabilities :: Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities = (Entity -> Capabilities (ExerciseCost Text))
-> (Entity -> Capabilities (ExerciseCost Text) -> Entity)
-> Lens' Entity (Capabilities (ExerciseCost Text))
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Capabilities (ExerciseCost Text)
_entityCapabilities (\Entity
e Capabilities (ExerciseCost Text)
x -> Entity
e {_entityCapabilities = x})

-- | The inventory of other entities carried by this entity.
entityBiomes :: Lens' Entity (Set TerrainType)
entityBiomes :: Lens' Entity (Set TerrainType)
entityBiomes = (Entity -> Set TerrainType)
-> (Entity -> Set TerrainType -> Entity)
-> Lens' Entity (Set TerrainType)
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Set TerrainType
_entityBiomes (\Entity
e Set TerrainType
x -> Entity
e {_entityBiomes = x})

-- | The inventory of other entities carried by this entity.
entityInventory :: Lens' Entity Inventory
entityInventory :: Lens' Entity Inventory
entityInventory = (Entity -> Inventory)
-> (Entity -> Inventory -> Entity) -> Lens' Entity Inventory
forall a.
(Entity -> a) -> (Entity -> a -> Entity) -> Lens' Entity a
hashedLens Entity -> Inventory
_entityInventory (\Entity
e Inventory
x -> Entity
e {_entityInventory = x})

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

-- | 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 (Int, 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 -> Int
inventoryHash :: Int
  }
  deriving (Int -> Inventory -> ShowS
[Inventory] -> ShowS
Inventory -> String
(Int -> Inventory -> ShowS)
-> (Inventory -> String)
-> ([Inventory] -> ShowS)
-> Show Inventory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inventory -> ShowS
showsPrec :: Int -> Inventory -> ShowS
$cshow :: Inventory -> String
show :: Inventory -> String
$cshowList :: [Inventory] -> ShowS
showList :: [Inventory] -> ShowS
Show, (forall x. Inventory -> Rep Inventory x)
-> (forall x. Rep Inventory x -> Inventory) -> Generic Inventory
forall x. Rep Inventory x -> Inventory
forall x. Inventory -> Rep Inventory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Inventory -> Rep Inventory x
from :: forall x. Inventory -> Rep Inventory x
$cto :: forall x. Rep Inventory x -> Inventory
to :: forall x. Rep Inventory x -> Inventory
Generic, Maybe Inventory
Value -> Parser [Inventory]
Value -> Parser Inventory
(Value -> Parser Inventory)
-> (Value -> Parser [Inventory])
-> Maybe Inventory
-> FromJSON Inventory
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Inventory
parseJSON :: Value -> Parser Inventory
$cparseJSONList :: Value -> Parser [Inventory]
parseJSONList :: Value -> Parser [Inventory]
$comittedField :: Maybe Inventory
omittedField :: Maybe Inventory
FromJSON, [Inventory] -> Value
[Inventory] -> Encoding
Inventory -> Bool
Inventory -> Value
Inventory -> Encoding
(Inventory -> Value)
-> (Inventory -> Encoding)
-> ([Inventory] -> Value)
-> ([Inventory] -> Encoding)
-> (Inventory -> Bool)
-> ToJSON Inventory
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Inventory -> Value
toJSON :: Inventory -> Value
$ctoEncoding :: Inventory -> Encoding
toEncoding :: Inventory -> Encoding
$ctoJSONList :: [Inventory] -> Value
toJSONList :: [Inventory] -> Value
$ctoEncodingList :: [Inventory] -> Encoding
toEncodingList :: [Inventory] -> Encoding
$comitField :: Inventory -> Bool
omitField :: Inventory -> Bool
ToJSON)

instance Hashable Inventory where
  -- Just return cached hash value.
  hash :: Inventory -> Int
hash = Inventory -> Int
inventoryHash
  hashWithSalt :: Int -> Inventory -> Int
hashWithSalt Int
s = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int -> Int) -> (Inventory -> Int) -> Inventory -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> Int
inventoryHash

-- | Inventories are compared by hash for efficiency.
instance Eq Inventory where
  == :: Inventory -> Inventory -> Bool
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Inventory -> Int) -> Inventory -> Inventory -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Inventory -> Int
forall a. Hashable a => a -> Int
hash

-- | Look up an entity in an inventory, returning the number of copies
--   contained.
lookup :: Entity -> Inventory -> Count
lookup :: Entity -> Inventory -> Int
lookup Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
_ Int
_) = Int -> ((Int, Entity) -> Int) -> Maybe (Int, Entity) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Entity) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Entity) -> Int) -> Maybe (Int, Entity) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs

-- | 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 (Int, Entity)
cs Map Text IntSet
byN Int
_) =
  [Entity] -> (IntSet -> [Entity]) -> Maybe IntSet -> [Entity]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Int -> Entity) -> [Int] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Entity) -> Entity
forall a b. (a, b) -> b
snd ((Int, Entity) -> Entity)
-> (Int -> (Int, Entity)) -> Int -> Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap (Int, Entity)
cs IntMap (Int, Entity) -> Int -> (Int, Entity)
forall a. IntMap a -> Int -> a
IM.!)) ([Int] -> [Entity]) -> (IntSet -> [Int]) -> IntSet -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.elems) (Text -> Map Text IntSet -> Maybe IntSet
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Text
T.toLower Text
name) Map Text IntSet
byN)

-- | 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 -> Int
countByName Text
name Inventory
inv =
  Int -> (Entity -> Int) -> Maybe Entity -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Entity -> Inventory -> Int
`lookup` Inventory
inv) ([Entity] -> Maybe Entity
forall a. [a] -> Maybe a
listToMaybe (Text -> Inventory -> [Entity]
lookupByName Text
name Inventory
inv))

-- | The empty inventory.
empty :: Inventory
empty :: Inventory
empty = IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory IntMap (Int, Entity)
forall a. IntMap a
IM.empty Map Text IntSet
forall k a. Map k a
M.empty Int
0

-- | Create an inventory containing one entity.
singleton :: Entity -> Inventory
singleton :: Entity -> Inventory
singleton = (Entity -> Inventory -> Inventory)
-> Inventory -> Entity -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Entity -> Inventory -> Inventory
insert Inventory
empty

-- | Insert 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 = Int -> Entity -> Inventory -> Inventory
insertCount Int
1

-- | Create an inventory from a list of entities.
fromList :: [Entity] -> Inventory
fromList :: [Entity] -> Inventory
fromList = (Inventory -> Entity -> Inventory)
-> Inventory -> [Entity] -> Inventory
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Entity -> Inventory -> Inventory)
-> Inventory -> Entity -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Entity -> Inventory -> Inventory
insert) Inventory
empty

-- | Create an inventory from a list of entities and their counts.
fromElems :: [(Count, Entity)] -> Inventory
fromElems :: [(Int, Entity)] -> Inventory
fromElems = (Inventory -> (Int, Entity) -> Inventory)
-> Inventory -> [(Int, Entity)] -> Inventory
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Int, Entity) -> Inventory -> Inventory)
-> Inventory -> (Int, Entity) -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> Entity -> Inventory -> Inventory)
-> (Int, Entity) -> Inventory -> Inventory
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Entity -> Inventory -> Inventory
insertCount)) Inventory
empty

-- | 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 :: Int -> Entity -> Inventory -> Inventory
insertCount Int
k Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
byN Int
h) =
  IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory
    (((Int, Entity) -> (Int, Entity) -> (Int, Entity))
-> Int
-> (Int, Entity)
-> IntMap (Int, Entity)
-> IntMap (Int, Entity)
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith (\(Int
m, Entity
_) (Int
n, Entity
_) -> (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, Entity
e)) (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) (Int
k, Entity
e) IntMap (Int, Entity)
cs)
    ((IntSet -> IntSet -> IntSet)
-> Text -> IntSet -> Map Text IntSet -> Map Text IntSet
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith IntSet -> IntSet -> IntSet
IS.union (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName) (Int -> IntSet
IS.singleton (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash)) Map Text IntSet
byN)
    (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash)) -- 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 :: Int
extra = if (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) Int -> IntMap (Int, Entity) -> Bool
forall a. Int -> IntMap a -> Bool
`IM.member` IntMap (Int, Entity)
cs then Int
0 else Int
1

-- | 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 -> Int
lookup Entity
e Inventory
inv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

-- | Check whether an inventory has an entry for the given entity,
--   even if there are 0 copies.  In particular this is used to
--   indicate whether a robot "knows about" an entity.
contains0plus :: Entity -> Inventory -> Bool
contains0plus :: Entity -> Inventory -> Bool
contains0plus Entity
e = Maybe (Int, Entity) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Int, Entity) -> Bool)
-> (Inventory -> Maybe (Int, Entity)) -> Inventory -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) (IntMap (Int, Entity) -> Maybe (Int, Entity))
-> (Inventory -> IntMap (Int, Entity))
-> Inventory
-> Maybe (Int, Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> IntMap (Int, Entity)
counts

-- | 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 = ((Int, Entity) -> Bool) -> [(Int, Entity)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Int
n, Entity
e) -> Entity -> Inventory -> Int
lookup Entity
e Inventory
inv2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) (Inventory -> [(Int, Entity)]
elems Inventory
inv1)

-- | 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 = ((Int, Entity) -> Bool) -> [(Int, Entity)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> ((Int, Entity) -> Int) -> (Int, Entity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Entity)] -> Bool)
-> (Inventory -> [(Int, Entity)]) -> Inventory -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems

-- | Compute the set of capabilities provided by the devices in an inventory.
inventoryCapabilities :: Inventory -> MultiEntityCapabilities Entity EntityName
inventoryCapabilities :: Inventory -> MultiEntityCapabilities Entity Text
inventoryCapabilities = [Entity] -> MultiEntityCapabilities Entity Text
combineEntityCaps ([Entity] -> MultiEntityCapabilities Entity Text)
-> (Inventory -> [Entity])
-> Inventory
-> MultiEntityCapabilities Entity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [Entity]
nonzeroEntities

-- | List elements that have at least one copy in the inventory.
nonzeroEntities :: Inventory -> [Entity]
nonzeroEntities :: Inventory -> [Entity]
nonzeroEntities = ((Int, Entity) -> Entity) -> [(Int, Entity)] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd ([(Int, Entity)] -> [Entity])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> Bool) -> [(Int, Entity)] -> [(Int, Entity)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool) -> ((Int, Entity) -> Int) -> (Int, Entity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Entity)] -> [(Int, Entity)])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [(Int, Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems

-- | List elements that possess a given Capability and
-- exist with nonzero count in the inventory.
extantElemsWithCapability :: Capability -> Inventory -> [Entity]
extantElemsWithCapability :: Capability -> Inventory -> [Entity]
extantElemsWithCapability Capability
cap =
  (Entity -> Bool) -> [Entity] -> [Entity]
forall a. (a -> Bool) -> [a] -> [a]
filter (Capability -> Map Capability (ExerciseCost Text) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Capability
cap (Map Capability (ExerciseCost Text) -> Bool)
-> (Entity -> Map Capability (ExerciseCost Text)) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Capabilities (ExerciseCost Text)
 -> Map Capability (ExerciseCost Text))
-> (Entity -> Capabilities (ExerciseCost Text))
-> Entity
-> Map Capability (ExerciseCost Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)) ([Entity] -> [Entity])
-> (Inventory -> [Entity]) -> Inventory -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [Entity]
nonzeroEntities

-- | Groups entities by the capabilities they offer.
entitiesByCapability :: Inventory -> Map Capability (NE.NonEmpty Entity)
entitiesByCapability :: Inventory -> Map Capability (NonEmpty Entity)
entitiesByCapability Inventory
inv =
  [(Capability, Entity)] -> Map Capability (NonEmpty Entity)
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples [(Capability, Entity)]
entityCapabilityPairs
 where
  getCaps :: Entity -> [Capability]
getCaps = Map Capability (ExerciseCost Text) -> [Capability]
forall k a. Map k a -> [k]
M.keys (Map Capability (ExerciseCost Text) -> [Capability])
-> (Entity -> Map Capability (ExerciseCost Text))
-> Entity
-> [Capability]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Capabilities (ExerciseCost Text)
 -> Map Capability (ExerciseCost Text))
-> (Entity -> Capabilities (ExerciseCost Text))
-> Entity
-> Map Capability (ExerciseCost Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)
  entityCapabilityPairs :: [(Capability, Entity)]
entityCapabilityPairs = ((Int, Entity) -> [(Capability, Entity)])
-> [(Int, Entity)] -> [(Capability, Entity)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\Entity
e -> (Capability -> (Capability, Entity))
-> [Capability] -> [(Capability, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (,Entity
e) ([Capability] -> [(Capability, Entity)])
-> [Capability] -> [(Capability, Entity)]
forall a b. (a -> b) -> a -> b
$ Entity -> [Capability]
getCaps Entity
e) (Entity -> [(Capability, Entity)])
-> ((Int, Entity) -> Entity)
-> (Int, Entity)
-> [(Capability, Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd) ([(Int, Entity)] -> [(Capability, Entity)])
-> [(Int, Entity)] -> [(Capability, Entity)]
forall a b. (a -> b) -> a -> b
$ Inventory -> [(Int, Entity)]
elems Inventory
inv

-- | Delete a single copy of a certain entity from an inventory.
delete :: Entity -> Inventory -> Inventory
delete :: Entity -> Inventory -> Inventory
delete = Int -> Entity -> Inventory -> Inventory
deleteCount Int
1

-- | Delete a specified number of copies of an entity from an inventory.
deleteCount :: Count -> Entity -> Inventory -> Inventory
deleteCount :: Int -> Entity -> Inventory -> Inventory
deleteCount Int
k Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
byN Int
h) = IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory IntMap (Int, Entity)
cs' Map Text IntSet
byN Int
h'
 where
  m :: Int
m = ((Int, Entity) -> Int
forall a b. (a, b) -> a
fst ((Int, Entity) -> Int) -> Maybe (Int, Entity) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs) Maybe Int -> Int -> Int
forall a. Maybe a -> a -> a
? Int
0
  cs' :: IntMap (Int, Entity)
cs' = ((Int, Entity) -> (Int, Entity))
-> Int -> IntMap (Int, Entity) -> IntMap (Int, Entity)
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (Int, Entity) -> (Int, Entity)
forall a. (Int, a) -> (Int, a)
removeCount (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs
  h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
k Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash)

  removeCount :: (Count, a) -> (Count, a)
  removeCount :: forall a. (Int, a) -> (Int, a)
removeCount (Int
n, a
a) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k), a
a)

-- | Delete all copies of a certain entity from an inventory.
deleteAll :: Entity -> Inventory -> Inventory
deleteAll :: Entity -> Inventory -> Inventory
deleteAll Entity
e (Inventory IntMap (Int, Entity)
cs Map Text IntSet
byN Int
h) =
  IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory
    (((Int, Entity) -> (Int, Entity))
-> Int -> IntMap (Int, Entity) -> IntMap (Int, Entity)
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust ((Int -> Int) -> (Int, Entity) -> (Int, Entity)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Int -> Int
forall a b. a -> b -> a
const Int
0)) (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs)
    Map Text IntSet
byN
    (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash))
 where
  n :: Int
n = ((Int, Entity) -> Int
forall a b. (a, b) -> a
fst ((Int, Entity) -> Int) -> Maybe (Int, Entity) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap (Int, Entity) -> Maybe (Int, Entity)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Entity
e Entity -> Getting Int Entity Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Entity Int
Getter Entity Int
entityHash) IntMap (Int, Entity)
cs) Maybe Int -> Int -> Int
forall a. Maybe a -> a -> a
? Int
0

-- | Get the entities in an inventory and their associated counts.
elems :: Inventory -> [(Count, Entity)]
elems :: Inventory -> [(Int, Entity)]
elems (Inventory IntMap (Int, Entity)
cs Map Text IntSet
_ Int
_) = IntMap (Int, Entity) -> [(Int, Entity)]
forall a. IntMap a -> [a]
IM.elems IntMap (Int, Entity)
cs

-- | Union two inventories.
union :: Inventory -> Inventory -> Inventory
union :: Inventory -> Inventory -> Inventory
union (Inventory IntMap (Int, Entity)
cs1 Map Text IntSet
byN1 Int
h1) (Inventory IntMap (Int, Entity)
cs2 Map Text IntSet
byN2 Int
h2) =
  IntMap (Int, Entity) -> Map Text IntSet -> Int -> Inventory
Inventory
    (((Int, Entity) -> (Int, Entity) -> (Int, Entity))
-> IntMap (Int, Entity)
-> IntMap (Int, Entity)
-> IntMap (Int, Entity)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith (\(Int
c1, Entity
e) (Int
c2, Entity
_) -> (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2, Entity
e)) IntMap (Int, Entity)
cs1 IntMap (Int, Entity)
cs2)
    ((IntSet -> IntSet -> IntSet)
-> Map Text IntSet -> Map Text IntSet -> Map Text IntSet
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith IntSet -> IntSet -> IntSet
IS.union Map Text IntSet
byN1 Map Text IntSet
byN2)
    (Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
common)
 where
  -- 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 :: Int
common = (Int -> Int -> Int) -> Int -> IntSet -> Int
forall a. (a -> Int -> a) -> a -> IntSet -> a
IS.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (IntSet -> Int) -> IntSet -> Int
forall a b. (a -> b) -> a -> b
$ IntMap (Int, Entity) -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap (Int, Entity)
cs1 IntSet -> IntSet -> IntSet
`IS.intersection` IntMap (Int, Entity) -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet IntMap (Int, Entity)
cs2

-- | Subtract the second inventory from the first.
difference :: Inventory -> Inventory -> Inventory
difference :: Inventory -> Inventory -> Inventory
difference Inventory
inv1 = (Inventory -> (Int, Entity) -> Inventory)
-> Inventory -> [(Int, Entity)] -> Inventory
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Int, Entity) -> Inventory -> Inventory)
-> Inventory -> (Int, Entity) -> Inventory
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> Entity -> Inventory -> Inventory)
-> (Int, Entity) -> Inventory -> Inventory
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Entity -> Inventory -> Inventory
deleteCount)) Inventory
inv1 ([(Int, Entity)] -> Inventory)
-> (Inventory -> [(Int, Entity)]) -> Inventory -> Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems