Pedagogy separate refactoring (#1194)

Simplify #1186 by offloading some refactoring.

See [this comment](#1186 (comment)).

data/scenarios/Tutorials/bind2.yaml

@@ -60,7 +60,17 @@ objectives:
       } { return false }
     prerequisite: grab_artifact
 solution: |
-  run "data/scenarios/Tutorials/bind2-solution.sw"
+  build {
+    move; move;
+    turn right;
+    move; move; move; move; move; move;
+    x <- grab;
+    turn left;
+    move;
+    turn left;
+    move; move;
+    place x;
+  }
 entities:
   - name: Hastur
     display:

data/scenarios/Tutorials/crash.yaml

@@ -33,7 +33,14 @@ entities:
       - If you have this, you win!
     properties: [known, portable]
 solution: |
-  run "scenarios/Tutorials/crash-solution.sw"
+  crasher <- build {
+      turn east; move; move; move; log "bye"; move
+  };
+  wait 32;
+  salvager <- build {
+      log "I will bring home the Win!";
+      turn east; move; move; move; salvage; turn back; move; move; give base "Win"
+  };
 robots:
   - name: base
     dir: [0,1]

src/Swarm/DocGen.hs

@@ -26,9 +26,8 @@ module Swarm.DocGen (
 import Control.Arrow (left)
 import Control.Lens (view, (^.))
 import Control.Lens.Combinators (to)
-import Control.Monad (zipWithM, zipWithM_, (<=<))
+import Control.Monad (zipWithM, zipWithM_)
 import Control.Monad.Except (ExceptT (..), liftIO, runExceptT, withExceptT)
-import Data.Bifunctor (Bifunctor (bimap))
 import Data.Containers.ListUtils (nubOrd)
 import Data.Either.Extra (eitherToMaybe)
 import Data.Foldable (find, toList)
@@ -60,7 +59,7 @@ import Swarm.Language.Pretty (prettyText)
 import Swarm.Language.Syntax (Const (..))
 import Swarm.Language.Syntax qualified as Syntax
 import Swarm.Language.Typecheck (inferConst)
-import Swarm.Util (isRightOr, listEnums, quote)
+import Swarm.Util (both, guardRight, listEnums, quote, simpleErrorHandle)
 import Text.Dot (Dot, NodeId, (.->.))
 import Text.Dot qualified as Dot
 import Witch (from)
@@ -577,16 +576,3 @@ i .~>. j = Dot.edge i j [("style", "invis")]
 e1 ---<> e2 = Dot.edge e1 e2 attrs
  where
   attrs = [("arrowhead", "diamond"), ("color", "blue")]
-
--- ----------------------------------------------------------------------------
--- UTILITY
--- ----------------------------------------------------------------------------
-
-both :: Bifunctor p => (a -> d) -> p a a -> p d d
-both f = bimap f f
-
-guardRight :: Text -> Either Text a -> ExceptT Text IO a
-guardRight what i = i `isRightOr` (\e -> "Failed to " <> what <> ": " <> e)
-
-simpleErrorHandle :: ExceptT Text IO a -> IO a
-simpleErrorHandle = either (fail . unpack) pure <=< runExceptT

src/Swarm/Game/ScenarioInfo.hs

@@ -26,6 +26,7 @@ module Swarm.Game.ScenarioInfo (
   -- * Scenario collection
   ScenarioCollection (..),
   scenarioCollectionToList,
+  flatten,
   scenarioItemByPath,
   normalizeScenarioPath,
   ScenarioItem (..),
@@ -34,6 +35,7 @@ module Swarm.Game.ScenarioInfo (
 
   -- * Loading and saving scenarios
   loadScenarios,
+  loadScenariosWithWarnings,
   loadScenarioInfo,
   saveScenarioInfo,
 
@@ -227,6 +229,10 @@ scenarioCollectionToList :: ScenarioCollection -> [ScenarioItem]
 scenarioCollectionToList (SC Nothing m) = M.elems m
 scenarioCollectionToList (SC (Just order) m) = (m M.!) <$> order
 
+flatten :: ScenarioItem -> [ScenarioInfoPair]
+flatten (SISingle p) = [p]
+flatten (SICollection _ c) = concatMap flatten $ scenarioCollectionToList c
+
 -- | Load all the scenarios from the scenarios data directory.
 loadScenarios ::
   EntityMap ->
@@ -237,11 +243,25 @@ loadScenarios em = do
  where
   p = "scenarios"
 
+loadScenariosWithWarnings :: EntityMap -> IO ([SystemFailure], ScenarioCollection)
+loadScenariosWithWarnings entities = do
+  eitherLoadedScenarios <- runExceptT $ loadScenarios entities
+  return $ case eitherLoadedScenarios of
+    Left xs -> (xs, SC mempty mempty)
+    Right (warnings, x) -> (warnings, x)
+
 -- | The name of the special file which indicates the order of
 --   scenarios in a folder.
 orderFileName :: FilePath
 orderFileName = "00-ORDER.txt"
 
+readOrderFile ::
+  MonadIO m =>
+  FilePath ->
+  ExceptT [SystemFailure] m [String]
+readOrderFile orderFile =
+  filter (not . null) . lines <$> liftIO (readFile orderFile)
+
 -- | Recursively load all scenarios from a particular directory, and also load
 --   the 00-ORDER file (if any) giving the order for the scenarios.
 loadScenarioDir ::
@@ -263,7 +283,7 @@ loadScenarioDir em dir = do
             <> dirName
             <> ", using alphabetical order"
       return Nothing
-    True -> Just . filter (not . null) . lines <$> liftIO (readFile orderFile)
+    True -> Just <$> readOrderFile orderFile
   fs <- liftIO $ keepYamlOrPublicDirectory dir =<< listDirectory dir
 
   case morder of

src/Swarm/Game/Step.hs

@@ -85,7 +85,7 @@ import Swarm.Language.Requirement qualified as R
 import Swarm.Language.Syntax
 import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Value
-import Swarm.Util
+import Swarm.Util hiding (both)
 import System.Clock (TimeSpec)
 import System.Clock qualified
 import System.Random (UniformRange, uniformR)

src/Swarm/Game/World.hs

@@ -57,7 +57,7 @@ import Data.Map.Strict qualified as M
 import Data.Yaml (FromJSON, ToJSON)
 import GHC.Generics (Generic)
 import Swarm.Game.Location
-import Swarm.Util
+import Swarm.Util ((?))
 import Prelude hiding (lookup)
 
 ------------------------------------------------------------

src/Swarm/TUI/Controller.hs

@@ -32,6 +32,9 @@ module Swarm.TUI.Controller (
 
   -- ** Info panel
   handleInfoPanelEvent,
+
+  -- ** Utils
+  getTutorials,
 ) where
 
 import Brick hiding (Direction, Location)
@@ -97,7 +100,7 @@ import Swarm.TUI.Model.StateUpdate
 import Swarm.TUI.Model.UI
 import Swarm.TUI.View (generateModal)
 import Swarm.TUI.View.Objective qualified as GR
-import Swarm.Util hiding ((<<.=))
+import Swarm.Util hiding (both, (<<.=))
 import Swarm.Version (NewReleaseFailure (..))
 import System.Clock
 import System.FilePath (splitDirectories)

src/Swarm/Util.hs

@@ -17,6 +17,7 @@ module Swarm.Util (
   uniq,
   binTuples,
   findDup,
+  both,
 
   -- * Directory utilities
   readFileMay,
@@ -45,6 +46,8 @@ module Swarm.Util (
   isJustOr,
   isRightOr,
   isSuccessOr,
+  guardRight,
+  simpleErrorHandle,
 
   -- * Template Haskell utilities
   liftText,
@@ -65,8 +68,9 @@ import Control.Algebra (Has)
 import Control.Effect.State (State, modify, state)
 import Control.Effect.Throw (Throw, throwError)
 import Control.Lens (ASetter', Lens', LensLike, LensLike', Over, lens, (<>~))
-import Control.Monad (unless)
-import Data.Bifunctor (first)
+import Control.Monad (unless, (<=<))
+import Control.Monad.Except (ExceptT (..), runExceptT)
+import Data.Bifunctor (Bifunctor (bimap), first)
 import Data.Char (isAlphaNum)
 import Data.Either.Validation
 import Data.List (maximumBy, partition)
@@ -158,6 +162,9 @@ findDup = go S.empty
     | a `S.member` seen = Just a
     | otherwise = go (S.insert a seen) as
 
+both :: Bifunctor p => (a -> d) -> p a a -> p d d
+both f = bimap f f
+
 ------------------------------------------------------------
 -- Directory stuff
 
@@ -312,6 +319,12 @@ isSuccessOr :: Has (Throw e) sig m => Validation b a -> (b -> e) -> m a
 Success a `isSuccessOr` _ = return a
 Failure b `isSuccessOr` f = throwError (f b)
 
+guardRight :: Text -> Either Text a -> ExceptT Text IO a
+guardRight what i = i `isRightOr` (\e -> "Failed to " <> what <> ": " <> e)
+
+simpleErrorHandle :: ExceptT Text IO a -> IO a
+simpleErrorHandle = either (fail . T.unpack) pure <=< runExceptT
+
 ------------------------------------------------------------
 -- Template Haskell utilities