WinCheck.hs

{-# 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 oc = all _objectiveOptional $ incomplete buckets <> unwinnable buckets
 where
  buckets = completionBuckets oc

-- | We have "lost" if any of the "unwinnable" objectives not "optional".
didLose :: ObjectiveCompletion -> Bool
didLose oc = not $ all _objectiveOptional $ unwinnable buckets
 where
  buckets = completionBuckets oc

isPrereqsSatisfied :: ObjectiveCompletion -> Objective -> Bool
isPrereqsSatisfied completions =
  maybe True f . _objectivePrerequisite
 where
  f = BE.evalBoolExpr getTruth . L.toBoolExpr . logic

  getTruth :: ObjectiveLabel -> Bool
  getTruth label = Set.member label $ completedIDs completions

isUnwinnablePrereq :: Set ObjectiveLabel -> Prerequisite ObjectiveLabel -> Bool
isUnwinnablePrereq completedObjectives =
  Simplify.cannotBeTrue . Simplify.replace boolMap . L.toBoolExpr
 where
  boolMap =
    M.fromList $
      map (,True) $
        Set.toList completedObjectives

isUnwinnable :: ObjectiveCompletion -> Objective -> Bool
isUnwinnable completions obj =
  maybe False (isUnwinnablePrereq (completedIDs completions) . logic) $ _objectivePrerequisite obj

-- | The first element of the returned tuple consists of "active" objectives,
-- the second element "inactive".
partitionActiveObjectives :: ObjectiveCompletion -> ([Objective], [Objective])
partitionActiveObjectives oc =
  partition (isPrereqsSatisfied oc) $
    incomplete $
      completionBuckets oc

getActiveObjectives :: ObjectiveCompletion -> [Objective]
getActiveObjectives =
  fst . partitionActiveObjectives

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

-- | For debugging only (via Web API)
data PrereqSatisfaction = PrereqSatisfaction
  { objective :: Objective
  , deps :: Set (BE.Signed ObjectiveLabel)
  , prereqsSatisfied :: Bool
  }
  deriving (Generic, ToJSON)

instance ToSample PrereqSatisfaction where
  toSamples _ = SD.noSamples

-- | Used only by the web interface for debugging
getSatisfaction :: ObjectiveCompletion -> [PrereqSatisfaction]
getSatisfaction oc =
  map f $
    listAllObjectives $
      completionBuckets oc
 where
  f y =
    PrereqSatisfaction
      y
      (maybe mempty (getDistinctConstants . logic) $ _objectivePrerequisite y)
      (isPrereqsSatisfied oc y)

getDistinctConstants :: (Ord a) => Prerequisite a -> Set (BE.Signed a)
getDistinctConstants = Set.fromList . BE.constants . toBoolExpr