{-# 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.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.Entity (loadEntities)
import Swarm.Game.Failure (SystemFailure)
import Swarm.Game.Scenario (Scenario, scenarioDescription, scenarioName, scenarioObjectives, scenarioSolution)
import Swarm.Game.Scenario.Objective (objectiveGoal)
import Swarm.Game.ScenarioInfo (ScenarioCollection, ScenarioInfoPair, flatten, loadScenarios, scenarioCollectionToList, scenarioPath)
import Swarm.Game.World.Load (loadWorlds)
import Swarm.Language.Module (Module (..))
import Swarm.Language.Pipeline (ProcessedTerm (..))
import Swarm.Language.Syntax
import Swarm.Language.Text.Markdown (docToText, findCode)
import Swarm.Language.Types (Polytype)
import Swarm.TUI.Controller (getTutorials)
import Swarm.Util.Effect (ignoreWarnings, simpleErrorHandle)

-- * Constants

commandsWikiAnchorPrefix :: Text
commandsWikiAnchorPrefix :: Text
commandsWikiAnchorPrefix = Text
wikiCheatSheet 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 forall a b. (a -> b) -> a -> b
$ Scenario -> Set Const
getDescCommands Scenario
s
 where
  solnCommands :: Map Const [SrcLoc]
solnCommands = Maybe ProcessedTerm -> Map Const [SrcLoc]
getCommands Maybe ProcessedTerm
maybeSoln
  maybeSoln :: Maybe ProcessedTerm
maybeSoln = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Scenario (Maybe ProcessedTerm)
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 = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Syntax -> [Const]
filterConst [Syntax]
allCode
 where
  goalTextParagraphs :: [Document Syntax]
goalTextParagraphs = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Objective (Document Syntax)
objectiveGoal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Scenario [Objective]
scenarioObjectives Scenario
s
  allCode :: [Syntax]
allCode = 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Term -> Maybe Const
toConst forall a b. (a -> b) -> a -> b
$ forall a. Plated a => a -> [a]
universe (Syntax
sx forall s a. s -> Getting a s a -> a
^. forall ty. Lens' (Syntax' ty) (Term' ty)
sTerm)
  toConst :: Term -> Maybe Const
  toConst :: Term -> Maybe Const
toConst = \case
    TConst Const
c -> forall a. a -> Maybe a
Just Const
c
    Term
_ -> forall a. Maybe a
Nothing

isConsidered :: Const -> Bool
isConsidered :: Const -> Bool
isConsidered Const
c = Const -> Bool
isUserFunc Const
c Bool -> Bool -> Bool
&& Const
c forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Const
ignoredCommands
 where
  ignoredCommands :: Set Const
ignoredCommands = 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 ProcessedTerm -> Map Const [SrcLoc]
getCommands :: Maybe ProcessedTerm -> Map Const [SrcLoc]
getCommands Maybe ProcessedTerm
Nothing = forall a. Monoid a => a
mempty
getCommands (Just (ProcessedTerm (Module Syntax' Polytype
stx Ctx Polytype
_) Requirements
_ ReqCtx
_)) =
  forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {ty}. Syntax' ty -> Maybe (Const, [SrcLoc])
isCommand [Syntax' Polytype]
nodelist
 where
  nodelist :: [Syntax' Polytype]
  nodelist :: [Syntax' Polytype]
nodelist = forall a. Plated a => a -> [a]
universe Syntax' Polytype
stx
  isCommand :: Syntax' ty -> Maybe (Const, [SrcLoc])
isCommand (Syntax' SrcLoc
sloc Term' ty
t ty
_) = case Term' ty
t of
    TConst Const
c -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Const -> Bool
isConsidered Const
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (Const
c, [SrcLoc
sloc])
    Term' ty
_ -> 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 =
  forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandAccum -> [CoverageInfo]
tuts forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Monoid a => a
mempty 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 forall a b. (a -> b) -> a -> b
$ TutorialInfo -> Map Const [SrcLoc] -> CoverageInfo
CoverageInfo TutorialInfo
usages Map Const [SrcLoc]
novelCommands 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 forall a. Ord a => Set a -> Set a -> Set a
`S.union` forall k a. Map k a -> Set k
M.keysSet Map Const [SrcLoc]
usedCmdsForTutorial
    novelCommands :: Map Const [SrcLoc]
novelCommands = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection -> [ScenarioInfoPair]
getTuts
 where
  getTuts :: ScenarioCollection -> [ScenarioInfoPair]
getTuts =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ScenarioItem -> [ScenarioInfoPair]
flatten
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection -> [ScenarioItem]
scenarioCollectionToList
      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 = forall a. ThrowC SystemFailure IO a -> IO a
simpleErrorHandle forall a b. (a -> b) -> a -> b
$ do
  EntityMap
entities <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m EntityMap
loadEntities
  -- 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) forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> m WorldMap
loadWorlds EntityMap
entities
  forall e (m :: * -> *) a.
(Monoid e, Functor m) =>
AccumC e m a -> m a
ignoreWarnings @(Seq SystemFailure) forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> m ScenarioCollection
loadScenarios EntityMap
entities WorldMap
worlds

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 forall a. a -> [a] -> [a]
: [Text]
otherLines
  otherLines :: [Text]
otherLines =
    forall a. [a] -> [[a]] -> [a]
intercalate
      [Text
""]
      [ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Semigroup a => a -> a -> a
surround Text
"`" forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ScenarioInfo FilePath
scenarioPath ScenarioInfo
si
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Semigroup a => a -> a -> a
surround Text
"*" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrettyPrec a => Document a -> Text
docToText forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Scenario (Document Syntax)
scenarioDescription Scenario
s
      , forall {a}. (Semigroup a, IsString a) => a -> [a] -> [a]
renderSection Text
"Introduced in solution" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Const -> [Text]
renderCmdList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
M.keysSet Map Const [SrcLoc]
novelCmds
      , forall {a}. (Semigroup a, IsString a) => a -> [a] -> [a]
renderSection Text
"Referenced in description" 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 forall a. Semigroup a => a -> a -> a
<> a
y forall a. Semigroup a => a -> a -> a
<> a
x

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

  firstLine :: Text
firstLine =
    [Text] -> Text
T.unwords
      [ 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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show a
idx forall a. Semigroup a => a -> a -> a
<> FilePath
":"
    , forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Scenario Text
scenarioName Scenario
s
    ]

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

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

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

renderCmdList :: Set Const -> [Text]
renderCmdList :: Set Const -> [Text]
renderCmdList = [Text] -> [Text]
renderList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
linkifyCommand 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 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"
        forall a. a -> [a] -> [a]
: Text
"This document indicates which tutorials introduce various commands and keywords."
        forall a. a -> [a] -> [a]
: Text
""
        forall a. a -> [a] -> [a]
: Text
"All used:"
        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
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Scenario -> Text
renderTutorialTitle (TutorialInfo -> Int
tutIndex TutorialInfo
tut) (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ TutorialInfo -> ScenarioInfoPair
scenarioPair TutorialInfo
tut) forall a. Semigroup a => a -> a -> a
<> Text
")"
        ]
    renderFullCmdList :: [(Text, TutorialInfo)] -> [Text]
renderFullCmdList = [Text] -> [Text]
renderList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text, TutorialInfo) -> Text
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst
    infos :: [CoverageInfo]
infos = ScenarioCollection -> [CoverageInfo]
generateIntroductionsSequence ScenarioCollection
ss
    allLines :: [Text]
allLines = [Text]
introSection forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map CoverageInfo -> Text
renderUsagesMarkdown [CoverageInfo]
infos
    allUsed :: [(Text, TutorialInfo)]
allUsed = 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 =
      forall a b. (a -> b) -> [a] -> [b]
map (\Const
x -> (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Const
x, TutorialInfo
tutIdxScenario)) forall a b. (a -> b) -> a -> b
$
        forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$
          CoverageInfo -> Map Const [SrcLoc]
novelSolutionCommands CoverageInfo
tut
     where
      tutIdxScenario :: TutorialInfo
tutIdxScenario = CoverageInfo -> TutorialInfo
tutInfo CoverageInfo
tut