Boolean expressions of objective prerequisites

towards #795

data/scenarios/Testing/00-ORDER.txt

@@ -14,4 +14,5 @@
 684-swap.yaml
 699-movement-fail
 858-inventory
+795-prerequisite
 710-multi-robot.yaml

data/scenarios/Testing/378-objectives.yaml

@@ -10,6 +10,7 @@ objectives:
         n <- as base {count "tree"};
         return (n >= 3)
       } { return false }
+    id: "0"
   - goal:
       - Nice job.  Now, build a harvester.
     condition: |

data/scenarios/Testing/795-prerequisite/00-ORDER.txt

@@ -0,0 +1 @@
+795-prerequisite-or.yaml

data/scenarios/Testing/795-prerequisite/795-prerequisite-or.yaml

@@ -0,0 +1,46 @@
+version: 1
+name: |
+  Prerequisite bjectives: OR
+description: |
+  Complete an objective with a prerequisite of either of two other objectives.
+objectives:
+  - goal:
+      - Achieve one of two other objectives
+    condition: |
+      return true;
+    prerequisite:
+      or:
+        - id: have_furnace
+        - id: have_gear
+  - goal:
+      - Make a "furnace".
+    condition: |
+      as base {has "furnace"};
+    id: have_furnace
+    optional: true
+  - goal:
+      - Make a "wooden gear".
+    condition: |
+      as base {has "wooden gear"};
+    id: have_gear
+    optional: true
+solution: |
+  make "furnace"
+robots:
+  - name: base
+    display:
+      char: 'Ω'
+      attr: robot
+    dir: [0, 1]
+    devices:
+      - workbench
+    inventory:
+      - [2, board]
+      - [5, rock]
+world:
+  default: [blank]
+  palette:
+    'x': [grass, null, base]
+  upperleft: [0, 0]
+  map: |
+    x

src/Swarm/Game/Scenario.hs

@@ -17,11 +17,6 @@
 -- conditions, which can be used both for building interactive
 -- tutorials and for standalone puzzles and scenarios.
 module Swarm.Game.Scenario (
-  -- * Objectives
-  Objective,
-  objectiveGoal,
-  objectiveCondition,
-
   -- * WorldDescription
   PCell (..),
   Cell,
@@ -45,6 +40,7 @@ module Swarm.Game.Scenario (
   scenarioWorld,
   scenarioRobots,
   scenarioObjectives,
+  scenarioObjectiveLookup,
   scenarioSolution,
   scenarioStepsPerTick,
 
@@ -55,13 +51,20 @@ module Swarm.Game.Scenario (
 ) where
 
 import Control.Algebra (Has)
+import Control.Arrow ((&&&))
 import Control.Carrier.Lift (Lift, sendIO)
 import Control.Carrier.Throw.Either (Throw, throwError)
 import Control.Lens hiding (from, (<.>))
-import Control.Monad (filterM)
-import Data.Maybe (catMaybes, isNothing, listToMaybe)
+import Control.Monad (filterM, unless)
+import Data.Aeson
+import Data.Foldable (for_, toList)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Map.Strict qualified as M
+import Data.Maybe (catMaybes, isNothing, listToMaybe, mapMaybe)
+import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
+import Data.Tuple (swap)
 import Data.Yaml as Y
 import Swarm.Game.Entity
 import Swarm.Game.Recipe
@@ -71,7 +74,7 @@ import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.RobotLookup
 import Swarm.Game.Scenario.WorldDescription
 import Swarm.Language.Pipeline (ProcessedTerm)
-import Swarm.Util (getDataFileNameSafe)
+import Swarm.Util (getDataFileNameSafe, quote)
 import Swarm.Util.Yaml
 import System.Directory (doesFileExist)
 import System.FilePath ((<.>), (</>))
@@ -95,7 +98,8 @@ data Scenario = Scenario
   , _scenarioKnown :: [Text]
   , _scenarioWorld :: WorldDescription
   , _scenarioRobots :: [TRobot]
-  , _scenarioObjectives :: [Objective]
+  , _scenarioObjectives :: [Objective] -- deprecated
+  , _scenarioObjectiveLookup :: ObjectiveLookup
   , _scenarioSolution :: Maybe ProcessedTerm
   , _scenarioStepsPerTick :: Maybe Int
   }
@@ -108,6 +112,30 @@ instance FromJSONE EntityMap Scenario where
     -- parse custom entities
     em <- liftE (buildEntityMap <$> (v .:? "entities" .!= []))
     -- extend ambient EntityMap with custom entities
+
+    objectives <- liftE (v .:? "objectives" .!= [])
+    let objectivesById =
+          M.fromList $
+            map swap $
+              mapMaybe (sequenceA . (id &&& _objectiveId)) objectives
+        allIds = M.keysSet objectivesById
+        objectivesLookup = ObjectiveLookup objectivesById objectives
+
+    for_ objectives $ \x -> case _objectivePrerequisite x of
+      Just p ->
+        unless (null remaining) $
+          fail . into @String $
+            T.unwords
+              [ "Reference to undefined objectives"
+              , T.intercalate ", " (map quote $ Set.toList remaining) <> "."
+              , "Defined are:"
+              , T.intercalate ", " (map quote $ Set.toList allIds)
+              ]
+       where
+        refs = Set.fromList $ toList p
+        remaining = Set.difference refs allIds
+      Nothing -> return ()
+
     withE em $ do
       -- parse 'known' entity names and make sure they exist
       known <- liftE (v .:? "known" .!= [])
@@ -121,7 +149,6 @@ instance FromJSONE EntityMap Scenario where
       -- parse robots and build RobotMap
       rs <- v ..: "robots"
       let rsMap = buildRobotMap rs
-
       Scenario
         <$> liftE (v .: "version")
         <*> liftE (v .: "name")
@@ -134,7 +161,8 @@ instance FromJSONE EntityMap Scenario where
         <*> pure known
         <*> localE (,rsMap) (v ..: "world")
         <*> pure rs
-        <*> liftE (v .:? "objectives" .!= [])
+        <*> pure objectives
+        <*> pure objectivesLookup
         <*> liftE (v .:? "solution")
         <*> liftE (v .:? "stepsPerTick")
 
@@ -182,8 +210,12 @@ scenarioWorld :: Lens' Scenario WorldDescription
 scenarioRobots :: Lens' Scenario [TRobot]
 
 -- | A sequence of objectives for the scenario (if any).
+-- DEPRECATED!
 scenarioObjectives :: Lens' Scenario [Objective]
 
+-- | Replacement for 'scenarioObjectives'
+scenarioObjectiveLookup :: Lens' Scenario ObjectiveLookup
+
 -- | An optional solution of the scenario, expressed as a
 --   program of type @cmd a@. This is useful for automated
 --   testing of the win condition.
@@ -225,7 +257,20 @@ loadScenarioFile ::
   FilePath ->
   m Scenario
 loadScenarioFile em fileName = do
+  -- FIXME This is just a rendering experiment:
+  sendIO $ Y.encodeFile "foo.yaml" demo
+  sendIO $ writeFile "blarg.txt" $ show $ toList demo
+
   res <- sendIO $ decodeFileEitherE em fileName
   case res of
     Left parseExn -> throwError @Text (from @String (prettyPrintParseException parseExn))
     Right c -> return c
+ where
+  demo :: Prerequisite ObjectiveId
+  demo =
+    And $
+      Id "a"
+        :| [ Not $ And (Id "e" :| pure (Id "f"))
+           , Id "d"
+           , Or (Id "b" :| pure (Not $ Id "c"))
+           ]

src/Swarm/Game/Scenario/Objective.hs

@@ -4,8 +4,12 @@
 module Swarm.Game.Scenario.Objective where
 
 import Control.Lens hiding (from, (<.>))
+import Data.Aeson
+import Data.Char (toLower)
+import Data.List.NonEmpty (NonEmpty)
+import Data.Map (Map)
+import Data.Semigroup
 import Data.Text (Text)
-import Data.Yaml as Y
 import GHC.Generics (Generic)
 import Swarm.Language.Pipeline (ProcessedTerm)
 import Swarm.Util (reflow)
@@ -14,11 +18,42 @@ import Swarm.Util (reflow)
 -- Scenario objectives
 ------------------------------------------------------------
 
+type ObjectiveId = Text
+
+data Prerequisite a
+  = And (NonEmpty (Prerequisite a))
+  | Or (NonEmpty (Prerequisite a))
+  | Not (Prerequisite a)
+  | Id a
+  deriving (Eq, Show, Generic, Functor, Foldable)
+
+met :: Prerequisite Bool -> Bool
+met (And x) = getAll $ sconcat $ fmap (All . met) x
+met (Or x) = getAny $ sconcat $ fmap (Any . met) x
+met (Not x) = not $ met x
+met (Id x) = x
+
+prerequisiteOptions :: Options
+prerequisiteOptions =
+  defaultOptions
+    { sumEncoding = ObjectWithSingleField
+    , constructorTagModifier = map toLower
+    }
+
+instance ToJSON (Prerequisite ObjectiveId) where
+  toJSON = genericToJSON prerequisiteOptions
+
+instance FromJSON (Prerequisite ObjectiveId) where
+  parseJSON = genericParseJSON prerequisiteOptions
+
 -- | An objective is a condition to be achieved by a player in a
 --   scenario.
 data Objective = Objective
   { _objectiveGoal :: [Text]
   , _objectiveCondition :: ProcessedTerm
+  , _objectiveId :: Maybe ObjectiveId
+  , _objectiveOptional :: Bool
+  , _objectivePrerequisite :: Maybe (Prerequisite ObjectiveId)
   }
   deriving (Eq, Show, Generic, ToJSON)
 
@@ -34,8 +69,41 @@ objectiveGoal :: Lens' Objective [Text]
 --   of CESK steps per tick do not apply).
 objectiveCondition :: Lens' Objective ProcessedTerm
 
+-- | 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
+
+-- | Boolean expression the represents the condition dependencies which also
+-- must have been evaluated to True.
+-- Note that the achievement of these objective dependencies is
+-- persistent; once achieved, it still counts even if the "condition"
+-- might not still hold. The condition is never re-evaluated once True.
+objectivePrerequisite :: Lens' Objective (Maybe (Prerequisite ObjectiveId))
+
 instance FromJSON Objective where
   parseJSON = withObject "objective" $ \v ->
     Objective
       <$> (fmap . map) reflow (v .:? "goal" .!= [])
       <*> (v .: "condition")
+      <*> (v .:? "id")
+      <*> (v .:? "optional" .!= False)
+      <*> (v .:? "prerequisite")
+
+-- | TODO: Should use a "smart constructor"
+-- on this so that all ObjectId references
+-- within the 'allObjectives' list are guaranteed
+-- to exist as keys of the 'byId' map.
+-- Or, perhaps hide the implementation detail
+-- of there being a map, and just define an
+-- accessor function that does not fail?
+data ObjectiveLookup = ObjectiveLookup
+  { byId :: Map ObjectiveId Objective
+  , allObjectives :: [Objective]
+  }
+  deriving (Show, Eq, Generic, FromJSON, ToJSON)

src/Swarm/Game/State.hs

@@ -21,6 +21,7 @@ module Swarm.Game.State (
   ViewCenterRule (..),
   REPLStatus (..),
   WinCondition (..),
+  ObjectiveCompletion (..),
   _NoWinCondition,
   _WinConditions,
   _Won,
@@ -145,6 +146,7 @@ import Swarm.Game.Recipe (
   reqRecipeMap,
  )
 import Swarm.Game.Robot
+import Swarm.Game.Scenario.Objective
 import Swarm.Game.ScenarioInfo
 import Swarm.Game.Terrain (TerrainType (..))
 import Swarm.Game.Value (Value)
@@ -197,12 +199,18 @@ data REPLStatus
     REPLWorking (Typed (Maybe Value))
   deriving (Eq, Show, Generic, FromJSON, ToJSON)
 
+data ObjectiveCompletion = ObjectiveCompletion
+  { objectiveLookup :: ObjectiveLookup
+  , completeById :: Map ObjectiveId Bool
+  }
+  deriving (Show, Generic, FromJSON, ToJSON)
+
 data WinCondition
   = -- | There is no winning condition.
     NoWinCondition
   | -- | There are one or more objectives remaining that the player
     --   has not yet accomplished.
-    WinConditions (NonEmpty Objective)
+    WinConditions ObjectiveCompletion (NonEmpty Objective)
   | -- | The player has won. The boolean indicates whether they have
     --   already been congratulated.
     Won Bool
@@ -875,7 +883,12 @@ scenarioToGameState scenario userSeed toRun g = do
 
   (genRobots, wf) = buildWorld em (scenario ^. scenarioWorld)
   theWorld = W.newWorld . wf
-  theWinCondition = maybe NoWinCondition WinConditions (NE.nonEmpty (scenario ^. scenarioObjectives))
+  theWinCondition =
+    maybe
+      NoWinCondition
+      (\(x, y) -> WinConditions (ObjectiveCompletion x mempty) y)
+      (sequenceA (scenario ^. scenarioObjectiveLookup, NE.nonEmpty (scenario ^. scenarioObjectives)))
+
   initGensym = length robotList - 1
   addRecipesWith f gRs = IM.unionWith (<>) (f $ scenario ^. scenarioRecipes) (g ^. gRs)
 

src/Swarm/Game/Step.hs

@@ -58,7 +58,7 @@ import Swarm.Game.Entity qualified as E
 import Swarm.Game.Exception
 import Swarm.Game.Recipe
 import Swarm.Game.Robot
-import Swarm.Game.Scenario (objectiveCondition)
+import Swarm.Game.Scenario.Objective (objectiveCondition, objectiveId)
 import Swarm.Game.State
 import Swarm.Game.Value
 import Swarm.Game.World qualified as W
@@ -131,7 +131,7 @@ gameTick = do
   -- Possibly see if the winning condition for the current objective is met.
   wc <- use winCondition
   case wc of
-    WinConditions (obj :| objs) -> do
+    WinConditions (ObjectiveCompletion objLookup prevCompleteness) (obj :| objs) -> do
       g <- get @GameState
 
       -- Execute the win condition check *hypothetically*: i.e. in a
@@ -148,7 +148,17 @@ gameTick = do
               farAway = Location maxBound maxBound
           let m = LogEntry time ErrorTrace hn hid farAway $ formatExn em exn
           emitMessage m
-        Right (VBool True) -> winCondition .= maybe (Won False) WinConditions (NE.nonEmpty objs)
+        Right (VBool True) ->
+          winCondition
+            .= maybe
+              (Won False)
+              (WinConditions (ObjectiveCompletion objLookup $ completenessTxform prevCompleteness))
+              (NE.nonEmpty objs)
+         where
+          completenessTxform = case maybeCompletedId of
+            Nothing -> id
+            Just z -> M.insert z True
+          maybeCompletedId = obj ^. objectiveId
         _ -> return ()
     _ -> return ()