{-# LANGUAGE OverloadedStrings #-}
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)
commandsWikiAnchorPrefix :: Text
commandsWikiAnchorPrefix :: Text
commandsWikiAnchorPrefix = Text
wikiCheatSheet forall a. Semigroup a => a -> a -> a
<> Text
"#"
data CoverageInfo = CoverageInfo
{ CoverageInfo -> TutorialInfo
tutInfo :: TutorialInfo
, CoverageInfo -> Map Const [SrcLoc]
novelSolutionCommands :: Map Const [SrcLoc]
}
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
}
data CommandAccum = CommandAccum
{ CommandAccum -> Set Const
_encounteredCmds :: Set Const
, CommandAccum -> [CoverageInfo]
tuts :: [CoverageInfo]
}
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
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]
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
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
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
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
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
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