{-# 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 Control.Lens (andOf, view, (^.), (^..))
import Data.Aeson (ToJSON)
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.Graph (getDistinctConstants)
import Swarm.Game.Scenario.Objective.Logic as L
import Swarm.Util.Lens (concatFold)

-- | We have "won" if all of the "unwinnable" or remaining "incomplete" objectives are "optional".
didWin :: ObjectiveCompletion -> Bool
didWin :: ObjectiveCompletion -> Bool
didWin = Getting All ObjectiveCompletion Bool -> ObjectiveCompletion -> Bool
forall s. Getting All s Bool -> s -> Bool
andOf (((Objective -> f Objective)
-> ObjectiveCompletion -> f ObjectiveCompletion
Fold ObjectiveCompletion Objective
incompleteObjectives Fold ObjectiveCompletion Objective
-> Fold ObjectiveCompletion Objective
-> Fold ObjectiveCompletion Objective
forall s a. Fold s a -> Fold s a -> Fold s a
`concatFold` (Objective -> f Objective)
-> ObjectiveCompletion -> f ObjectiveCompletion
Fold ObjectiveCompletion Objective
unwinnableObjectives) ((Objective -> Const All Objective)
 -> ObjectiveCompletion -> Const All ObjectiveCompletion)
-> ((Bool -> Const All Bool) -> Objective -> Const All Objective)
-> Getting All ObjectiveCompletion Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const All Bool) -> Objective -> Const All Objective
Lens' Objective Bool
objectiveOptional)

-- | We have "lost" if any of the "unwinnable" objectives are not "optional".
didLose :: ObjectiveCompletion -> Bool
didLose :: ObjectiveCompletion -> Bool
didLose = Bool -> Bool
not (Bool -> Bool)
-> (ObjectiveCompletion -> Bool) -> ObjectiveCompletion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting All ObjectiveCompletion Bool -> ObjectiveCompletion -> Bool
forall s. Getting All s Bool -> s -> Bool
andOf ((Objective -> Const All Objective)
-> ObjectiveCompletion -> Const All ObjectiveCompletion
Fold ObjectiveCompletion Objective
unwinnableObjectives ((Objective -> Const All Objective)
 -> ObjectiveCompletion -> Const All ObjectiveCompletion)
-> ((Bool -> Const All Bool) -> Objective -> Const All Objective)
-> Getting All ObjectiveCompletion Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const All Bool) -> Objective -> Const All Objective
Lens' Objective Bool
objectiveOptional)

isPrereqsSatisfied :: ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied :: ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied ObjectiveCompletion
completions =
  Bool
-> (PrerequisiteConfig -> Bool) -> Maybe PrerequisiteConfig -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True PrerequisiteConfig -> Bool
f (Maybe PrerequisiteConfig -> Bool)
-> (Objective -> Maybe PrerequisiteConfig) -> Objective -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
-> Objective -> Maybe PrerequisiteConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
Lens' Objective (Maybe PrerequisiteConfig)
objectivePrerequisite
 where
  f :: PrerequisiteConfig -> Bool
f = (ObjectiveLabel -> Bool) -> BoolExpr ObjectiveLabel -> Bool
forall a. (a -> Bool) -> BoolExpr a -> Bool
BE.evalBoolExpr ObjectiveLabel -> Bool
getTruth (BoolExpr ObjectiveLabel -> Bool)
-> (PrerequisiteConfig -> BoolExpr ObjectiveLabel)
-> PrerequisiteConfig
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prerequisite ObjectiveLabel -> BoolExpr ObjectiveLabel
forall a. Prerequisite a -> BoolExpr a
L.toBoolExpr (Prerequisite ObjectiveLabel -> BoolExpr ObjectiveLabel)
-> (PrerequisiteConfig -> Prerequisite ObjectiveLabel)
-> PrerequisiteConfig
-> BoolExpr ObjectiveLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrerequisiteConfig -> Prerequisite ObjectiveLabel
logic

  getTruth :: ObjectiveLabel -> Bool
  getTruth :: ObjectiveLabel -> Bool
getTruth ObjectiveLabel
label = ObjectiveLabel -> Set ObjectiveLabel -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ObjectiveLabel
label (Set ObjectiveLabel -> Bool) -> Set ObjectiveLabel -> Bool
forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion
completions ObjectiveCompletion
-> Getting
     (Set ObjectiveLabel) ObjectiveCompletion (Set ObjectiveLabel)
-> Set ObjectiveLabel
forall s a. s -> Getting a s a -> a
^. Getting
  (Set ObjectiveLabel) ObjectiveCompletion (Set ObjectiveLabel)
Getter ObjectiveCompletion (Set ObjectiveLabel)
completedIDs

isUnwinnablePrereq :: Set ObjectiveLabel -> Prerequisite ObjectiveLabel -> Bool
isUnwinnablePrereq :: Set ObjectiveLabel -> Prerequisite ObjectiveLabel -> Bool
isUnwinnablePrereq Set ObjectiveLabel
completed =
  BoolExpr ObjectiveLabel -> Bool
forall a. Ord a => BoolExpr a -> Bool
Simplify.cannotBeTrue (BoolExpr ObjectiveLabel -> Bool)
-> (Prerequisite ObjectiveLabel -> BoolExpr ObjectiveLabel)
-> Prerequisite ObjectiveLabel
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ObjectiveLabel Bool
-> BoolExpr ObjectiveLabel -> BoolExpr ObjectiveLabel
forall a. Ord a => Map a Bool -> BoolExpr a -> BoolExpr a
Simplify.replace Map ObjectiveLabel Bool
boolMap (BoolExpr ObjectiveLabel -> BoolExpr ObjectiveLabel)
-> (Prerequisite ObjectiveLabel -> BoolExpr ObjectiveLabel)
-> Prerequisite ObjectiveLabel
-> BoolExpr ObjectiveLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prerequisite ObjectiveLabel -> BoolExpr ObjectiveLabel
forall a. Prerequisite a -> BoolExpr a
L.toBoolExpr
 where
  boolMap :: Map ObjectiveLabel Bool
boolMap = [(ObjectiveLabel, Bool)] -> Map ObjectiveLabel Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ObjectiveLabel, Bool)] -> Map ObjectiveLabel Bool)
-> (Set ObjectiveLabel -> [(ObjectiveLabel, Bool)])
-> Set ObjectiveLabel
-> Map ObjectiveLabel Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectiveLabel -> (ObjectiveLabel, Bool))
-> [ObjectiveLabel] -> [(ObjectiveLabel, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True) ([ObjectiveLabel] -> [(ObjectiveLabel, Bool)])
-> (Set ObjectiveLabel -> [ObjectiveLabel])
-> Set ObjectiveLabel
-> [(ObjectiveLabel, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ObjectiveLabel -> [ObjectiveLabel]
forall a. Set a -> [a]
Set.toList (Set ObjectiveLabel -> Map ObjectiveLabel Bool)
-> Set ObjectiveLabel -> Map ObjectiveLabel Bool
forall a b. (a -> b) -> a -> b
$ Set ObjectiveLabel
completed

isUnwinnable :: ObjectiveCompletion -> Objective -> Bool
isUnwinnable :: ObjectiveCompletion -> Objective -> Bool
isUnwinnable ObjectiveCompletion
completions Objective
obj =
  Bool
-> (PrerequisiteConfig -> Bool) -> Maybe PrerequisiteConfig -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Set ObjectiveLabel -> Prerequisite ObjectiveLabel -> Bool
isUnwinnablePrereq (ObjectiveCompletion
completions ObjectiveCompletion
-> Getting
     (Set ObjectiveLabel) ObjectiveCompletion (Set ObjectiveLabel)
-> Set ObjectiveLabel
forall s a. s -> Getting a s a -> a
^. Getting
  (Set ObjectiveLabel) ObjectiveCompletion (Set ObjectiveLabel)
Getter ObjectiveCompletion (Set ObjectiveLabel)
completedIDs) (Prerequisite ObjectiveLabel -> Bool)
-> (PrerequisiteConfig -> Prerequisite ObjectiveLabel)
-> PrerequisiteConfig
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrerequisiteConfig -> Prerequisite ObjectiveLabel
logic) (Maybe PrerequisiteConfig -> Bool)
-> Maybe PrerequisiteConfig -> Bool
forall a b. (a -> b) -> a -> b
$ Objective
obj Objective
-> Getting
     (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
-> Maybe PrerequisiteConfig
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
Lens' Objective (Maybe PrerequisiteConfig)
objectivePrerequisite

-- | 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 =
  (Objective -> Bool) -> [Objective] -> ([Objective], [Objective])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied ObjectiveCompletion
oc) ([Objective] -> ([Objective], [Objective]))
-> [Objective] -> ([Objective], [Objective])
forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion
oc ObjectiveCompletion
-> Getting (Endo [Objective]) ObjectiveCompletion Objective
-> [Objective]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Objective]) ObjectiveCompletion Objective
Fold ObjectiveCompletion Objective
incompleteObjectives

getActiveObjectives :: ObjectiveCompletion -> [Objective]
getActiveObjectives :: ObjectiveCompletion -> [Objective]
getActiveObjectives =
  ([Objective], [Objective]) -> [Objective]
forall a b. (a, b) -> a
fst (([Objective], [Objective]) -> [Objective])
-> (ObjectiveCompletion -> ([Objective], [Objective]))
-> ObjectiveCompletion
-> [Objective]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectiveCompletion -> ([Objective], [Objective])
partitionActiveObjectives

-- | 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. PrereqSatisfaction -> Rep PrereqSatisfaction x)
-> (forall x. Rep PrereqSatisfaction x -> PrereqSatisfaction)
-> Generic PrereqSatisfaction
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
$cfrom :: forall x. PrereqSatisfaction -> Rep PrereqSatisfaction x
from :: forall x. PrereqSatisfaction -> Rep PrereqSatisfaction x
$cto :: forall x. Rep PrereqSatisfaction x -> PrereqSatisfaction
to :: forall x. Rep PrereqSatisfaction x -> PrereqSatisfaction
Generic, [PrereqSatisfaction] -> Value
[PrereqSatisfaction] -> Encoding
PrereqSatisfaction -> Bool
PrereqSatisfaction -> Value
PrereqSatisfaction -> Encoding
(PrereqSatisfaction -> Value)
-> (PrereqSatisfaction -> Encoding)
-> ([PrereqSatisfaction] -> Value)
-> ([PrereqSatisfaction] -> Encoding)
-> (PrereqSatisfaction -> Bool)
-> ToJSON PrereqSatisfaction
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PrereqSatisfaction -> Value
toJSON :: PrereqSatisfaction -> Value
$ctoEncoding :: PrereqSatisfaction -> Encoding
toEncoding :: PrereqSatisfaction -> Encoding
$ctoJSONList :: [PrereqSatisfaction] -> Value
toJSONList :: [PrereqSatisfaction] -> Value
$ctoEncodingList :: [PrereqSatisfaction] -> Encoding
toEncodingList :: [PrereqSatisfaction] -> Encoding
$comitField :: PrereqSatisfaction -> Bool
omitField :: PrereqSatisfaction -> Bool
ToJSON)

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

-- | Used only by the web interface for debugging
getSatisfaction :: ObjectiveCompletion -> [PrereqSatisfaction]
getSatisfaction :: ObjectiveCompletion -> [PrereqSatisfaction]
getSatisfaction ObjectiveCompletion
oc = (Objective -> PrereqSatisfaction)
-> [Objective] -> [PrereqSatisfaction]
forall a b. (a -> b) -> [a] -> [b]
map Objective -> PrereqSatisfaction
f ([Objective] -> [PrereqSatisfaction])
-> [Objective] -> [PrereqSatisfaction]
forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion
oc ObjectiveCompletion
-> Getting (Endo [Objective]) ObjectiveCompletion Objective
-> [Objective]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Objective]) ObjectiveCompletion Objective
Fold ObjectiveCompletion Objective
allObjectives
 where
  f :: Objective -> PrereqSatisfaction
f Objective
y =
    Objective
-> Set (Signed ObjectiveLabel) -> Bool -> PrereqSatisfaction
PrereqSatisfaction
      Objective
y
      (Set (Signed ObjectiveLabel)
-> (PrerequisiteConfig -> Set (Signed ObjectiveLabel))
-> Maybe PrerequisiteConfig
-> Set (Signed ObjectiveLabel)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (Signed ObjectiveLabel)
forall a. Monoid a => a
mempty (Prerequisite ObjectiveLabel -> Set (Signed ObjectiveLabel)
forall a. Ord a => Prerequisite a -> Set (Signed a)
getDistinctConstants (Prerequisite ObjectiveLabel -> Set (Signed ObjectiveLabel))
-> (PrerequisiteConfig -> Prerequisite ObjectiveLabel)
-> PrerequisiteConfig
-> Set (Signed ObjectiveLabel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrerequisiteConfig -> Prerequisite ObjectiveLabel
logic) (Maybe PrerequisiteConfig -> Set (Signed ObjectiveLabel))
-> Maybe PrerequisiteConfig -> Set (Signed ObjectiveLabel)
forall a b. (a -> b) -> a -> b
$ Objective
y Objective
-> Getting
     (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
-> Maybe PrerequisiteConfig
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
Lens' Objective (Maybe PrerequisiteConfig)
objectivePrerequisite)
      (ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied ObjectiveCompletion
oc Objective
y)