Dump a list of tutorials and commands they first introduce

app/Main.hs

@@ -14,7 +14,7 @@ import Data.Text.IO qualified as Text
 import GitHash (GitInfo, giBranch, giHash, tGitInfoCwdTry)
 import Options.Applicative
 import Swarm.App (appMain)
-import Swarm.DocGen (EditorType (..), GenerateDocs (..), PageAddress (..), SheetType (..), generateDocs)
+import Swarm.Doc.Gen (EditorType (..), GenerateDocs (..), PageAddress (..), SheetType (..), generateDocs)
 import Swarm.Language.LSP (lspMain)
 import Swarm.Language.Pipeline (processTerm)
 import Swarm.TUI.Model (AppOpts (..), ColorMode (..))
@@ -71,6 +71,7 @@ cliParser =
       [ command "recipes" (info (pure RecipeGraph) $ progDesc "Output graphviz dotfile of entity dependencies based on recipes")
       , command "editors" (info (EditorKeywords <$> editor <**> helper) $ progDesc "Output editor keywords")
       , command "cheatsheet" (info (CheatSheet <$> address <*> cheatsheet <**> helper) $ progDesc "Output nice Wiki tables")
+      , command "pedagogy" (info (pure TutorialCoverage) $ progDesc "Output tutorial coverage")
       ]
   editor :: Parser (Maybe EditorType)
   editor =

data/scenarios/Tutorials/backstory.yaml

@@ -28,8 +28,8 @@ objectives:
         the menu at any time to jump around between tutorials or pick
         up again where you left off.
       - |
-        When you're ready for your first challenge, close this dialog with Esc or Ctrl-G,
-        and type at the prompt:
+        When you're ready for your first challenge, we will try the `say` command.
+        Close this dialog with Esc or Ctrl-G, and type at the prompt:
       - |
         say "Ready!"
     condition: |

data/scenarios/Tutorials/build.yaml

@@ -11,7 +11,7 @@ objectives:
         build robots to do the work for you.
         You will start in a base ('Ω') that does not move (at least not yet).
       - Let's start by building a gardener robot to perform a simple task.
-      - You can build a robot with `build {COMMANDS}`,
+      - You can `build` a robot with `build {COMMANDS}`,
         where in place of `COMMANDS` you write the sequence
         of commands for the robot to execute (separated by semicolons).
       - |

data/scenarios/Tutorials/crash.yaml

@@ -4,7 +4,7 @@ description: |
   Learn how to view built robots and debug them.
 objectives:
   - goal:
-      - Before you send your robots far away you need to learn how
+      - Before you send your robots far away from the `base` you need to learn how
         to figure out what went wrong with them if they crash.
       - |
         In this challenge, you should start by
@@ -16,10 +16,12 @@ objectives:
         For example:
       - |
         build {log "Hi!"; turn east; move; move; move; log "3"; move; log "OK"}
-      - After the robot crashes, execute `view it0` (or whichever
+      - |
+        `wait` for the robot to crash, then execute `view it0` (or whichever
         `itN` variable corresponds to the result of the `build`
         command) to see how far it got. Further instructions should
-        appear in the crashed robot's log.
+        appear in the crashed robot's log and `give` you an opportunity to `salvage`
+        the situation...
     condition: |
       try {
         as base {has "Win"}

data/scenarios/Tutorials/equip.yaml

@@ -9,12 +9,12 @@ objectives:
         By equipping devices, you learn new capabilities which allow you to
         perform more complex commands.
       - Before you start building new robots in the later tutorials, you need
-        to gain the "build" capability.
+        to gain the `build` capability.
         Try typing `build {}` - you should get an error telling you that you
         need to equip a "3D printer".
       - |
         Fortunately, there is a 3D printer lying nearby.  Go `grab` it, then
-        equip it with `equip "3D printer"`.
+        `equip` it with `equip "3D printer"`.
       - |
         You win by building your first robot:
       - |

src/Swarm/Constant.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Constants used throughout the UI and game
+module Swarm.Constant where
+
+import Data.Text (Text)
+
+-- * Website constants
+
+-- By convention, all URL constants include trailing slashes
+-- when applicable.
+
+swarmRepoUrl :: Text
+swarmRepoUrl = "https://github.com/swarm-game/swarm/"
+
+wikiUrl :: Text
+wikiUrl = swarmRepoUrl <> "wiki/"
+
+wikiCheatSheet :: Text
+wikiCheatSheet = wikiUrl <> "Commands-Cheat-Sheet"

src/Swarm/DocGen.hs → src/Swarm/Doc/Gen.hs

@@ -3,7 +3,7 @@
 
 -- |
 -- SPDX-License-Identifier: BSD-3-Clause
-module Swarm.DocGen (
+module Swarm.Doc.Gen (
   generateDocs,
   GenerateDocs (..),
   EditorType (..),
@@ -43,6 +43,7 @@ import Data.Text.IO qualified as T
 import Data.Tuple (swap)
 import Data.Yaml (decodeFileEither)
 import Data.Yaml.Aeson (prettyPrintParseException)
+import Swarm.Doc.Pedagogy
 import Swarm.Game.Display (displayChar)
 import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities)
 import Swarm.Game.Entity qualified as E
@@ -78,6 +79,8 @@ data GenerateDocs where
   -- | Keyword lists for editors.
   EditorKeywords :: Maybe EditorType -> GenerateDocs
   CheatSheet :: PageAddress -> Maybe SheetType -> GenerateDocs
+  -- | List command introductions by tutorial
+  TutorialCoverage :: GenerateDocs
   deriving (Eq, Show)
 
 data EditorType = Emacs | VSCode
@@ -129,6 +132,7 @@ generateDocs = \case
         entities <- ExceptT loadEntities
         recipes <- withExceptT F.prettyFailure $ loadRecipes entities
         liftIO $ T.putStrLn $ recipePage address recipes
+  TutorialCoverage -> renderTutorialProgression >>= putStrLn . T.unpack
 
 -- ----------------------------------------------------------------------------
 -- GENERATE KEYWORDS: LIST OF WORDS TO BE HIGHLIGHTED

src/Swarm/Doc/Pedagogy.hs

@@ -0,0 +1,237 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Assess pedagogical soundness of the tutorials.
+--
+-- Approach:
+-- 1. Obtain a list of all of the tutorial scenarios, in order
+-- 2. Search their "solution" code for `commands`
+-- 3. "fold" over the tutorial list, noting which tutorial was first to introduce each command
+module Swarm.Doc.Pedagogy (
+  renderTutorialProgression,
+  generateIntroductionsSequence,
+  CoverageInfo (..),
+  TutorialInfo (..),
+) where
+
+import Control.Arrow ((&&&))
+import Control.Lens (universe, view)
+import Control.Monad (guard, (<=<))
+import Control.Monad.Except (ExceptT (..), liftIO)
+import Data.List (foldl', intercalate, sort, sortOn)
+import Data.List.Extra (zipFrom)
+import Data.Map (Map)
+import Data.Map qualified as M
+import Data.Maybe (mapMaybe)
+import Data.Set (Set)
+import Data.Set qualified as S
+import Data.Text (Text)
+import Data.Text qualified as T
+import Swarm.Constant
+import Swarm.Game.Entity (loadEntities)
+import Swarm.Game.Scenario (Scenario, scenarioDescription, scenarioName, scenarioObjectives, scenarioSolution)
+import Swarm.Game.Scenario.Objective (objectiveGoal)
+import Swarm.Game.ScenarioInfo (ScenarioCollection, ScenarioInfoPair, flatten, loadScenariosWithWarnings, scenarioCollectionToList, scenarioPath)
+import Swarm.Language.Module (Module (..))
+import Swarm.Language.Pipeline (ProcessedTerm (..))
+import Swarm.Language.Syntax
+import Swarm.Language.Types (Polytype)
+import Swarm.TUI.Controller (getTutorials)
+import Swarm.Util (simpleErrorHandle)
+
+-- * Constants
+
+commandsWikiAnchorPrefix :: Text
+commandsWikiAnchorPrefix = wikiCheatSheet <> "#"
+
+-- * Types
+
+-- | Tutorials augmented by the set of
+-- commands that they introduce.
+-- Generated by folding over all of the
+-- tutorials in sequence.
+data CoverageInfo = CoverageInfo
+  { tutInfo :: TutorialInfo
+  , novelSolutionCommands :: Map Const [SrcLoc]
+  }
+
+-- | Tutorial scenarios with the set of commands
+-- introduced in their solution and descriptions
+-- having been extracted
+data TutorialInfo = TutorialInfo
+  { scenarioPair :: ScenarioInfoPair
+  , tutIndex :: Int
+  , solutionCommands :: Map Const [SrcLoc]
+  , descriptionCommands :: Set Const
+  }
+
+-- | A private type used by the fold
+data CommandAccum = CommandAccum
+  { _encounteredCmds :: Set Const
+  , tuts :: [CoverageInfo]
+  }
+
+-- * Functions
+
+-- | Extract commands from both goal descriptions and solution code.
+extractCommandUsages :: Int -> ScenarioInfoPair -> TutorialInfo
+extractCommandUsages idx siPair@(s, _si) =
+  TutorialInfo siPair idx solnCommands $ getDescCommands s
+ where
+  solnCommands = getCommands maybeSoln
+  maybeSoln = view scenarioSolution s
+
+-- | Obtain the set of all commands mentioned by
+-- name in the tutorial's goal descriptions.
+getDescCommands :: Scenario -> Set Const
+getDescCommands s =
+  S.fromList $ mapMaybe (`M.lookup` txtLookups) backtickedWords
+ where
+  goalTextParagraphs = concatMap (view objectiveGoal) $ view scenarioObjectives s
+  allWords = concatMap (T.words . T.toLower) goalTextParagraphs
+  getBackticked = T.stripPrefix "`" <=< T.stripSuffix "`"
+  backtickedWords = mapMaybe getBackticked allWords
+
+  commandConsts = filter isConsidered allConst
+  txtLookups = M.fromList $ map (syntax . constInfo &&& id) commandConsts
+
+isConsidered :: Const -> Bool
+isConsidered c = isUserFunc c && c `S.notMember` ignoredCommands
+ where
+  ignoredCommands = S.fromList [Run, Return, Noop, Force]
+
+-- | Extract the command names from the source code of the solution.
+--
+-- NOTE: `noop` gets automatically inserted for an empty `build {}` command
+-- at parse time, so we explicitly ignore the `noop` in the case that
+-- the player did not write it explicitly in their code.
+--
+-- Also, the code from `run` is not parsed transitively yet.
+getCommands :: Maybe ProcessedTerm -> Map Const [SrcLoc]
+getCommands Nothing = mempty
+getCommands (Just (ProcessedTerm (Module stx _) _ _)) =
+  M.fromListWith (<>) $ mapMaybe isCommand nodelist
+ where
+  nodelist :: [Syntax' Polytype]
+  nodelist = universe stx
+  isCommand (Syntax' sloc t _) = case t of
+    TConst c -> guard (isConsidered c) >> Just (c, [sloc])
+    _ -> Nothing
+
+-- | "fold" over the tutorials in sequence to determine which
+-- commands are novel to each tutorial's solution.
+computeCommandIntroductions :: [(Int, ScenarioInfoPair)] -> [CoverageInfo]
+computeCommandIntroductions =
+  reverse . tuts . foldl' f initial
+ where
+  initial = CommandAccum mempty mempty
+
+  f :: CommandAccum -> (Int, ScenarioInfoPair) -> CommandAccum
+  f (CommandAccum encounteredPreviously xs) (idx, siPair) =
+    CommandAccum updatedEncountered $ CoverageInfo usages novelCommands : xs
+   where
+    usages = extractCommandUsages idx siPair
+    usedCmdsForTutorial = solutionCommands usages
+
+    updatedEncountered = encounteredPreviously `S.union` M.keysSet usedCmdsForTutorial
+    novelCommands = M.withoutKeys usedCmdsForTutorial encounteredPreviously
+
+-- | Extract the tutorials from the complete scenario collection
+-- and derive their command coverage info.
+generateIntroductionsSequence :: ScenarioCollection -> [CoverageInfo]
+generateIntroductionsSequence =
+  computeCommandIntroductions . zipFrom 0 . getTuts
+ where
+  getTuts =
+    concatMap flatten
+      . scenarioCollectionToList
+      . getTutorials
+
+-- * Rendering functions
+
+-- | Helper for standalone rendering.
+-- For unit tests, can instead access the scenarios via the GameState.
+loadScenarioCollection :: IO ScenarioCollection
+loadScenarioCollection = simpleErrorHandle $ do
+  entities <- ExceptT loadEntities
+  (_, loadedScenarios) <- liftIO $ loadScenariosWithWarnings entities
+  return loadedScenarios
+
+renderUsagesMarkdown :: CoverageInfo -> Text
+renderUsagesMarkdown (CoverageInfo (TutorialInfo (s, si) idx _sCmds dCmds) novelCmds) =
+  T.unlines bodySections
+ where
+  bodySections = firstLine : otherLines
+  otherLines =
+    intercalate
+      [""]
+      [ pure . surround "`" . T.pack $ view scenarioPath si
+      , pure . surround "*" . T.strip $ view scenarioDescription s
+      , renderSection "Introduced in solution" . renderCmdList $ M.keysSet novelCmds
+      , renderSection "Referenced in description" $ renderCmdList dCmds
+      ]
+  surround x y = x <> y <> x
+
+  renderSection title content =
+    ["### " <> title] <> content
+
+  firstLine =
+    T.unwords
+      [ "##"
+      , renderTutorialTitle idx s
+      ]
+
+renderTutorialTitle :: Show a => a -> Scenario -> Text
+renderTutorialTitle idx s =
+  T.unwords
+    [ T.pack $ show idx <> ":"
+    , view scenarioName s
+    ]
+
+linkifyCommand :: Text -> Text
+linkifyCommand c = "[" <> c <> "](" <> commandsWikiAnchorPrefix <> c <> ")"
+
+renderList :: [Text] -> [Text]
+renderList items =
+  if null items
+    then pure "(none)"
+    else map ("* " <>) items
+
+cmdSetToSortedText :: Set Const -> [Text]
+cmdSetToSortedText = sort . map (T.pack . show) . S.toList
+
+renderCmdList :: Set Const -> [Text]
+renderCmdList = renderList . map linkifyCommand . cmdSetToSortedText
+
+renderTutorialProgression :: IO Text
+renderTutorialProgression =
+  processAndRender <$> loadScenarioCollection
+ where
+  processAndRender ss =
+    T.unlines allLines
+   where
+    introSection =
+      "# Command introductions by tutorial"
+        : "This document indicates which tutorials introduce various commands and keywords."
+        : ""
+        : "All used:"
+        : renderFullCmdList allUsed
+
+    render (cmd, tut) =
+      T.unwords
+        [ linkifyCommand cmd
+        , "(" <> renderTutorialTitle (tutIndex tut) (fst $ scenarioPair tut) <> ")"
+        ]
+    renderFullCmdList = renderList . map render . sortOn fst
+    infos = generateIntroductionsSequence ss
+    allLines = introSection <> map renderUsagesMarkdown infos
+    allUsed = concatMap mkTuplesForTutorial infos
+
+    mkTuplesForTutorial tut =
+      map (\x -> (T.pack $ show x, tutIdxScenario)) $
+        M.keys $
+          novelSolutionCommands tut
+     where
+      tutIdxScenario = tutInfo tut

src/Swarm/Game/Exception.hs

@@ -22,6 +22,7 @@ import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
 import GHC.Generics (Generic)
+import Swarm.Constant
 import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Entity (EntityMap, deviceForCap, entityName)
 import Swarm.Language.Capability (Capability (CGod), capabilityName)
@@ -82,7 +83,7 @@ formatExn em = \case
     T.unlines
       [ "Fatal error: " <> t
       , "Please report this as a bug at"
-      , "<https://github.com/swarm-game/swarm/issues/new>."
+      , "<" <> swarmRepoUrl <> "issues/new>."
       ]
   InfiniteLoop -> "Infinite loop detected!"
   (CmdFailed c t _) -> T.concat [prettyText c, ": ", t]
@@ -141,7 +142,7 @@ formatIncapable em f (Requirements caps _ inv) tm
         [ "Missing the " <> capMsg <> " for:"
         , squote $ prettyText tm
         , "but no device yet provides it. See"
-        , "https://github.com/swarm-game/swarm/issues/26"
+        , swarmRepoUrl <> "issues/26"
         ]
   | not (S.null caps) =
       unlinesExText