{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Pedagogical soundness of tutorials
--
-- 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.Lens (universe, view, (^.))
import Control.Monad (guard)
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.Sequence (Seq)
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.Failure (SystemFailure, simpleErrorHandle)
import Swarm.Game.Land
import Swarm.Game.Scenario (
  Scenario,
  ScenarioInputs (..),
  scenarioDescription,
  scenarioMetadata,
  scenarioName,
  scenarioObjectives,
  scenarioOperation,
  scenarioSolution,
 )
import Swarm.Game.Scenario.Objective (objectiveGoal)
import Swarm.Game.ScenarioInfo (
  ScenarioCollection,
  ScenarioInfoPair,
  flatten,
  getTutorials,
  loadScenarios,
  scenarioCollectionToList,
  scenarioPath,
 )
import Swarm.Game.World.Load (loadWorlds)
import Swarm.Language.Syntax
import Swarm.Language.Text.Markdown (docToText, findCode)
import Swarm.Language.Types (Polytype)
import Swarm.Util.Effect (ignoreWarnings)

-- * Constants

commandsWikiAnchorPrefix :: Text
commandsWikiAnchorPrefix :: Text
commandsWikiAnchorPrefix = Text
wikiCheatSheet Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#"

-- * Types

-- | Tutorials augmented by the set of
-- commands that they introduce.
-- Generated by folding over all of the
-- tutorials in sequence.
data CoverageInfo = CoverageInfo
  { CoverageInfo -> TutorialInfo
tutInfo :: TutorialInfo
  , CoverageInfo -> Map Const [SrcLoc]
novelSolutionCommands :: Map Const [SrcLoc]
  }

-- | Tutorial scenarios with the set of commands
-- introduced in their solution and descriptions
-- having been extracted
data TutorialInfo = TutorialInfo
  { TutorialInfo -> ScenarioInfoPair
scenarioPair :: ScenarioInfoPair
  , TutorialInfo -> Int
tutIndex :: Int
  , TutorialInfo -> Map Const [SrcLoc]
solutionCommands :: Map Const [SrcLoc]
  , TutorialInfo -> Set Const
descriptionCommands :: Set Const
  }

-- | A private type used by the fold
data CommandAccum = CommandAccum
  { CommandAccum -> Set Const
_encounteredCmds :: Set Const
  , CommandAccum -> [CoverageInfo]
tuts :: [CoverageInfo]
  }

-- * Functions

-- | Extract commands from both goal descriptions and solution code.
extractCommandUsages :: Int -> ScenarioInfoPair -> TutorialInfo
extractCommandUsages :: Int -> ScenarioInfoPair -> TutorialInfo
extractCommandUsages Int
idx siPair :: ScenarioInfoPair
siPair@(Scenario
s, ScenarioInfo
_si) =
  ScenarioInfoPair
-> Int -> Map Const [SrcLoc] -> Set Const -> TutorialInfo
TutorialInfo ScenarioInfoPair
siPair Int
idx Map Const [SrcLoc]
solnCommands (Set Const -> TutorialInfo) -> Set Const -> TutorialInfo
forall a b. (a -> b) -> a -> b
$ Scenario -> Set Const
getDescCommands Scenario
s
 where
  solnCommands :: Map Const [SrcLoc]
solnCommands = Maybe (Syntax' Polytype) -> Map Const [SrcLoc]
getCommands Maybe (Syntax' Polytype)
maybeSoln
  maybeSoln :: Maybe (Syntax' Polytype)
maybeSoln = Getting
  (Maybe (Syntax' Polytype)) Scenario (Maybe (Syntax' Polytype))
-> Scenario -> Maybe (Syntax' Polytype)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ScenarioOperation
 -> Const (Maybe (Syntax' Polytype)) ScenarioOperation)
-> Scenario -> Const (Maybe (Syntax' Polytype)) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation
  -> Const (Maybe (Syntax' Polytype)) ScenarioOperation)
 -> Scenario -> Const (Maybe (Syntax' Polytype)) Scenario)
-> ((Maybe (Syntax' Polytype)
     -> Const (Maybe (Syntax' Polytype)) (Maybe (Syntax' Polytype)))
    -> ScenarioOperation
    -> Const (Maybe (Syntax' Polytype)) ScenarioOperation)
-> Getting
     (Maybe (Syntax' Polytype)) Scenario (Maybe (Syntax' Polytype))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Syntax' Polytype)
 -> Const (Maybe (Syntax' Polytype)) (Maybe (Syntax' Polytype)))
-> ScenarioOperation
-> Const (Maybe (Syntax' Polytype)) ScenarioOperation
Lens' ScenarioOperation (Maybe (Syntax' Polytype))
scenarioSolution) Scenario
s

-- | Obtain the set of all commands mentioned by
-- name in the tutorial's goal descriptions.
getDescCommands :: Scenario -> Set Const
getDescCommands :: Scenario -> Set Const
getDescCommands Scenario
s = [Const] -> Set Const
forall a. Ord a => [a] -> Set a
S.fromList ([Const] -> Set Const) -> [Const] -> Set Const
forall a b. (a -> b) -> a -> b
$ (Syntax -> [Const]) -> [Syntax] -> [Const]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Syntax -> [Const]
filterConst [Syntax]
allCode
 where
  goalTextParagraphs :: [Document Syntax]
goalTextParagraphs = Getting (Document Syntax) Objective (Document Syntax)
-> Objective -> Document Syntax
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Document Syntax) Objective (Document Syntax)
Lens' Objective (Document Syntax)
objectiveGoal (Objective -> Document Syntax) -> [Objective] -> [Document Syntax]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [Objective] Scenario [Objective] -> Scenario -> [Objective]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Scenario -> Const [Objective] Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const [Objective] ScenarioOperation)
 -> Scenario -> Const [Objective] Scenario)
-> (([Objective] -> Const [Objective] [Objective])
    -> ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Getting [Objective] Scenario [Objective]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Const [Objective] [Objective])
-> ScenarioOperation -> Const [Objective] ScenarioOperation
Lens' ScenarioOperation [Objective]
scenarioObjectives) Scenario
s
  allCode :: [Syntax]
allCode = (Document Syntax -> [Syntax]) -> [Document Syntax] -> [Syntax]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Document Syntax -> [Syntax]
findCode [Document Syntax]
goalTextParagraphs
  filterConst :: Syntax -> [Const]
  filterConst :: Syntax -> [Const]
filterConst Syntax
sx = (Term -> Maybe Const) -> [Term] -> [Const]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Term -> Maybe Const
toConst ([Term] -> [Const]) -> [Term] -> [Const]
forall a b. (a -> b) -> a -> b
$ Term -> [Term]
forall a. Plated a => a -> [a]
universe (Syntax
sx Syntax -> Getting Term Syntax Term -> Term
forall s a. s -> Getting a s a -> a
^. Getting Term Syntax Term
forall ty (f :: * -> *).
Functor f =>
(Term' ty -> f (Term' ty)) -> Syntax' ty -> f (Syntax' ty)
sTerm)
  toConst :: Term -> Maybe Const
  toConst :: Term -> Maybe Const
toConst = \case
    TConst Const
c -> Const -> Maybe Const
forall a. a -> Maybe a
Just Const
c
    Term
_ -> Maybe Const
forall a. Maybe a
Nothing

isConsidered :: Const -> Bool
isConsidered :: Const -> Bool
isConsidered Const
c = Const -> Bool
isUserFunc Const
c Bool -> Bool -> Bool
&& Const
c Const -> Set Const -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Const
ignoredCommands
 where
  ignoredCommands :: Set Const
ignoredCommands = [Const] -> Set Const
forall a. Ord a => [a] -> Set a
S.fromList [Const
Run, Const
Return, Const
Noop, Const
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 TSyntax -> Map Const [SrcLoc]
getCommands :: Maybe (Syntax' Polytype) -> Map Const [SrcLoc]
getCommands Maybe (Syntax' Polytype)
Nothing = Map Const [SrcLoc]
forall a. Monoid a => a
mempty
getCommands (Just Syntax' Polytype
tsyn) =
  ([SrcLoc] -> [SrcLoc] -> [SrcLoc])
-> [(Const, [SrcLoc])] -> Map Const [SrcLoc]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [SrcLoc] -> [SrcLoc] -> [SrcLoc]
forall a. Semigroup a => a -> a -> a
(<>) ([(Const, [SrcLoc])] -> Map Const [SrcLoc])
-> [(Const, [SrcLoc])] -> Map Const [SrcLoc]
forall a b. (a -> b) -> a -> b
$ (Syntax' Polytype -> Maybe (Const, [SrcLoc]))
-> [Syntax' Polytype] -> [(Const, [SrcLoc])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Syntax' Polytype -> Maybe (Const, [SrcLoc])
forall {ty}. Syntax' ty -> Maybe (Const, [SrcLoc])
isCommand [Syntax' Polytype]
nodelist
 where
  nodelist :: [Syntax' Polytype]
  nodelist :: [Syntax' Polytype]
nodelist = Syntax' Polytype -> [Syntax' Polytype]
forall a. Plated a => a -> [a]
universe Syntax' Polytype
tsyn
  isCommand :: Syntax' ty -> Maybe (Const, [SrcLoc])
isCommand (Syntax' SrcLoc
sloc Term' ty
t Comments
_ ty
_) = case Term' ty
t of
    TConst Const
c -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Const -> Bool
isConsidered Const
c) Maybe () -> Maybe (Const, [SrcLoc]) -> Maybe (Const, [SrcLoc])
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Const, [SrcLoc]) -> Maybe (Const, [SrcLoc])
forall a. a -> Maybe a
Just (Const
c, [SrcLoc
sloc])
    Term' ty
_ -> Maybe (Const, [SrcLoc])
forall a. Maybe a
Nothing

-- | "fold" over the tutorials in sequence to determine which
-- commands are novel to each tutorial's solution.
computeCommandIntroductions :: [(Int, ScenarioInfoPair)] -> [CoverageInfo]
computeCommandIntroductions :: [(Int, ScenarioInfoPair)] -> [CoverageInfo]
computeCommandIntroductions =
  [CoverageInfo] -> [CoverageInfo]
forall a. [a] -> [a]
reverse ([CoverageInfo] -> [CoverageInfo])
-> ([(Int, ScenarioInfoPair)] -> [CoverageInfo])
-> [(Int, ScenarioInfoPair)]
-> [CoverageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandAccum -> [CoverageInfo]
tuts (CommandAccum -> [CoverageInfo])
-> ([(Int, ScenarioInfoPair)] -> CommandAccum)
-> [(Int, ScenarioInfoPair)]
-> [CoverageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandAccum -> (Int, ScenarioInfoPair) -> CommandAccum)
-> CommandAccum -> [(Int, ScenarioInfoPair)] -> CommandAccum
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CommandAccum -> (Int, ScenarioInfoPair) -> CommandAccum
f CommandAccum
initial
 where
  initial :: CommandAccum
initial = Set Const -> [CoverageInfo] -> CommandAccum
CommandAccum Set Const
forall a. Monoid a => a
mempty [CoverageInfo]
forall a. Monoid a => a
mempty

  f :: CommandAccum -> (Int, ScenarioInfoPair) -> CommandAccum
  f :: CommandAccum -> (Int, ScenarioInfoPair) -> CommandAccum
f (CommandAccum Set Const
encounteredPreviously [CoverageInfo]
xs) (Int
idx, ScenarioInfoPair
siPair) =
    Set Const -> [CoverageInfo] -> CommandAccum
CommandAccum Set Const
updatedEncountered ([CoverageInfo] -> CommandAccum) -> [CoverageInfo] -> CommandAccum
forall a b. (a -> b) -> a -> b
$ TutorialInfo -> Map Const [SrcLoc] -> CoverageInfo
CoverageInfo TutorialInfo
usages Map Const [SrcLoc]
novelCommands CoverageInfo -> [CoverageInfo] -> [CoverageInfo]
forall a. a -> [a] -> [a]
: [CoverageInfo]
xs
   where
    usages :: TutorialInfo
usages = Int -> ScenarioInfoPair -> TutorialInfo
extractCommandUsages Int
idx ScenarioInfoPair
siPair
    usedCmdsForTutorial :: Map Const [SrcLoc]
usedCmdsForTutorial = TutorialInfo -> Map Const [SrcLoc]
solutionCommands TutorialInfo
usages

    updatedEncountered :: Set Const
updatedEncountered = Set Const
encounteredPreviously Set Const -> Set Const -> Set Const
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Map Const [SrcLoc] -> Set Const
forall k a. Map k a -> Set k
M.keysSet Map Const [SrcLoc]
usedCmdsForTutorial
    novelCommands :: Map Const [SrcLoc]
novelCommands = Map Const [SrcLoc] -> Set Const -> Map Const [SrcLoc]
forall k a. Ord k => Map k a -> Set k -> Map k a
M.withoutKeys Map Const [SrcLoc]
usedCmdsForTutorial Set Const
encounteredPreviously

-- | Extract the tutorials from the complete scenario collection
-- and derive their command coverage info.
generateIntroductionsSequence :: ScenarioCollection -> [CoverageInfo]
generateIntroductionsSequence :: ScenarioCollection -> [CoverageInfo]
generateIntroductionsSequence =
  [(Int, ScenarioInfoPair)] -> [CoverageInfo]
computeCommandIntroductions ([(Int, ScenarioInfoPair)] -> [CoverageInfo])
-> (ScenarioCollection -> [(Int, ScenarioInfoPair)])
-> ScenarioCollection
-> [CoverageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ScenarioInfoPair] -> [(Int, ScenarioInfoPair)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 ([ScenarioInfoPair] -> [(Int, ScenarioInfoPair)])
-> (ScenarioCollection -> [ScenarioInfoPair])
-> ScenarioCollection
-> [(Int, ScenarioInfoPair)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection -> [ScenarioInfoPair]
getTuts
 where
  getTuts :: ScenarioCollection -> [ScenarioInfoPair]
getTuts =
    (ScenarioItem -> [ScenarioInfoPair])
-> [ScenarioItem] -> [ScenarioInfoPair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ScenarioItem -> [ScenarioInfoPair]
flatten
      ([ScenarioItem] -> [ScenarioInfoPair])
-> (ScenarioCollection -> [ScenarioItem])
-> ScenarioCollection
-> [ScenarioInfoPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection -> [ScenarioItem]
scenarioCollectionToList
      (ScenarioCollection -> [ScenarioItem])
-> (ScenarioCollection -> ScenarioCollection)
-> ScenarioCollection
-> [ScenarioItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection -> ScenarioCollection
getTutorials

-- * Rendering functions

-- | Helper for standalone rendering.
-- For unit tests, can instead access the scenarios via the GameState.
loadScenarioCollection :: IO ScenarioCollection
loadScenarioCollection :: IO ScenarioCollection
loadScenarioCollection = ThrowC SystemFailure IO ScenarioCollection -> IO ScenarioCollection
forall a. ThrowC SystemFailure IO a -> IO a
simpleErrorHandle (ThrowC SystemFailure IO ScenarioCollection
 -> IO ScenarioCollection)
-> ThrowC SystemFailure IO ScenarioCollection
-> IO ScenarioCollection
forall a b. (a -> b) -> a -> b
$ do
  TerrainEntityMaps
tem <- ThrowC SystemFailure IO TerrainEntityMaps
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m TerrainEntityMaps
loadEntitiesAndTerrain

  -- Note we ignore any warnings generated by 'loadWorlds' and
  -- 'loadScenarios' below.  Any warnings will be caught when loading
  -- all the scenarios via the usual code path; we do not need to do
  -- anything with them here while simply rendering pedagogy info.
  WorldMap
worlds <- forall e (m :: * -> *) a.
(Monoid e, Functor m) =>
AccumC e m a -> m a
ignoreWarnings @(Seq SystemFailure) (AccumC (Seq SystemFailure) (ThrowC SystemFailure IO) WorldMap
 -> ThrowC SystemFailure IO WorldMap)
-> AccumC (Seq SystemFailure) (ThrowC SystemFailure IO) WorldMap
-> ThrowC SystemFailure IO WorldMap
forall a b. (a -> b) -> a -> b
$ TerrainEntityMaps
-> AccumC (Seq SystemFailure) (ThrowC SystemFailure IO) WorldMap
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
TerrainEntityMaps -> m WorldMap
loadWorlds TerrainEntityMaps
tem
  forall e (m :: * -> *) a.
(Monoid e, Functor m) =>
AccumC e m a -> m a
ignoreWarnings @(Seq SystemFailure) (AccumC
   (Seq SystemFailure) (ThrowC SystemFailure IO) ScenarioCollection
 -> ThrowC SystemFailure IO ScenarioCollection)
-> AccumC
     (Seq SystemFailure) (ThrowC SystemFailure IO) ScenarioCollection
-> ThrowC SystemFailure IO ScenarioCollection
forall a b. (a -> b) -> a -> b
$ ScenarioInputs
-> AccumC
     (Seq SystemFailure) (ThrowC SystemFailure IO) ScenarioCollection
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> m ScenarioCollection
loadScenarios (ScenarioInputs
 -> AccumC
      (Seq SystemFailure) (ThrowC SystemFailure IO) ScenarioCollection)
-> ScenarioInputs
-> AccumC
     (Seq SystemFailure) (ThrowC SystemFailure IO) ScenarioCollection
forall a b. (a -> b) -> a -> b
$ WorldMap -> TerrainEntityMaps -> ScenarioInputs
ScenarioInputs WorldMap
worlds TerrainEntityMaps
tem

renderUsagesMarkdown :: CoverageInfo -> Text
renderUsagesMarkdown :: CoverageInfo -> Text
renderUsagesMarkdown (CoverageInfo (TutorialInfo (Scenario
s, ScenarioInfo
si) Int
idx Map Const [SrcLoc]
_sCmds Set Const
dCmds) Map Const [SrcLoc]
novelCmds) =
  [Text] -> Text
T.unlines [Text]
bodySections
 where
  bodySections :: [Text]
bodySections = Text
firstLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
otherLines
  otherLines :: [Text]
otherLines =
    [Text] -> [[Text]] -> [Text]
forall a. [a] -> [[a]] -> [a]
intercalate
      [Text
""]
      [ Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
surround Text
"`" (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> [Text]) -> FilePath -> [Text]
forall a b. (a -> b) -> a -> b
$ Getting FilePath ScenarioInfo FilePath -> ScenarioInfo -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FilePath ScenarioInfo FilePath
Lens' ScenarioInfo FilePath
scenarioPath ScenarioInfo
si
      , Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text])
-> (Document Syntax -> Text) -> Document Syntax -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
surround Text
"*" (Text -> Text)
-> (Document Syntax -> Text) -> Document Syntax -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text)
-> (Document Syntax -> Text) -> Document Syntax -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document Syntax -> Text
forall a. PrettyPrec a => Document a -> Text
docToText (Document Syntax -> [Text]) -> Document Syntax -> [Text]
forall a b. (a -> b) -> a -> b
$ Getting (Document Syntax) Scenario (Document Syntax)
-> Scenario -> Document Syntax
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
-> Scenario -> Const (Document Syntax) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
 -> Scenario -> Const (Document Syntax) Scenario)
-> ((Document Syntax -> Const (Document Syntax) (Document Syntax))
    -> ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
-> Getting (Document Syntax) Scenario (Document Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Document Syntax -> Const (Document Syntax) (Document Syntax))
-> ScenarioOperation -> Const (Document Syntax) ScenarioOperation
Lens' ScenarioOperation (Document Syntax)
scenarioDescription) Scenario
s
      , Text -> [Text] -> [Text]
forall {a}. (Semigroup a, IsString a) => a -> [a] -> [a]
renderSection Text
"Introduced in solution" ([Text] -> [Text]) -> (Set Const -> [Text]) -> Set Const -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Const -> [Text]
renderCmdList (Set Const -> [Text]) -> Set Const -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Const [SrcLoc] -> Set Const
forall k a. Map k a -> Set k
M.keysSet Map Const [SrcLoc]
novelCmds
      , Text -> [Text] -> [Text]
forall {a}. (Semigroup a, IsString a) => a -> [a] -> [a]
renderSection Text
"Referenced in description" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Const -> [Text]
renderCmdList Set Const
dCmds
      ]
  surround :: a -> a -> a
surround a
x a
y = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x

  renderSection :: a -> [a] -> [a]
renderSection a
title [a]
content =
    [a
"### " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
title] [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
content

  firstLine :: Text
firstLine =
    [Text] -> Text
T.unwords
      [ Text
"##"
      , Int -> Scenario -> Text
forall a. Show a => a -> Scenario -> Text
renderTutorialTitle Int
idx Scenario
s
      ]

renderTutorialTitle :: (Show a) => a -> Scenario -> Text
renderTutorialTitle :: forall a. Show a => a -> Scenario -> Text
renderTutorialTitle a
idx Scenario
s =
  [Text] -> Text
T.unwords
    [ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ a -> FilePath
forall a. Show a => a -> FilePath
show a
idx FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
":"
    , Getting Text Scenario Text -> Scenario -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ScenarioMetadata -> Const Text ScenarioMetadata)
-> Scenario -> Const Text Scenario
Lens' Scenario ScenarioMetadata
scenarioMetadata ((ScenarioMetadata -> Const Text ScenarioMetadata)
 -> Scenario -> Const Text Scenario)
-> ((Text -> Const Text Text)
    -> ScenarioMetadata -> Const Text ScenarioMetadata)
-> Getting Text Scenario Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> ScenarioMetadata -> Const Text ScenarioMetadata
Lens' ScenarioMetadata Text
scenarioName) Scenario
s
    ]

linkifyCommand :: Text -> Text
linkifyCommand :: Text -> Text
linkifyCommand Text
c = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandsWikiAnchorPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

renderList :: [Text] -> [Text]
renderList :: [Text] -> [Text]
renderList [Text]
items =
  if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
items
    then Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"(none)"
    else (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
items

cmdSetToSortedText :: Set Const -> [Text]
cmdSetToSortedText :: Set Const -> [Text]
cmdSetToSortedText = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> (Set Const -> [Text]) -> Set Const -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text) -> (Const -> FilePath) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> FilePath
forall a. Show a => a -> FilePath
show) ([Const] -> [Text])
-> (Set Const -> [Const]) -> Set Const -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Const -> [Const]
forall a. Set a -> [a]
S.toList

renderCmdList :: Set Const -> [Text]
renderCmdList :: Set Const -> [Text]
renderCmdList = [Text] -> [Text]
renderList ([Text] -> [Text]) -> (Set Const -> [Text]) -> Set Const -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
linkifyCommand ([Text] -> [Text]) -> (Set Const -> [Text]) -> Set Const -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Const -> [Text]
cmdSetToSortedText

-- | Generate a document which lists all the tutorial scenarios,
--   highlighting for each one which commands are introduced for the
--   first time in the canonical solution, and which commands are
--   referenced in the tutorial description.
renderTutorialProgression :: IO Text
renderTutorialProgression :: IO Text
renderTutorialProgression =
  ScenarioCollection -> Text
processAndRender (ScenarioCollection -> Text) -> IO ScenarioCollection -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ScenarioCollection
loadScenarioCollection
 where
  processAndRender :: ScenarioCollection -> Text
processAndRender ScenarioCollection
ss =
    [Text] -> Text
T.unlines [Text]
allLines
   where
    introSection :: [Text]
introSection =
      Text
"# Command introductions by tutorial"
        Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"This document indicates which tutorials introduce various commands and keywords."
        Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
""
        Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"All used:"
        Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [(Text, TutorialInfo)] -> [Text]
renderFullCmdList [(Text, TutorialInfo)]
allUsed

    render :: (Text, TutorialInfo) -> Text
render (Text
cmd, TutorialInfo
tut) =
      [Text] -> Text
T.unwords
        [ Text -> Text
linkifyCommand Text
cmd
        , Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Scenario -> Text
forall a. Show a => a -> Scenario -> Text
renderTutorialTitle (TutorialInfo -> Int
tutIndex TutorialInfo
tut) (ScenarioInfoPair -> Scenario
forall a b. (a, b) -> a
fst (ScenarioInfoPair -> Scenario) -> ScenarioInfoPair -> Scenario
forall a b. (a -> b) -> a -> b
$ TutorialInfo -> ScenarioInfoPair
scenarioPair TutorialInfo
tut) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        ]
    renderFullCmdList :: [(Text, TutorialInfo)] -> [Text]
renderFullCmdList = [Text] -> [Text]
renderList ([Text] -> [Text])
-> ([(Text, TutorialInfo)] -> [Text])
-> [(Text, TutorialInfo)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, TutorialInfo) -> Text) -> [(Text, TutorialInfo)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, TutorialInfo) -> Text
render ([(Text, TutorialInfo)] -> [Text])
-> ([(Text, TutorialInfo)] -> [(Text, TutorialInfo)])
-> [(Text, TutorialInfo)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, TutorialInfo) -> Text)
-> [(Text, TutorialInfo)] -> [(Text, TutorialInfo)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, TutorialInfo) -> Text
forall a b. (a, b) -> a
fst
    infos :: [CoverageInfo]
infos = ScenarioCollection -> [CoverageInfo]
generateIntroductionsSequence ScenarioCollection
ss
    allLines :: [Text]
allLines = [Text]
introSection [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (CoverageInfo -> Text) -> [CoverageInfo] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map CoverageInfo -> Text
renderUsagesMarkdown [CoverageInfo]
infos
    allUsed :: [(Text, TutorialInfo)]
allUsed = (CoverageInfo -> [(Text, TutorialInfo)])
-> [CoverageInfo] -> [(Text, TutorialInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CoverageInfo -> [(Text, TutorialInfo)]
mkTuplesForTutorial [CoverageInfo]
infos

    mkTuplesForTutorial :: CoverageInfo -> [(Text, TutorialInfo)]
mkTuplesForTutorial CoverageInfo
tut =
      (Const -> (Text, TutorialInfo))
-> [Const] -> [(Text, TutorialInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\Const
x -> (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Const -> FilePath
forall a. Show a => a -> FilePath
show Const
x, TutorialInfo
tutIdxScenario)) ([Const] -> [(Text, TutorialInfo)])
-> [Const] -> [(Text, TutorialInfo)]
forall a b. (a -> b) -> a -> b
$
        Map Const [SrcLoc] -> [Const]
forall k a. Map k a -> [k]
M.keys (Map Const [SrcLoc] -> [Const]) -> Map Const [SrcLoc] -> [Const]
forall a b. (a -> b) -> a -> b
$
          CoverageInfo -> Map Const [SrcLoc]
novelSolutionCommands CoverageInfo
tut
     where
      tutIdxScenario :: TutorialInfo
tutIdxScenario = CoverageInfo -> TutorialInfo
tutInfo CoverageInfo
tut