{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Utilities to check whether conditions are met for a game win/loss.
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 Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Logic as L

-- | We have "won" if all of the "unwinnable" or remaining "incomplete" objectives are "optional".
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

-- | We have "lost" if any of the "unwinnable" objectives not "optional".
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

-- | The first element of the returned tuple consists of "active" objectives,
-- the second element "inactive".
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

deriving instance Generic (BE.Signed ObjectiveLabel)
deriving instance ToJSON (BE.Signed ObjectiveLabel)

-- | For debugging only (via Web API)
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)

instance ToSample PrereqSatisfaction where
  toSamples :: Proxy PrereqSatisfaction -> [(ObjectiveLabel, PrereqSatisfaction)]
toSamples Proxy PrereqSatisfaction
_ = forall a. [(ObjectiveLabel, a)]
SD.noSamples

-- | Used only by the web interface for debugging
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