module Swarm.Game.Scenario.Objective.WinCheck where
import Data.Aeson
import Data.BoolExpr qualified as BE
import Data.BoolExpr.Simplify qualified as Simplify
import Data.List (partition)
import Data.Map qualified as M
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Generics (Generic)
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Logic as L
didWin :: ObjectiveCompletion -> Bool
didWin :: ObjectiveCompletion -> Bool
didWin ObjectiveCompletion
oc = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Objective -> Bool
_objectiveOptional forall a b. (a -> b) -> a -> b
$ CompletionBuckets -> [Objective]
incomplete CompletionBuckets
buckets forall a. Semigroup a => a -> a -> a
<> CompletionBuckets -> [Objective]
unwinnable CompletionBuckets
buckets
where
buckets :: CompletionBuckets
buckets = ObjectiveCompletion -> CompletionBuckets
completionBuckets ObjectiveCompletion
oc
didLose :: ObjectiveCompletion -> Bool
didLose :: ObjectiveCompletion -> Bool
didLose ObjectiveCompletion
oc = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Objective -> Bool
_objectiveOptional forall a b. (a -> b) -> a -> b
$ CompletionBuckets -> [Objective]
unwinnable CompletionBuckets
buckets
where
buckets :: CompletionBuckets
buckets = ObjectiveCompletion -> CompletionBuckets
completionBuckets ObjectiveCompletion
oc
isPrereqsSatisfied :: ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied :: ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied ObjectiveCompletion
completions =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True PrerequisiteConfig -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Objective -> Maybe PrerequisiteConfig
_objectivePrerequisite
where
f :: PrerequisiteConfig -> Bool
f = forall a. (a -> Bool) -> BoolExpr a -> Bool
BE.evalBoolExpr ObjectiveLabel -> Bool
getTruth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Prerequisite a -> BoolExpr a
L.toBoolExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrerequisiteConfig -> Prerequisite ObjectiveLabel
logic
getTruth :: ObjectiveLabel -> Bool
getTruth :: ObjectiveLabel -> Bool
getTruth ObjectiveLabel
label = forall a. Ord a => a -> Set a -> Bool
Set.member ObjectiveLabel
label forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> Set ObjectiveLabel
completedIDs ObjectiveCompletion
completions
isUnwinnablePrereq :: Set ObjectiveLabel -> Prerequisite ObjectiveLabel -> Bool
isUnwinnablePrereq :: Set ObjectiveLabel -> Prerequisite ObjectiveLabel -> Bool
isUnwinnablePrereq Set ObjectiveLabel
completedObjectives =
forall a. Ord a => BoolExpr a -> Bool
Simplify.cannotBeTrue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Map a Bool -> BoolExpr a -> BoolExpr a
Simplify.replace Map ObjectiveLabel Bool
boolMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Prerequisite a -> BoolExpr a
L.toBoolExpr
where
boolMap :: Map ObjectiveLabel Bool
boolMap =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True) forall a b. (a -> b) -> a -> b
$
forall a. Set a -> [a]
Set.toList Set ObjectiveLabel
completedObjectives
isUnwinnable :: ObjectiveCompletion -> Objective -> Bool
isUnwinnable :: ObjectiveCompletion -> Objective -> Bool
isUnwinnable ObjectiveCompletion
completions Objective
obj =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Set ObjectiveLabel -> Prerequisite ObjectiveLabel -> Bool
isUnwinnablePrereq (ObjectiveCompletion -> Set ObjectiveLabel
completedIDs ObjectiveCompletion
completions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrerequisiteConfig -> Prerequisite ObjectiveLabel
logic) forall a b. (a -> b) -> a -> b
$ Objective -> Maybe PrerequisiteConfig
_objectivePrerequisite Objective
obj
partitionActiveObjectives :: ObjectiveCompletion -> ([Objective], [Objective])
partitionActiveObjectives :: ObjectiveCompletion -> ([Objective], [Objective])
partitionActiveObjectives ObjectiveCompletion
oc =
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied ObjectiveCompletion
oc) forall a b. (a -> b) -> a -> b
$
CompletionBuckets -> [Objective]
incomplete forall a b. (a -> b) -> a -> b
$
ObjectiveCompletion -> CompletionBuckets
completionBuckets ObjectiveCompletion
oc
getActiveObjectives :: ObjectiveCompletion -> [Objective]
getActiveObjectives :: ObjectiveCompletion -> [Objective]
getActiveObjectives =
forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectiveCompletion -> ([Objective], [Objective])
partitionActiveObjectives
data PrereqSatisfaction = PrereqSatisfaction
{ PrereqSatisfaction -> Objective
objective :: Objective
, PrereqSatisfaction -> Set (Signed ObjectiveLabel)
deps :: Set (BE.Signed ObjectiveLabel)
, PrereqSatisfaction -> Bool
prereqsSatisfied :: Bool
}
deriving (forall x. Rep PrereqSatisfaction x -> PrereqSatisfaction
forall x. PrereqSatisfaction -> Rep PrereqSatisfaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrereqSatisfaction x -> PrereqSatisfaction
$cfrom :: forall x. PrereqSatisfaction -> Rep PrereqSatisfaction x
Generic, [PrereqSatisfaction] -> Encoding
[PrereqSatisfaction] -> Value
PrereqSatisfaction -> Encoding
PrereqSatisfaction -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PrereqSatisfaction] -> Encoding
$ctoEncodingList :: [PrereqSatisfaction] -> Encoding
toJSONList :: [PrereqSatisfaction] -> Value
$ctoJSONList :: [PrereqSatisfaction] -> Value
toEncoding :: PrereqSatisfaction -> Encoding
$ctoEncoding :: PrereqSatisfaction -> Encoding
toJSON :: PrereqSatisfaction -> Value
$ctoJSON :: PrereqSatisfaction -> Value
ToJSON)
getSatisfaction :: ObjectiveCompletion -> [PrereqSatisfaction]
getSatisfaction :: ObjectiveCompletion -> [PrereqSatisfaction]
getSatisfaction ObjectiveCompletion
oc =
forall a b. (a -> b) -> [a] -> [b]
map Objective -> PrereqSatisfaction
f forall a b. (a -> b) -> a -> b
$
CompletionBuckets -> [Objective]
listAllObjectives forall a b. (a -> b) -> a -> b
$
ObjectiveCompletion -> CompletionBuckets
completionBuckets ObjectiveCompletion
oc
where
f :: Objective -> PrereqSatisfaction
f Objective
y =
Objective
-> Set (Signed ObjectiveLabel) -> Bool -> PrereqSatisfaction
PrereqSatisfaction
Objective
y
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a. Ord a => Prerequisite a -> Set (Signed a)
getDistinctConstants forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrerequisiteConfig -> Prerequisite ObjectiveLabel
logic) forall a b. (a -> b) -> a -> b
$ Objective -> Maybe PrerequisiteConfig
_objectivePrerequisite Objective
y)
(ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied ObjectiveCompletion
oc Objective
y)
getDistinctConstants :: (Ord a) => Prerequisite a -> Set (BE.Signed a)
getDistinctConstants :: forall a. Ord a => Prerequisite a -> Set (Signed a)
getDistinctConstants = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BoolExpr a -> [Signed a]
BE.constants forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Prerequisite a -> BoolExpr a
toBoolExpr