{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Swarm.Game.Recipe
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A recipe represents some kind of process for transforming
-- some input entities into some output entities.
module Swarm.Game.Recipe (
  -- * Ingredient lists and recipes
  IngredientList,
  Recipe (..),
  recipeInputs,
  recipeOutputs,
  recipeRequirements,
  recipeTime,
  recipeWeight,

  -- * Loading recipes
  loadRecipes,
  outRecipeMap,
  inRecipeMap,
  reqRecipeMap,

  -- * Looking up recipes
  MissingIngredient (..),
  MissingType (..),
  knowsIngredientsFor,
  recipesFor,
  make,
  make',
) where

import Control.Lens hiding (from, (.=))
import Data.Bifunctor (second)
import Data.Either.Validation
import Data.IntMap (IntMap)
import Data.IntMap qualified as IM
import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml
import GHC.Generics (Generic)
import Witch

import Control.Algebra (Has)
import Control.Carrier.Lift (Lift, sendIO)
import Control.Carrier.Throw.Either (runThrow, throwError)
import Swarm.Game.Entity as E
import Swarm.Util
import Swarm.Util.Yaml

-- | An ingredient list is a list of entities with multiplicity.  It
--   is polymorphic in the entity type so that we can use either
--   entity names when serializing, or actual entity objects while the
--   game is running.
type IngredientList e = [(Count, e)]

-- | A recipe is just a list of input entities and a list of output
--   entities (both with multiplicity).  The idea is that it
--   represents some kind of process where the inputs are
--   transformed into the outputs.
data Recipe e = Recipe
  { forall e. Recipe e -> IngredientList e
_recipeInputs :: IngredientList e
  , forall e. Recipe e -> IngredientList e
_recipeOutputs :: IngredientList e
  , forall e. Recipe e -> IngredientList e
_recipeRequirements :: IngredientList e
  , forall e. Recipe e -> Integer
_recipeTime :: Integer
  , forall e. Recipe e -> Integer
_recipeWeight :: Integer
  }
  deriving (Recipe e -> Recipe e -> Bool
forall e. Eq e => Recipe e -> Recipe e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recipe e -> Recipe e -> Bool
$c/= :: forall e. Eq e => Recipe e -> Recipe e -> Bool
== :: Recipe e -> Recipe e -> Bool
$c== :: forall e. Eq e => Recipe e -> Recipe e -> Bool
Eq, Recipe e -> Recipe e -> Bool
Recipe e -> Recipe e -> Ordering
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
forall {e}. Ord e => Eq (Recipe e)
forall e. Ord e => Recipe e -> Recipe e -> Bool
forall e. Ord e => Recipe e -> Recipe e -> Ordering
forall e. Ord e => Recipe e -> Recipe e -> Recipe e
min :: Recipe e -> Recipe e -> Recipe e
$cmin :: forall e. Ord e => Recipe e -> Recipe e -> Recipe e
max :: Recipe e -> Recipe e -> Recipe e
$cmax :: forall e. Ord e => Recipe e -> Recipe e -> Recipe e
>= :: Recipe e -> Recipe e -> Bool
$c>= :: forall e. Ord e => Recipe e -> Recipe e -> Bool
> :: Recipe e -> Recipe e -> Bool
$c> :: forall e. Ord e => Recipe e -> Recipe e -> Bool
<= :: Recipe e -> Recipe e -> Bool
$c<= :: forall e. Ord e => Recipe e -> Recipe e -> Bool
< :: Recipe e -> Recipe e -> Bool
$c< :: forall e. Ord e => Recipe e -> Recipe e -> Bool
compare :: Recipe e -> Recipe e -> Ordering
$ccompare :: forall e. Ord e => Recipe e -> Recipe e -> Ordering
Ord, Count -> Recipe e -> ShowS
forall e. Show e => Count -> Recipe e -> ShowS
forall e. Show e => [Recipe e] -> ShowS
forall e. Show e => Recipe e -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recipe e] -> ShowS
$cshowList :: forall e. Show e => [Recipe e] -> ShowS
show :: Recipe e -> String
$cshow :: forall e. Show e => Recipe e -> String
showsPrec :: Count -> Recipe e -> ShowS
$cshowsPrec :: forall e. Show e => Count -> Recipe e -> ShowS
Show, forall a b. a -> Recipe b -> Recipe a
forall a b. (a -> b) -> Recipe a -> Recipe b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Recipe b -> Recipe a
$c<$ :: forall a b. a -> Recipe b -> Recipe a
fmap :: forall a b. (a -> b) -> Recipe a -> Recipe b
$cfmap :: forall a b. (a -> b) -> Recipe a -> Recipe b
Functor, forall a. Eq a => a -> Recipe a -> Bool
forall a. Num a => Recipe a -> a
forall a. Ord a => Recipe a -> a
forall m. Monoid m => Recipe m -> m
forall a. Recipe a -> Bool
forall a. Recipe a -> Count
forall a. Recipe a -> [a]
forall a. (a -> a -> a) -> Recipe a -> a
forall m a. Monoid m => (a -> m) -> Recipe a -> m
forall b a. (b -> a -> b) -> b -> Recipe a -> b
forall a b. (a -> b -> b) -> b -> Recipe a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Count)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Recipe a -> a
$cproduct :: forall a. Num a => Recipe a -> a
sum :: forall a. Num a => Recipe a -> a
$csum :: forall a. Num a => Recipe a -> a
minimum :: forall a. Ord a => Recipe a -> a
$cminimum :: forall a. Ord a => Recipe a -> a
maximum :: forall a. Ord a => Recipe a -> a
$cmaximum :: forall a. Ord a => Recipe a -> a
elem :: forall a. Eq a => a -> Recipe a -> Bool
$celem :: forall a. Eq a => a -> Recipe a -> Bool
length :: forall a. Recipe a -> Count
$clength :: forall a. Recipe a -> Count
null :: forall a. Recipe a -> Bool
$cnull :: forall a. Recipe a -> Bool
toList :: forall a. Recipe a -> [a]
$ctoList :: forall a. Recipe a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Recipe a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Recipe a -> a
foldr1 :: forall a. (a -> a -> a) -> Recipe a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Recipe a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Recipe a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Recipe a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Recipe a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Recipe a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Recipe a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Recipe a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Recipe a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Recipe a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Recipe a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Recipe a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Recipe a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Recipe a -> m
fold :: forall m. Monoid m => Recipe m -> m
$cfold :: forall m. Monoid m => Recipe m -> m
Foldable, Functor Recipe
Foldable Recipe
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Recipe (m a) -> m (Recipe a)
forall (f :: * -> *) a.
Applicative f =>
Recipe (f a) -> f (Recipe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Recipe a -> m (Recipe b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Recipe a -> f (Recipe b)
sequence :: forall (m :: * -> *) a. Monad m => Recipe (m a) -> m (Recipe a)
$csequence :: forall (m :: * -> *) a. Monad m => Recipe (m a) -> m (Recipe a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Recipe a -> m (Recipe b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Recipe a -> m (Recipe b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Recipe (f a) -> f (Recipe a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Recipe (f a) -> f (Recipe a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Recipe a -> f (Recipe b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Recipe a -> f (Recipe b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (Recipe e) x -> Recipe e
forall e x. Recipe e -> Rep (Recipe e) x
$cto :: forall e x. Rep (Recipe e) x -> Recipe e
$cfrom :: forall e x. Recipe e -> Rep (Recipe e) x
Generic)

deriving instance ToJSON (Recipe Entity)
deriving instance FromJSON (Recipe Entity)

makeLensesWith (lensRules & generateSignatures .~ False) ''Recipe

-- | The inputs to a recipe.
recipeInputs :: Lens' (Recipe e) (IngredientList e)

-- | The outputs from a recipe.
recipeOutputs :: Lens' (Recipe e) (IngredientList e)

-- | The time required to finish a recipe.
recipeTime :: Lens' (Recipe e) Integer

-- | Other entities which the recipe requires you to have, but which
--   are not consumed by the recipe (e.g. a furnace).
recipeRequirements :: Lens' (Recipe e) (IngredientList e)

-- | How this recipe is weighted against other recipes.  Any time
--   there are multiple valid recipes that fit certain criteria, one
--   of the recipes will be randomly chosen with probability
--   proportional to its weight.
recipeWeight :: Lens' (Recipe e) Integer

------------------------------------------------------------
-- Serializing
------------------------------------------------------------

instance ToJSON (Recipe Text) where
  toJSON :: Recipe Text -> Value
toJSON (Recipe IngredientList Text
ins IngredientList Text
outs IngredientList Text
reqs Integer
time Integer
weight) =
    [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
      [ Key
"in" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IngredientList Text
ins
      , Key
"out" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IngredientList Text
outs
      ]
        forall a. [a] -> [a] -> [a]
++ [Key
"required" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IngredientList Text
reqs | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null IngredientList Text
reqs)]
        forall a. [a] -> [a] -> [a]
++ [Key
"time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
time | Integer
time forall a. Eq a => a -> a -> Bool
/= Integer
1]
        forall a. [a] -> [a] -> [a]
++ [Key
"weight" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
weight | Integer
weight forall a. Eq a => a -> a -> Bool
/= Integer
1]

instance FromJSON (Recipe Text) where
  parseJSON :: Value -> Parser (Recipe Text)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Recipe" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    forall e.
IngredientList e
-> IngredientList e
-> IngredientList e
-> Integer
-> Integer
-> Recipe e
Recipe
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"in"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"out"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"time" forall a. Parser (Maybe a) -> a -> Parser a
.!= Integer
1
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"weight" forall a. Parser (Maybe a) -> a -> Parser a
.!= Integer
1

-- | Given an 'EntityMap', turn a list of recipes containing /names/
--   of entities into a list of recipes containing actual 'Entity'
--   records; or.
resolveRecipes :: EntityMap -> [Recipe Text] -> Validation [Text] [Recipe Entity]
resolveRecipes :: EntityMap -> [Recipe Text] -> Validation [Text] [Recipe Entity]
resolveRecipes EntityMap
em = (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (\Text
t -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. e -> Validation e a
Failure [Text
t]) forall e a. a -> Validation e a
Success (Text -> EntityMap -> Maybe Entity
lookupEntityName Text
t EntityMap
em))

instance FromJSONE EntityMap (Recipe Entity) where
  parseJSONE :: Value -> ParserE EntityMap (Recipe Entity)
parseJSONE Value
v = do
    Recipe Text
rt <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON @(Recipe Text) Value
v
    EntityMap
em <- forall (f :: * -> *) e. Monad f => With e f e
getE
    let erEnt :: Validation [Text] (Recipe Entity)
        erEnt :: Validation [Text] (Recipe Entity)
erEnt = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Text
t -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. e -> Validation e a
Failure [Text
t]) forall e a. a -> Validation e a
Success (Text -> EntityMap -> Maybe Entity
lookupEntityName Text
t EntityMap
em)) Recipe Text
rt
    case forall e a. Validation e a -> Either e a
validationToEither Validation [Text] (Recipe Entity)
erEnt of
      Right Recipe Entity
rEnt -> forall (m :: * -> *) a. Monad m => a -> m a
return Recipe Entity
rEnt
      Left [Text]
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ [Text]
err

-- | Given an already loaded 'EntityMap', try to load a list of
--   recipes from the data file @recipes.yaml@.
loadRecipes :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text [Recipe Entity])
loadRecipes :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
EntityMap -> m (Either Text [Recipe Entity])
loadRecipes EntityMap
em = forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow forall a b. (a -> b) -> a -> b
$ do
  let f :: String
f = String
"recipes.yaml"
  Maybe String
mayFileName <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
getDataFileNameSafe String
f
  case Maybe String
mayFileName of
    Maybe String
Nothing -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (String -> IO Text
dataNotFound String
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError
    Just String
fileName -> do
      Either ParseException [Recipe Text]
res <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither @[Recipe Text] String
fileName
      [Recipe Text]
textRecipes <- Either ParseException [Recipe Text]
res forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) b a.
Has (Throw e) sig m =>
Either b a -> (b -> e) -> m a
`isRightOr` (forall source target. From source target => source -> target
from @String @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> String
prettyPrintParseException)
      EntityMap -> [Recipe Text] -> Validation [Text] [Recipe Entity]
resolveRecipes EntityMap
em [Recipe Text]
textRecipes
        forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) b a.
Has (Throw e) sig m =>
Validation b a -> (b -> e) -> m a
`isSuccessOr` (Text -> Text -> Text
T.append Text
"Unknown entities in recipe(s): " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
", ")

------------------------------------------------------------

-- | Build a map of recipes either by inputs or outputs.
buildRecipeMap ::
  Getter (Recipe Entity) (IngredientList Entity) ->
  [Recipe Entity] ->
  IntMap [Recipe Entity]
buildRecipeMap :: Getter (Recipe Entity) (IngredientList Entity)
-> [Recipe Entity] -> IntMap [Recipe Entity]
buildRecipeMap Getter (Recipe Entity) (IngredientList Entity)
select [Recipe Entity]
recipeList =
  forall a. (a -> a -> a) -> [(Count, a)] -> IntMap a
IM.fromListWith forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. a -> [a] -> [a]
: [])) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Recipe Entity -> [(Count, Recipe Entity)]
mk [Recipe Entity]
recipeList))
 where
  mk :: Recipe Entity -> [(Count, Recipe Entity)]
mk Recipe Entity
r = [(Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash, Recipe Entity
r) | (Count
_, Entity
e) <- Recipe Entity
r forall s a. s -> Getting a s a -> a
^. Getter (Recipe Entity) (IngredientList Entity)
select]

-- | Build a map of recipes indexed by output ingredients.
outRecipeMap :: [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap :: [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap = Getter (Recipe Entity) (IngredientList Entity)
-> [Recipe Entity] -> IntMap [Recipe Entity]
buildRecipeMap forall e. Lens' (Recipe e) (IngredientList e)
recipeOutputs

-- | Build a map of recipes indexed by input ingredients.
inRecipeMap :: [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap :: [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap = Getter (Recipe Entity) (IngredientList Entity)
-> [Recipe Entity] -> IntMap [Recipe Entity]
buildRecipeMap forall e. Lens' (Recipe e) (IngredientList e)
recipeInputs

-- | Build a map of recipes indexed by requirements.
reqRecipeMap :: [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap :: [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap = Getter (Recipe Entity) (IngredientList Entity)
-> [Recipe Entity] -> IntMap [Recipe Entity]
buildRecipeMap forall e. Lens' (Recipe e) (IngredientList e)
recipeRequirements

-- | Get a list of all the recipes for the given entity.  Look up an
--   entity in either an 'inRecipeMap' or 'outRecipeMap' depending on
--   whether you want to know recipes that consume or produce the
--   given entity, respectively.
recipesFor :: IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor :: IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor IntMap [Recipe Entity]
rm Entity
e = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a. Count -> IntMap a -> Maybe a
IM.lookup (Entity
e forall s a. s -> Getting a s a -> a
^. Getter Entity Count
entityHash) IntMap [Recipe Entity]
rm

data MissingIngredient = MissingIngredient MissingType Count Entity
  deriving (Count -> MissingIngredient -> ShowS
[MissingIngredient] -> ShowS
MissingIngredient -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MissingIngredient] -> ShowS
$cshowList :: [MissingIngredient] -> ShowS
show :: MissingIngredient -> String
$cshow :: MissingIngredient -> String
showsPrec :: Count -> MissingIngredient -> ShowS
$cshowsPrec :: Count -> MissingIngredient -> ShowS
Show, MissingIngredient -> MissingIngredient -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MissingIngredient -> MissingIngredient -> Bool
$c/= :: MissingIngredient -> MissingIngredient -> Bool
== :: MissingIngredient -> MissingIngredient -> Bool
$c== :: MissingIngredient -> MissingIngredient -> Bool
Eq)

data MissingType = MissingInput | MissingCatalyst
  deriving (Count -> MissingType -> ShowS
[MissingType] -> ShowS
MissingType -> String
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MissingType] -> ShowS
$cshowList :: [MissingType] -> ShowS
show :: MissingType -> String
$cshow :: MissingType -> String
showsPrec :: Count -> MissingType -> ShowS
$cshowsPrec :: Count -> MissingType -> ShowS
Show, MissingType -> MissingType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MissingType -> MissingType -> Bool
$c/= :: MissingType -> MissingType -> Bool
== :: MissingType -> MissingType -> Bool
$c== :: MissingType -> MissingType -> Bool
Eq)

-- | Figure out which ingredients (if any) are lacking from an
--   inventory to be able to carry out the recipe.
--   Requirements are not consumed and so can use installed.
missingIngredientsFor :: (Inventory, Inventory) -> Recipe Entity -> [MissingIngredient]
missingIngredientsFor :: (Inventory, Inventory) -> Recipe Entity -> [MissingIngredient]
missingIngredientsFor (Inventory
inv, Inventory
ins) (Recipe IngredientList Entity
inps IngredientList Entity
_ IngredientList Entity
reqs Integer
_ Integer
_) =
  MissingType -> IngredientList Entity -> [MissingIngredient]
mkMissing MissingType
MissingInput (Inventory -> IngredientList Entity -> IngredientList Entity
findLacking Inventory
inv IngredientList Entity
inps)
    forall a. Semigroup a => a -> a -> a
<> MissingType -> IngredientList Entity -> [MissingIngredient]
mkMissing MissingType
MissingCatalyst (Inventory -> IngredientList Entity -> IngredientList Entity
findLacking Inventory
ins (Inventory -> IngredientList Entity -> IngredientList Entity
findLacking Inventory
inv IngredientList Entity
reqs))
 where
  mkMissing :: MissingType -> IngredientList Entity -> [MissingIngredient]
mkMissing MissingType
k = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (MissingType -> Count -> Entity -> MissingIngredient
MissingIngredient MissingType
k))
  findLacking :: Inventory -> IngredientList Entity -> IngredientList Entity
findLacking Inventory
inven = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Count
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Inventory -> (Count, Entity) -> (Count, Entity)
countNeeded Inventory
inven)
  countNeeded :: Inventory -> (Count, Entity) -> (Count, Entity)
countNeeded Inventory
inven (Count
need, Entity
entity) = (Count
need forall a. Num a => a -> a -> a
- Entity -> Inventory -> Count
E.lookup Entity
entity Inventory
inven, Entity
entity)

-- | Figure out if a recipe is available, but it can be lacking items.
knowsIngredientsFor :: (Inventory, Inventory) -> Recipe Entity -> Bool
knowsIngredientsFor :: (Inventory, Inventory) -> Recipe Entity -> Bool
knowsIngredientsFor (Inventory
inv, Inventory
ins) Recipe Entity
recipe =
  forall {t :: * -> *} {a}.
Foldable t =>
Inventory -> t (a, Entity) -> Bool
knowsAll Inventory
inv (Recipe Entity
recipe forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) (IngredientList e)
recipeInputs) Bool -> Bool -> Bool
&& forall {t :: * -> *} {a}.
Foldable t =>
Inventory -> t (a, Entity) -> Bool
knowsAll Inventory
ins (Recipe Entity
recipe forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) (IngredientList e)
recipeRequirements)
 where
  knowsAll :: Inventory -> t (a, Entity) -> Bool
knowsAll Inventory
xs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Inventory -> Entity -> Bool
E.contains Inventory
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- | Try to make a recipe, deleting the recipe's inputs from the
--   inventory. Return either a description of which items are
--   lacking, if the inventory does not contain sufficient inputs,
--   or an inventory without inputs and function adding outputs if
--   it was successful.
make ::
  -- robots inventory and installed devices
  (Inventory, Inventory) ->
  -- considered recipe
  Recipe Entity ->
  -- failure (with count of missing) or success with a new inventory,
  -- a function to add results and the recipe repeated
  Either
    [MissingIngredient]
    (Inventory, Inventory -> Inventory, Recipe Entity)
make :: (Inventory, Inventory)
-> Recipe Entity
-> Either
     [MissingIngredient]
     (Inventory, Inventory -> Inventory, Recipe Entity)
make (Inventory, Inventory)
invs Recipe Entity
r = forall {t :: * -> *} {a}.
Foldable t =>
(a, t (Count, Entity))
-> (a, Inventory -> Inventory, Recipe Entity)
finish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inventory, Inventory)
-> Recipe Entity
-> Either [MissingIngredient] (Inventory, IngredientList Entity)
make' (Inventory, Inventory)
invs Recipe Entity
r
 where
  finish :: (a, t (Count, Entity))
-> (a, Inventory -> Inventory, Recipe Entity)
finish (a
invTaken, t (Count, Entity)
out) = (a
invTaken, forall {t :: * -> *}.
Foldable t =>
t (Count, Entity) -> Inventory -> Inventory
addOuts t (Count, Entity)
out, Recipe Entity
r)
  addOuts :: t (Count, Entity) -> Inventory -> Inventory
addOuts t (Count, Entity)
out Inventory
inv' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Count -> Entity -> Inventory -> Inventory
insertCount) Inventory
inv' t (Count, Entity)
out

-- | Try to make a recipe, but do not insert it yet.
make' :: (Inventory, Inventory) -> Recipe Entity -> Either [MissingIngredient] (Inventory, IngredientList Entity)
make' :: (Inventory, Inventory)
-> Recipe Entity
-> Either [MissingIngredient] (Inventory, IngredientList Entity)
make' invs :: (Inventory, Inventory)
invs@(Inventory
inv, Inventory
_) Recipe Entity
r =
  case (Inventory, Inventory) -> Recipe Entity -> [MissingIngredient]
missingIngredientsFor (Inventory, Inventory)
invs Recipe Entity
r of
    [] ->
      let removed :: Inventory
removed = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Count -> Entity -> Inventory -> Inventory
deleteCount)) Inventory
inv (Recipe Entity
r forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) (IngredientList e)
recipeInputs)
       in forall a b. b -> Either a b
Right (Inventory
removed, Recipe Entity
r forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) (IngredientList e)
recipeOutputs)
    [MissingIngredient]
missing -> forall a b. a -> Either a b
Left [MissingIngredient]
missing