{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Goals of scenario
module Swarm.Game.Scenario.Objective (
  -- * Scenario objectives
  PrerequisiteConfig (..),
  Objective,
  objectiveGoal,
  objectiveTeaser,
  objectiveCondition,
  objectiveId,
  objectiveOptional,
  objectivePrerequisite,
  objectiveHidden,
  objectiveAchievement,
  Announcement (..),

  -- * Objective completion tracking
  ObjectiveCompletion,
  initCompletion,
  completedIDs,
  incompleteObjectives,
  completedObjectives,
  unwinnableObjectives,
  allObjectives,
  addCompleted,
  addUnwinnable,
  addIncomplete,
  extractIncomplete,
)
where

import Control.Applicative ((<|>))
import Control.Lens hiding (from, (<.>))
import Data.Aeson
import Data.Set qualified as Set
import Data.Text (Text)
import GHC.Generics (Generic)
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.Achievement.Definitions qualified as AD
import Swarm.Game.Scenario.Objective.Logic as L
import Swarm.Language.JSON ()
import Swarm.Language.Syntax (Syntax, TSyntax)
import Swarm.Language.Text.Markdown qualified as Markdown
import Swarm.Util.Lens (concatFold, makeLensesExcluding, makeLensesNoSigs)

------------------------------------------------------------
-- Scenario objectives
------------------------------------------------------------

data PrerequisiteConfig = PrerequisiteConfig
  { PrerequisiteConfig -> Bool
previewable :: Bool
  -- ^ Typically, only the currently "active" objectives are
  -- displayed to the user in the Goals dialog. An objective
  -- is "active" if all of its prerequisites are met.
  --
  -- However, some objectives may be "high-level", in that they may
  -- explain the broader intention behind potentially multiple
  -- prerequisites.
  --
  -- Set this option to 'True' to display this goal in the "upcoming" section even
  -- if the objective has currently unmet prerequisites.
  , PrerequisiteConfig -> Prerequisite ObjectiveLabel
logic :: Prerequisite ObjectiveLabel
  -- ^ Boolean expression of dependencies upon other objectives. Variables in this expression
  -- are the "id"s of other objectives, and become "true" if the corresponding objective is completed.
  -- The "condition" of the objective at hand shall not be evaluated until its
  -- prerequisite expression evaluates as 'True'.
  --
  -- Note that the achievement of these objective dependencies is
  -- persistent; once achieved, they still count even if their "condition"
  -- might not still hold. The condition is never re-evaluated once true.
  }
  deriving (PrerequisiteConfig -> PrerequisiteConfig -> Bool
(PrerequisiteConfig -> PrerequisiteConfig -> Bool)
-> (PrerequisiteConfig -> PrerequisiteConfig -> Bool)
-> Eq PrerequisiteConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
== :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
$c/= :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
/= :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
Eq, Int -> PrerequisiteConfig -> ShowS
[PrerequisiteConfig] -> ShowS
PrerequisiteConfig -> String
(Int -> PrerequisiteConfig -> ShowS)
-> (PrerequisiteConfig -> String)
-> ([PrerequisiteConfig] -> ShowS)
-> Show PrerequisiteConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrerequisiteConfig -> ShowS
showsPrec :: Int -> PrerequisiteConfig -> ShowS
$cshow :: PrerequisiteConfig -> String
show :: PrerequisiteConfig -> String
$cshowList :: [PrerequisiteConfig] -> ShowS
showList :: [PrerequisiteConfig] -> ShowS
Show, (forall x. PrerequisiteConfig -> Rep PrerequisiteConfig x)
-> (forall x. Rep PrerequisiteConfig x -> PrerequisiteConfig)
-> Generic PrerequisiteConfig
forall x. Rep PrerequisiteConfig x -> PrerequisiteConfig
forall x. PrerequisiteConfig -> Rep PrerequisiteConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrerequisiteConfig -> Rep PrerequisiteConfig x
from :: forall x. PrerequisiteConfig -> Rep PrerequisiteConfig x
$cto :: forall x. Rep PrerequisiteConfig x -> PrerequisiteConfig
to :: forall x. Rep PrerequisiteConfig x -> PrerequisiteConfig
Generic, [PrerequisiteConfig] -> Value
[PrerequisiteConfig] -> Encoding
PrerequisiteConfig -> Bool
PrerequisiteConfig -> Value
PrerequisiteConfig -> Encoding
(PrerequisiteConfig -> Value)
-> (PrerequisiteConfig -> Encoding)
-> ([PrerequisiteConfig] -> Value)
-> ([PrerequisiteConfig] -> Encoding)
-> (PrerequisiteConfig -> Bool)
-> ToJSON PrerequisiteConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PrerequisiteConfig -> Value
toJSON :: PrerequisiteConfig -> Value
$ctoEncoding :: PrerequisiteConfig -> Encoding
toEncoding :: PrerequisiteConfig -> Encoding
$ctoJSONList :: [PrerequisiteConfig] -> Value
toJSONList :: [PrerequisiteConfig] -> Value
$ctoEncodingList :: [PrerequisiteConfig] -> Encoding
toEncodingList :: [PrerequisiteConfig] -> Encoding
$comitField :: PrerequisiteConfig -> Bool
omitField :: PrerequisiteConfig -> Bool
ToJSON)

instance FromJSON PrerequisiteConfig where
  -- Parsing JSON/YAML 'PrerequisiteConfig' has a shorthand option
  -- in which the boolean expression can be written directly,
  -- bypassing the "logic" key.
  -- Furthermore, an "Id" in a boolean expressions can be written
  -- as a bare string without needing the "id" key.
  parseJSON :: Value -> Parser PrerequisiteConfig
parseJSON Value
val = Value -> Parser PrerequisiteConfig
preLogic Value
val Parser PrerequisiteConfig
-> Parser PrerequisiteConfig -> Parser PrerequisiteConfig
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser PrerequisiteConfig
preObject Value
val
   where
    preObject :: Value -> Parser PrerequisiteConfig
preObject = String
-> (Object -> Parser PrerequisiteConfig)
-> Value
-> Parser PrerequisiteConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"prerequisite" ((Object -> Parser PrerequisiteConfig)
 -> Value -> Parser PrerequisiteConfig)
-> (Object -> Parser PrerequisiteConfig)
-> Value
-> Parser PrerequisiteConfig
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
      Bool
previewable <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"previewable" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Prerequisite ObjectiveLabel
logic <- Object
v Object -> Key -> Parser (Prerequisite ObjectiveLabel)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"logic"
      PrerequisiteConfig -> Parser PrerequisiteConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrerequisiteConfig {Bool
Prerequisite ObjectiveLabel
previewable :: Bool
logic :: Prerequisite ObjectiveLabel
previewable :: Bool
logic :: Prerequisite ObjectiveLabel
..}
    preLogic :: Value -> Parser PrerequisiteConfig
preLogic = (Prerequisite ObjectiveLabel -> PrerequisiteConfig)
-> Parser (Prerequisite ObjectiveLabel)
-> Parser PrerequisiteConfig
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Prerequisite ObjectiveLabel -> PrerequisiteConfig
PrerequisiteConfig Bool
False) (Parser (Prerequisite ObjectiveLabel) -> Parser PrerequisiteConfig)
-> (Value -> Parser (Prerequisite ObjectiveLabel))
-> Value
-> Parser PrerequisiteConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (Prerequisite ObjectiveLabel)
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | An objective is a condition to be achieved by a player in a
--   scenario.
data Objective = Objective
  { Objective -> Document Syntax
_objectiveGoal :: Markdown.Document Syntax
  , Objective -> Maybe ObjectiveLabel
_objectiveTeaser :: Maybe Text
  , Objective -> TSyntax
_objectiveCondition :: TSyntax
  , Objective -> Maybe ObjectiveLabel
_objectiveId :: Maybe ObjectiveLabel
  , Objective -> Bool
_objectiveOptional :: Bool
  , Objective -> Maybe PrerequisiteConfig
_objectivePrerequisite :: Maybe PrerequisiteConfig
  , Objective -> Bool
_objectiveHidden :: Bool
  , Objective -> Maybe AchievementInfo
_objectiveAchievement :: Maybe AD.AchievementInfo
  }
  deriving (Objective -> Objective -> Bool
(Objective -> Objective -> Bool)
-> (Objective -> Objective -> Bool) -> Eq Objective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Objective -> Objective -> Bool
== :: Objective -> Objective -> Bool
$c/= :: Objective -> Objective -> Bool
/= :: Objective -> Objective -> Bool
Eq, Int -> Objective -> ShowS
[Objective] -> ShowS
Objective -> String
(Int -> Objective -> ShowS)
-> (Objective -> String)
-> ([Objective] -> ShowS)
-> Show Objective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Objective -> ShowS
showsPrec :: Int -> Objective -> ShowS
$cshow :: Objective -> String
show :: Objective -> String
$cshowList :: [Objective] -> ShowS
showList :: [Objective] -> ShowS
Show, (forall x. Objective -> Rep Objective x)
-> (forall x. Rep Objective x -> Objective) -> Generic Objective
forall x. Rep Objective x -> Objective
forall x. Objective -> Rep Objective x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Objective -> Rep Objective x
from :: forall x. Objective -> Rep Objective x
$cto :: forall x. Rep Objective x -> Objective
to :: forall x. Rep Objective x -> Objective
Generic, [Objective] -> Value
[Objective] -> Encoding
Objective -> Bool
Objective -> Value
Objective -> Encoding
(Objective -> Value)
-> (Objective -> Encoding)
-> ([Objective] -> Value)
-> ([Objective] -> Encoding)
-> (Objective -> Bool)
-> ToJSON Objective
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Objective -> Value
toJSON :: Objective -> Value
$ctoEncoding :: Objective -> Encoding
toEncoding :: Objective -> Encoding
$ctoJSONList :: [Objective] -> Value
toJSONList :: [Objective] -> Value
$ctoEncodingList :: [Objective] -> Encoding
toEncodingList :: [Objective] -> Encoding
$comitField :: Objective -> Bool
omitField :: Objective -> Bool
ToJSON)

makeLensesNoSigs ''Objective

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

-- | An explanation of the goal of the objective, shown to the player
--   during play.  It is represented as a list of paragraphs.
objectiveGoal :: Lens' Objective (Markdown.Document Syntax)

-- | A very short (3-5 words) description of the goal for
-- displaying on the left side of the Objectives modal.
objectiveTeaser :: Lens' Objective (Maybe Text)

-- | A winning condition for the objective, expressed as a
--   program of type @cmd bool@.  By default, this program will be
--   run to completion every tick (the usual limits on the number
--   of CESK steps per tick do not apply).
objectiveCondition :: Lens' Objective TSyntax

-- | Optional name by which this objective may be referenced
-- as a prerequisite for other objectives.
objectiveId :: Lens' Objective (Maybe Text)

-- | Indicates whether the objective is not required in order
-- to "win" the scenario. Useful for (potentially hidden) achievements.
-- If the field is not supplied, it defaults to False (i.e. the
-- objective is mandatory to "win").
objectiveOptional :: Lens' Objective Bool

-- | Dependencies upon other objectives
objectivePrerequisite :: Lens' Objective (Maybe PrerequisiteConfig)

-- | Whether the goal is displayed in the UI before completion.
-- The goal will always be revealed after it is completed.
--
-- This attribute often goes along with an Achievement.
objectiveHidden :: Lens' Objective Bool

-- | An optional achievement that is to be registered globally
-- when this objective is completed.
objectiveAchievement :: Lens' Objective (Maybe AD.AchievementInfo)

instance FromJSON Objective where
  parseJSON :: Value -> Parser Objective
parseJSON = String -> (Object -> Parser Objective) -> Value -> Parser Objective
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"objective" ((Object -> Parser Objective) -> Value -> Parser Objective)
-> (Object -> Parser Objective) -> Value -> Parser Objective
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Document Syntax
_objectiveGoal <- Object
v Object -> Key -> Parser (Maybe (Document Syntax))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"goal" Parser (Maybe (Document Syntax))
-> Document Syntax -> Parser (Document Syntax)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Document Syntax
forall a. Monoid a => a
mempty
    Maybe ObjectiveLabel
_objectiveTeaser <- Object
v Object -> Key -> Parser (Maybe ObjectiveLabel)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"teaser"
    TSyntax
_objectiveCondition <- Object
v Object -> Key -> Parser TSyntax
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"condition"
    Maybe ObjectiveLabel
_objectiveId <- Object
v Object -> Key -> Parser (Maybe ObjectiveLabel)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    Bool
_objectiveOptional <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"optional" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Maybe PrerequisiteConfig
_objectivePrerequisite <- Object
v Object -> Key -> Parser (Maybe PrerequisiteConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prerequisite"
    Bool
_objectiveHidden <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hidden" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Maybe AchievementInfo
_objectiveAchievement <- Object
v Object -> Key -> Parser (Maybe AchievementInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"achievement"
    Objective -> Parser Objective
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Objective {Bool
Maybe ObjectiveLabel
Maybe AchievementInfo
Maybe PrerequisiteConfig
TSyntax
Document Syntax
_objectiveGoal :: Document Syntax
_objectiveTeaser :: Maybe ObjectiveLabel
_objectiveCondition :: TSyntax
_objectiveId :: Maybe ObjectiveLabel
_objectiveOptional :: Bool
_objectivePrerequisite :: Maybe PrerequisiteConfig
_objectiveHidden :: Bool
_objectiveAchievement :: Maybe AchievementInfo
_objectiveGoal :: Document Syntax
_objectiveTeaser :: Maybe ObjectiveLabel
_objectiveCondition :: TSyntax
_objectiveId :: Maybe ObjectiveLabel
_objectiveOptional :: Bool
_objectivePrerequisite :: Maybe PrerequisiteConfig
_objectiveHidden :: Bool
_objectiveAchievement :: Maybe AchievementInfo
..}

-- | TODO: #1044 Could also add an "ObjectiveFailed" constructor...
newtype Announcement
  = ObjectiveCompleted Objective
  deriving (Int -> Announcement -> ShowS
[Announcement] -> ShowS
Announcement -> String
(Int -> Announcement -> ShowS)
-> (Announcement -> String)
-> ([Announcement] -> ShowS)
-> Show Announcement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Announcement -> ShowS
showsPrec :: Int -> Announcement -> ShowS
$cshow :: Announcement -> String
show :: Announcement -> String
$cshowList :: [Announcement] -> ShowS
showList :: [Announcement] -> ShowS
Show, (forall x. Announcement -> Rep Announcement x)
-> (forall x. Rep Announcement x -> Announcement)
-> Generic Announcement
forall x. Rep Announcement x -> Announcement
forall x. Announcement -> Rep Announcement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Announcement -> Rep Announcement x
from :: forall x. Announcement -> Rep Announcement x
$cto :: forall x. Rep Announcement x -> Announcement
to :: forall x. Rep Announcement x -> Announcement
Generic, [Announcement] -> Value
[Announcement] -> Encoding
Announcement -> Bool
Announcement -> Value
Announcement -> Encoding
(Announcement -> Value)
-> (Announcement -> Encoding)
-> ([Announcement] -> Value)
-> ([Announcement] -> Encoding)
-> (Announcement -> Bool)
-> ToJSON Announcement
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Announcement -> Value
toJSON :: Announcement -> Value
$ctoEncoding :: Announcement -> Encoding
toEncoding :: Announcement -> Encoding
$ctoJSONList :: [Announcement] -> Value
toJSONList :: [Announcement] -> Value
$ctoEncodingList :: [Announcement] -> Encoding
toEncodingList :: [Announcement] -> Encoding
$comitField :: Announcement -> Bool
omitField :: Announcement -> Bool
ToJSON)

------------------------------------------------------------
-- Completion tracking
------------------------------------------------------------

-- | Gather together lists of objectives that are incomplete,
--   complete, or unwinnable.  This type is not exported from this
--   module.
data CompletionBuckets = CompletionBuckets
  { CompletionBuckets -> [Objective]
_incomplete :: [Objective]
  , CompletionBuckets -> [Objective]
_completed :: [Objective]
  , CompletionBuckets -> [Objective]
_unwinnable :: [Objective]
  }
  deriving (Int -> CompletionBuckets -> ShowS
[CompletionBuckets] -> ShowS
CompletionBuckets -> String
(Int -> CompletionBuckets -> ShowS)
-> (CompletionBuckets -> String)
-> ([CompletionBuckets] -> ShowS)
-> Show CompletionBuckets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionBuckets -> ShowS
showsPrec :: Int -> CompletionBuckets -> ShowS
$cshow :: CompletionBuckets -> String
show :: CompletionBuckets -> String
$cshowList :: [CompletionBuckets] -> ShowS
showList :: [CompletionBuckets] -> ShowS
Show, (forall x. CompletionBuckets -> Rep CompletionBuckets x)
-> (forall x. Rep CompletionBuckets x -> CompletionBuckets)
-> Generic CompletionBuckets
forall x. Rep CompletionBuckets x -> CompletionBuckets
forall x. CompletionBuckets -> Rep CompletionBuckets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletionBuckets -> Rep CompletionBuckets x
from :: forall x. CompletionBuckets -> Rep CompletionBuckets x
$cto :: forall x. Rep CompletionBuckets x -> CompletionBuckets
to :: forall x. Rep CompletionBuckets x -> CompletionBuckets
Generic, Maybe CompletionBuckets
Value -> Parser [CompletionBuckets]
Value -> Parser CompletionBuckets
(Value -> Parser CompletionBuckets)
-> (Value -> Parser [CompletionBuckets])
-> Maybe CompletionBuckets
-> FromJSON CompletionBuckets
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CompletionBuckets
parseJSON :: Value -> Parser CompletionBuckets
$cparseJSONList :: Value -> Parser [CompletionBuckets]
parseJSONList :: Value -> Parser [CompletionBuckets]
$comittedField :: Maybe CompletionBuckets
omittedField :: Maybe CompletionBuckets
FromJSON, [CompletionBuckets] -> Value
[CompletionBuckets] -> Encoding
CompletionBuckets -> Bool
CompletionBuckets -> Value
CompletionBuckets -> Encoding
(CompletionBuckets -> Value)
-> (CompletionBuckets -> Encoding)
-> ([CompletionBuckets] -> Value)
-> ([CompletionBuckets] -> Encoding)
-> (CompletionBuckets -> Bool)
-> ToJSON CompletionBuckets
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CompletionBuckets -> Value
toJSON :: CompletionBuckets -> Value
$ctoEncoding :: CompletionBuckets -> Encoding
toEncoding :: CompletionBuckets -> Encoding
$ctoJSONList :: [CompletionBuckets] -> Value
toJSONList :: [CompletionBuckets] -> Value
$ctoEncodingList :: [CompletionBuckets] -> Encoding
toEncodingList :: [CompletionBuckets] -> Encoding
$comitField :: CompletionBuckets -> Bool
omitField :: CompletionBuckets -> Bool
ToJSON)

-- Note we derive these lenses for `CompletionBuckets` but we do NOT
-- export them; they are used only internally to this module.  In
-- fact, the `CompletionBuckets` type itself is not exported.
makeLensesNoSigs ''CompletionBuckets

-- | The incomplete objectives in a 'CompletionBuckets' record.
incomplete :: Lens' CompletionBuckets [Objective]

-- | The completed objectives in a 'CompletionBuckets' record.
completed :: Lens' CompletionBuckets [Objective]

-- | The unwinnable objectives in a 'CompletionBuckets' record.
unwinnable :: Lens' CompletionBuckets [Objective]

-- | A record to keep track of the completion status of all a
--   scenario's objectives.  We do not export the constructor or
--   record field labels of this type in order to ensure that its
--   internal invariants cannot be violated.
data ObjectiveCompletion = ObjectiveCompletion
  { ObjectiveCompletion -> CompletionBuckets
_completionBuckets :: CompletionBuckets
  -- ^ This is the authoritative "completion status"
  -- for all objectives.
  -- Note that there is a separate Set to store the
  -- completion status of prerequisite objectives, which
  -- must be carefully kept in sync with this.
  -- Those prerequisite objectives are required to have
  -- labels, but other objectives are not.
  -- Therefore only prerequisites exist in the completion
  -- map keyed by label.
  , ObjectiveCompletion -> Set ObjectiveLabel
_completedIDs :: Set.Set ObjectiveLabel
  }
  deriving (Int -> ObjectiveCompletion -> ShowS
[ObjectiveCompletion] -> ShowS
ObjectiveCompletion -> String
(Int -> ObjectiveCompletion -> ShowS)
-> (ObjectiveCompletion -> String)
-> ([ObjectiveCompletion] -> ShowS)
-> Show ObjectiveCompletion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectiveCompletion -> ShowS
showsPrec :: Int -> ObjectiveCompletion -> ShowS
$cshow :: ObjectiveCompletion -> String
show :: ObjectiveCompletion -> String
$cshowList :: [ObjectiveCompletion] -> ShowS
showList :: [ObjectiveCompletion] -> ShowS
Show, (forall x. ObjectiveCompletion -> Rep ObjectiveCompletion x)
-> (forall x. Rep ObjectiveCompletion x -> ObjectiveCompletion)
-> Generic ObjectiveCompletion
forall x. Rep ObjectiveCompletion x -> ObjectiveCompletion
forall x. ObjectiveCompletion -> Rep ObjectiveCompletion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectiveCompletion -> Rep ObjectiveCompletion x
from :: forall x. ObjectiveCompletion -> Rep ObjectiveCompletion x
$cto :: forall x. Rep ObjectiveCompletion x -> ObjectiveCompletion
to :: forall x. Rep ObjectiveCompletion x -> ObjectiveCompletion
Generic, Maybe ObjectiveCompletion
Value -> Parser [ObjectiveCompletion]
Value -> Parser ObjectiveCompletion
(Value -> Parser ObjectiveCompletion)
-> (Value -> Parser [ObjectiveCompletion])
-> Maybe ObjectiveCompletion
-> FromJSON ObjectiveCompletion
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ObjectiveCompletion
parseJSON :: Value -> Parser ObjectiveCompletion
$cparseJSONList :: Value -> Parser [ObjectiveCompletion]
parseJSONList :: Value -> Parser [ObjectiveCompletion]
$comittedField :: Maybe ObjectiveCompletion
omittedField :: Maybe ObjectiveCompletion
FromJSON, [ObjectiveCompletion] -> Value
[ObjectiveCompletion] -> Encoding
ObjectiveCompletion -> Bool
ObjectiveCompletion -> Value
ObjectiveCompletion -> Encoding
(ObjectiveCompletion -> Value)
-> (ObjectiveCompletion -> Encoding)
-> ([ObjectiveCompletion] -> Value)
-> ([ObjectiveCompletion] -> Encoding)
-> (ObjectiveCompletion -> Bool)
-> ToJSON ObjectiveCompletion
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ObjectiveCompletion -> Value
toJSON :: ObjectiveCompletion -> Value
$ctoEncoding :: ObjectiveCompletion -> Encoding
toEncoding :: ObjectiveCompletion -> Encoding
$ctoJSONList :: [ObjectiveCompletion] -> Value
toJSONList :: [ObjectiveCompletion] -> Value
$ctoEncodingList :: [ObjectiveCompletion] -> Encoding
toEncodingList :: [ObjectiveCompletion] -> Encoding
$comitField :: ObjectiveCompletion -> Bool
omitField :: ObjectiveCompletion -> Bool
ToJSON)

makeLensesFor [("_completedIDs", "internalCompletedIDs")] ''ObjectiveCompletion
makeLensesExcluding ['_completedIDs] ''ObjectiveCompletion

-- | Initialize an objective completion tracking record from a list of
--   (initially incomplete) objectives.
initCompletion :: [Objective] -> ObjectiveCompletion
initCompletion :: [Objective] -> ObjectiveCompletion
initCompletion [Objective]
objs = CompletionBuckets -> Set ObjectiveLabel -> ObjectiveCompletion
ObjectiveCompletion ([Objective] -> [Objective] -> [Objective] -> CompletionBuckets
CompletionBuckets [Objective]
objs [] []) Set ObjectiveLabel
forall a. Monoid a => a
mempty

-- | A lens onto the 'CompletionBuckets' member of an
--   'ObjectiveCompletion' record.  This lens is not exported.
completionBuckets :: Lens' ObjectiveCompletion CompletionBuckets

-- | A 'Getter' allowing one to read the set of completed objective
--   IDs for a given scenario.  Note that this is a 'Getter', not a
--   'Lens', to allow for read-only access without the possibility of
--   violating the internal invariants of 'ObjectiveCompletion'.
completedIDs :: Getter ObjectiveCompletion (Set.Set ObjectiveLabel)
completedIDs :: Getter ObjectiveCompletion (Set ObjectiveLabel)
completedIDs = (ObjectiveCompletion -> Set ObjectiveLabel)
-> (Set ObjectiveLabel -> f (Set ObjectiveLabel))
-> ObjectiveCompletion
-> f ObjectiveCompletion
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ObjectiveCompletion -> Set ObjectiveLabel
_completedIDs

-- | A 'Fold' giving read-only access to all the incomplete objectives
--   tracked by an 'ObjectiveCompletion' record.  Note that 'Fold' is
--   like a read-only 'Traversal', that is, it has multiple targets
--   but allows only reading them, not updating.  In other words
--   'Fold' is to 'Traversal' as 'Getter' is to 'Lens'.
--
--   To get an actual list of objectives, use the '(^..)' operator, as
--   in @objCompl ^.. incompleteObjectives@, where @objCompl ::
--   ObjectiveCompletion@.
incompleteObjectives :: Fold ObjectiveCompletion Objective
incompleteObjectives :: Fold ObjectiveCompletion Objective
incompleteObjectives = (CompletionBuckets -> f CompletionBuckets)
-> ObjectiveCompletion -> f ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> f CompletionBuckets)
 -> ObjectiveCompletion -> f ObjectiveCompletion)
-> ((Objective -> f Objective)
    -> CompletionBuckets -> f CompletionBuckets)
-> (Objective -> f Objective)
-> ObjectiveCompletion
-> f ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompletionBuckets -> [Objective])
-> Fold CompletionBuckets Objective
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding CompletionBuckets -> [Objective]
_incomplete

-- | A 'Fold' giving read-only access to all the completed objectives
--   tracked by an 'ObjectiveCompletion' record.  See the
--   documentation for 'incompleteObjectives' for more about 'Fold'.
completedObjectives :: Fold ObjectiveCompletion Objective
completedObjectives :: Fold ObjectiveCompletion Objective
completedObjectives = (CompletionBuckets -> f CompletionBuckets)
-> ObjectiveCompletion -> f ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> f CompletionBuckets)
 -> ObjectiveCompletion -> f ObjectiveCompletion)
-> ((Objective -> f Objective)
    -> CompletionBuckets -> f CompletionBuckets)
-> (Objective -> f Objective)
-> ObjectiveCompletion
-> f ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompletionBuckets -> [Objective])
-> Fold CompletionBuckets Objective
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding CompletionBuckets -> [Objective]
_completed

-- | A 'Fold' giving read-only access to all the unwinnable objectives
--   tracked by an 'ObjectiveCompletion' record.  See the
--   documentation for 'incompleteObjectives' for more about 'Fold'.
unwinnableObjectives :: Fold ObjectiveCompletion Objective
unwinnableObjectives :: Fold ObjectiveCompletion Objective
unwinnableObjectives = (CompletionBuckets -> f CompletionBuckets)
-> ObjectiveCompletion -> f ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> f CompletionBuckets)
 -> ObjectiveCompletion -> f ObjectiveCompletion)
-> ((Objective -> f Objective)
    -> CompletionBuckets -> f CompletionBuckets)
-> (Objective -> f Objective)
-> ObjectiveCompletion
-> f ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompletionBuckets -> [Objective])
-> Fold CompletionBuckets Objective
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding CompletionBuckets -> [Objective]
_unwinnable

-- | A 'Fold' over /all/ objectives (whether incomplete, complete, or
--   unwinnable) tracked by an 'ObjectiveCompletion' record. See the
--   documentation for 'incompleteObjectives' for more about 'Fold'.
allObjectives :: Fold ObjectiveCompletion Objective
allObjectives :: Fold ObjectiveCompletion Objective
allObjectives = (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
completedObjectives 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

-- | Add a completed objective to an 'ObjectiveCompletion' record,
--   being careful to maintain its internal invariants.
addCompleted :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addCompleted :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addCompleted Objective
obj =
  ((CompletionBuckets -> Identity CompletionBuckets)
-> ObjectiveCompletion -> Identity ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> Identity CompletionBuckets)
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> (([Objective] -> Identity [Objective])
    -> CompletionBuckets -> Identity CompletionBuckets)
-> ([Objective] -> Identity [Objective])
-> ObjectiveCompletion
-> Identity ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Identity [Objective])
-> CompletionBuckets -> Identity CompletionBuckets
Lens' CompletionBuckets [Objective]
completed (([Objective] -> Identity [Objective])
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> ([Objective] -> [Objective])
-> ObjectiveCompletion
-> ObjectiveCompletion
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Objective
obj Objective -> [Objective] -> [Objective]
forall a. a -> [a] -> [a]
:))
    (ObjectiveCompletion -> ObjectiveCompletion)
-> (ObjectiveCompletion -> ObjectiveCompletion)
-> ObjectiveCompletion
-> ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set ObjectiveLabel -> Identity (Set ObjectiveLabel))
-> ObjectiveCompletion -> Identity ObjectiveCompletion
Lens' ObjectiveCompletion (Set ObjectiveLabel)
internalCompletedIDs ((Set ObjectiveLabel -> Identity (Set ObjectiveLabel))
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> (Set ObjectiveLabel -> Set ObjectiveLabel)
-> ObjectiveCompletion
-> ObjectiveCompletion
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Set ObjectiveLabel -> Set ObjectiveLabel)
-> (ObjectiveLabel -> Set ObjectiveLabel -> Set ObjectiveLabel)
-> Maybe ObjectiveLabel
-> Set ObjectiveLabel
-> Set ObjectiveLabel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set ObjectiveLabel -> Set ObjectiveLabel
forall a. a -> a
id ObjectiveLabel -> Set ObjectiveLabel -> Set ObjectiveLabel
forall a. Ord a => a -> Set a -> Set a
Set.insert (Objective
obj Objective
-> Getting (Maybe ObjectiveLabel) Objective (Maybe ObjectiveLabel)
-> Maybe ObjectiveLabel
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ObjectiveLabel) Objective (Maybe ObjectiveLabel)
Lens' Objective (Maybe ObjectiveLabel)
objectiveId))

-- | Add an unwinnable objective to an 'ObjectiveCompletion' record,
--   being careful to maintain its internal invariants.
addUnwinnable :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addUnwinnable :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addUnwinnable Objective
obj = (CompletionBuckets -> Identity CompletionBuckets)
-> ObjectiveCompletion -> Identity ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> Identity CompletionBuckets)
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> (([Objective] -> Identity [Objective])
    -> CompletionBuckets -> Identity CompletionBuckets)
-> ([Objective] -> Identity [Objective])
-> ObjectiveCompletion
-> Identity ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Identity [Objective])
-> CompletionBuckets -> Identity CompletionBuckets
Lens' CompletionBuckets [Objective]
unwinnable (([Objective] -> Identity [Objective])
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> ([Objective] -> [Objective])
-> ObjectiveCompletion
-> ObjectiveCompletion
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Objective
obj Objective -> [Objective] -> [Objective]
forall a. a -> [a] -> [a]
:)

-- | Add an incomplete objective to an 'ObjectiveCompletion' record,
--   being careful to maintain its internal invariants.
addIncomplete :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addIncomplete :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addIncomplete Objective
obj = (CompletionBuckets -> Identity CompletionBuckets)
-> ObjectiveCompletion -> Identity ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> Identity CompletionBuckets)
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> (([Objective] -> Identity [Objective])
    -> CompletionBuckets -> Identity CompletionBuckets)
-> ([Objective] -> Identity [Objective])
-> ObjectiveCompletion
-> Identity ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Identity [Objective])
-> CompletionBuckets -> Identity CompletionBuckets
Lens' CompletionBuckets [Objective]
incomplete (([Objective] -> Identity [Objective])
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> ([Objective] -> [Objective])
-> ObjectiveCompletion
-> ObjectiveCompletion
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Objective
obj Objective -> [Objective] -> [Objective]
forall a. a -> [a] -> [a]
:)

-- | Returns the 'ObjectiveCompletion' with the incomplete goals
--   extracted to a separate tuple member.  This is intended to be
--   used as input to a fold.
extractIncomplete :: ObjectiveCompletion -> (ObjectiveCompletion, [Objective])
extractIncomplete :: ObjectiveCompletion -> (ObjectiveCompletion, [Objective])
extractIncomplete ObjectiveCompletion
oc =
  (ObjectiveCompletion
withoutIncomplete, [Objective]
incompleteGoals)
 where
  incompleteGoals :: [Objective]
incompleteGoals = ObjectiveCompletion
oc ObjectiveCompletion
-> Getting [Objective] ObjectiveCompletion [Objective]
-> [Objective]
forall s a. s -> Getting a s a -> a
^. (CompletionBuckets -> Const [Objective] CompletionBuckets)
-> ObjectiveCompletion -> Const [Objective] ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> Const [Objective] CompletionBuckets)
 -> ObjectiveCompletion -> Const [Objective] ObjectiveCompletion)
-> (([Objective] -> Const [Objective] [Objective])
    -> CompletionBuckets -> Const [Objective] CompletionBuckets)
-> Getting [Objective] ObjectiveCompletion [Objective]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Const [Objective] [Objective])
-> CompletionBuckets -> Const [Objective] CompletionBuckets
Lens' CompletionBuckets [Objective]
incomplete
  withoutIncomplete :: ObjectiveCompletion
withoutIncomplete = ObjectiveCompletion
oc ObjectiveCompletion
-> (ObjectiveCompletion -> ObjectiveCompletion)
-> ObjectiveCompletion
forall a b. a -> (a -> b) -> b
& (CompletionBuckets -> Identity CompletionBuckets)
-> ObjectiveCompletion -> Identity ObjectiveCompletion
Lens' ObjectiveCompletion CompletionBuckets
completionBuckets ((CompletionBuckets -> Identity CompletionBuckets)
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> (([Objective] -> Identity [Objective])
    -> CompletionBuckets -> Identity CompletionBuckets)
-> ([Objective] -> Identity [Objective])
-> ObjectiveCompletion
-> Identity ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Identity [Objective])
-> CompletionBuckets -> Identity CompletionBuckets
Lens' CompletionBuckets [Objective]
incomplete (([Objective] -> Identity [Objective])
 -> ObjectiveCompletion -> Identity ObjectiveCompletion)
-> [Objective] -> ObjectiveCompletion -> ObjectiveCompletion
forall s t a b. ASetter s t a b -> b -> s -> t
.~ []