Render markdown in entity descriptions

bench/Benchmark.hs

@@ -75,7 +75,7 @@ circlerProgram =
 
 -- | Initializes a robot with program prog at location loc facing north.
 initRobot :: ProcessedTerm -> Location -> TRobot
-initRobot prog loc = mkRobot () Nothing "" [] (Just $ Cosmic DefaultRootSubworld loc) north defaultRobotDisplay (initMachine prog Context.empty emptyStore) [] [] False False 0
+initRobot prog loc = mkRobot () Nothing "" mempty (Just $ Cosmic DefaultRootSubworld loc) north defaultRobotDisplay (initMachine prog Context.empty emptyStore) [] [] False False 0
 
 -- | Creates a GameState with numRobot copies of robot on a blank map, aligned
 --   in a row starting at (0,0) and spreading east.

data/entities.yaml

@@ -363,10 +363,7 @@
   - |
     Facilitates the concatenation of text values.
   - |
-    The infix operator
-    ```
-    ++ : text -> text -> text
-    ```
+    The infix operator `++ : text -> text -> text`{=snippet}
     can be used to concatenate two text values.  For example,
   - |
     "Number of widgets: " ++ format numWidgets
@@ -412,22 +409,23 @@
     also be woven into larger configurations such as cloth or nets.
   - |
     An equipped `string`{=entity} device enables several commands for working with
-    `text` values:
+    `text`{=type} values:
   - |
     `format : a -> text` can turn any value into a suitable text
     representation.
   - |
-    The infix operator `++ : text -> text -> text`
+    The infix operator `++ : text -> text -> text`{=snippet}
     can be used to concatenate two text values.  For example,
   - |
     ```
-    "Number of widgets: " ++ format numWidgets
+    let numWidgets = 42
+    in "Number of widgets: " ++ format numWidgets
     ```
   - |
     `chars : text -> int` computes the number of characters in a
-    `text` value.
+    `text`{=type} value.
   - |
-    `split : int -> text -> text * text` splits a `text` value into
+    `split : int -> text -> text * text` splits a `text`{=type} value into
     two pieces, one before the given index and one after.
   properties: [portable]
   capabilities: [format, concat, charcount, split]
@@ -443,9 +441,9 @@
     enables two functions:
   - |
     `charAt : int -> text -> int` returns the numeric code of the
-    character at a specific index in a (0-indexed) `text` value.
+    character at a specific index in a (0-indexed) `text`{=type} value.
   - |
-    `toChar : int -> text` creates a singleton (length-1) `text`
+    `toChar : int -> text` creates a singleton (length-1) `text`{=type}
     value containing a character with the given numeric code.
   properties: [portable]
   capabilities: [code]
@@ -462,7 +460,7 @@
     ```
     def thrice : cmd unit -> cmd unit = \c. c;c;c end
     ```
-  - defines the function `thrice` which repeats a command three times.
+  - defines the function `thrice`{=snippet} which repeats a command three times.
   properties: [portable, growable]
   growth: [100, 200]
   capabilities: [lambda]
@@ -797,7 +795,7 @@
     attr: device
     char: '%'
   description:
-  - A "tape drive" allows you to `backup`; that is, to `drive` in reverse.
+  - A `tape drive`{=entity} allows you to `backup`; that is, to drive in reverse.
   capabilities: [backup]
   properties: [portable]
 
@@ -1014,7 +1012,8 @@
   - 'Example:'
   - |
     ```
-    if (x > 3) {move} {turn right; move}'
+    let x = 2 in
+    if (x > 3) {move} {turn right; move}
     ```
   properties: [portable]
   capabilities: [cond]
@@ -1129,7 +1128,7 @@
   - "To wait for a message and get the string value, use:"
   - |
     ```
-    l <- listen; log $ \"I have waited for someone to say \" ++ l
+    l <- listen; log $ "I have waited for someone to say " ++ l
     ```
   properties: [portable]
   capabilities: [listen]
@@ -1140,7 +1139,7 @@
     char: 'C'
   description:
   - |
-    A counter enables the command `count : string -> cmd int`,
+    A counter enables the command `count : text -> cmd int`,
     which counts how many occurrences of an entity are currently
     in the inventory.  This is an upgraded version of the `has`
     command, which returns a bool instead of an int and does
@@ -1170,21 +1169,21 @@
     addition to the usual arithmetic on numbers, an ADT calculator can
     also do arithmetic on types!  After all, the helpful typewritten manual
     explains, a type is just a collection of values, and a finite collection
-    of values is just a fancy number.  For example, the type `bool` is
+    of values is just a fancy number.  For example, the type `bool`{=type} is
     just a fancy version of the number 2, where the two things happen to be
-    labelled `false` and `true`.  There are also types `unit` and
-    `void` that correspond to 1 and 0, respectively.
+    labelled `false` and `true`.  There are also types `unit`{=type} and
+    `void`{=type} that correspond to 1 and 0, respectively.
   - |
     The product of two types is a type of pairs, since, for example,
-    if `t` is a type with three elements, then there are 2 * 3 = 6
-    different pairs containing a `bool` and a `t`, that is, 6 elements
-    of type `bool * t`.  For working with products of types, the ADT
-    calculator enables pair syntax `(a, b)` as well as the projection
+    if `t`{=type} is a type with three elements, then there are 2 * 3 = 6
+    different pairs containing a `bool`{=type} and a `t`{=type}, that is, 6 elements
+    of type `bool * t`{=type}.  For working with products of types, the ADT
+    calculator enables pair syntax `(1, "Hi!")` as well as the projection
     functions `fst : a * b -> a` and `snd : a * b -> b`.
   - |
     The sum of two types is a type with two options; for example, a
-    value of type `bool + t` is either a `bool` value or a `t` value,
-    and there are 2 + 3 = 5 such values.  For working with sums of
+    value of type `bool + t`{=type} is either a `bool`{=type} value or a `t`{=type} value,
+    and there are `2 + 3 == 5` such values.  For working with sums of
     types, the ADT calculator provides the injection functions `inl :
     a -> a + b` and `inr : b -> a + b`, as well as the case analysis
     function `case : (a + b) -> (a -> c) -> (b -> c) -> c`.  For
@@ -1279,7 +1278,7 @@
     robot A executes the following code:"
   - |
     ```
-    b <- ishere "rock"; if b {grab} {}
+    b <- ishere "rock"; if b {grab; return ()} {}
     ```
   - "This seems like a safe way to execute `grab` only when there is a
     rock to grab.  However, it is actually possible for the `grab` to
@@ -1289,7 +1288,7 @@
   - "To prevent this situation, robot A can wrap the commands in `atomic`, like so:"
   - |
     ```
-    atomic (b <- ishere "rock"; if b {grab} {})
+    atomic (b <- ishere "rock"; if b {grab; return ()} {})
     ```
 
   properties: [portable]
@@ -1323,16 +1322,17 @@
     waves off them and listening for the echo.  This capability can be
     accessed via two commands:
   - |
-    `meet : cmd (() + actor)` tries to locate a
+    `meet : cmd (unit + actor)` tries to locate a
     nearby actor (a robot, or... something else?) up to one cell away.
     It returns a reference to the nearest actor, or a unit value if
     none are found.
   - |
     `meetAll : (b -> actor -> cmd b) -> b -> cmd b` runs a command on
     every nearby actor (other than oneself), folding over the results
-    to compute a final result of type `b`.  For example, if `x`, `y`,
-    and `z` are nearby actors, then `meetAll f b0` is equivalent to
-    `b1 <- f b0 x; b2 <- f b1 y; f b2 z`.
+    to compute a final result of type `b`{=type}.  For example, if
+    `x`{=snippet}, `y`{=snippet}, and `z`{=snippet}
+    are nearby actors, then `meetAll f b0`{=snippet} is equivalent to
+    `b1 <- f b0 x; b2 <- f b1 y; f b2 z`{=snippet}.
   properties: [portable]
   capabilities: [meet]
 
@@ -1374,9 +1374,9 @@
   - |
     Also allows manipulating composite values consisting of a
     collection of named fields.  For example, `[x = 2, y = "hi"]`
-    is a value of type `[x : int, y : text]`.  Individual fields
+    is a value of type `[x : int, y : text]`{=type}.  Individual fields
     can be projected using dot notation.  For example,
-    `let r = [y="hi", x=2] in r.x` has the value 2.  The order
+    `let r = [y="hi", x=2] in r.x` has the value `2`.  The order
     of the fields does not matter.
   properties: [portable]
   capabilities: [record]

data/scenarios/Tutorials/craft.yaml

@@ -19,7 +19,7 @@ objectives:
         Note: when used after opening quotes in the REPL, the Tab key can cycle through
         possible completions of a name. E.g., type:
       - |
-        > make "br[Tab][Tab]
+        `> make "br[Tab][Tab]`{=snippet}
     condition: |
       try {
         as base {has "branch predictor"}

scripts/autoplay-tutorials.sh

@@ -0,0 +1,25 @@
+#!/usr/bin/env bash
+
+SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
+
+cd $SCRIPT_DIR/..
+
+if command -v stack &> /dev/null; then
+    SWARM="stack exec swarm --"
+else
+    SWARM="cabal run swarm -O0 --"
+fi
+
+for tutorial in $(cat scenarios/Tutorials/00-ORDER.txt | xargs); do
+    echo -n "$tutorial"
+    $SWARM -i "scenarios/Tutorials/$tutorial" --autoplay --cheat;
+    echo -en "\tCONTINUE [Y/n]: "
+    read answer;
+    case "${answer:0:1}" in
+        n|N )
+            exit 1
+        ;;
+        * )
+        ;;
+    esac
+done

src/Swarm/Doc/Gen.hs

@@ -55,6 +55,7 @@ import Swarm.Language.Key (specialKeyNames)
 import Swarm.Language.Pretty (prettyText)
 import Swarm.Language.Syntax (Const (..))
 import Swarm.Language.Syntax qualified as Syntax
+import Swarm.Language.Text.Markdown as Markdown (docToMark)
 import Swarm.Language.Typecheck (inferConst)
 import Swarm.Util (both, listEnums, quote)
 import Swarm.Util.Effect (simpleErrorHandle)
@@ -359,7 +360,7 @@ entityToSection e =
       <> [" - Properties: " <> T.intercalate ", " (map tshow $ toList props) | not $ null props]
       <> [" - Capabilities: " <> T.intercalate ", " (Capability.capabilityName <$> caps) | not $ null caps]
       <> ["\n"]
-      <> [T.intercalate "\n\n" $ view E.entityDescription e]
+      <> [Markdown.docToMark $ view E.entityDescription e]
  where
   props = view E.entityProperties e
   caps = Set.toList $ view E.entityCapabilities e

src/Swarm/Doc/Pedagogy.hs

@@ -90,7 +90,7 @@ extractCommandUsages idx siPair@(s, _si) =
 getDescCommands :: Scenario -> Set Const
 getDescCommands s = S.fromList $ concatMap filterConst allCode
  where
-  goalTextParagraphs = concatMap (view objectiveGoal) $ view scenarioObjectives s
+  goalTextParagraphs = view objectiveGoal <$> view scenarioObjectives s
   allCode = concatMap findCode goalTextParagraphs
   filterConst :: Syntax -> [Const]
   filterConst sx = mapMaybe toConst $ universe (sx ^. sTerm)

src/Swarm/Game/Entity.hs

@@ -109,7 +109,9 @@ import Swarm.Game.Failure
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (getDataFileNameSafe)
 import Swarm.Language.Capability
-import Swarm.Util (binTuples, failT, findDup, plural, reflow, (?))
+import Swarm.Language.Syntax (Syntax)
+import Swarm.Language.Text.Markdown (Document, docToText)
+import Swarm.Util (binTuples, failT, findDup, plural, (?))
 import Swarm.Util.Effect (withThrow)
 import Swarm.Util.Yaml
 import Text.Read (readMaybe)
@@ -214,7 +216,7 @@ data Entity = Entity
   -- ^ The plural of the entity name, in case it is irregular.  If
   --   this field is @Nothing@, default pluralization heuristics
   --   will be used (see 'plural').
-  , _entityDescription :: [Text]
+  , _entityDescription :: Document Syntax
   -- ^ A longer-form description. Each 'Text' value is one
   --   paragraph.
   , _entityOrientation :: Maybe Heading
@@ -246,7 +248,7 @@ instance Hashable Entity where
       `hashWithSalt` disp
       `hashWithSalt` nm
       `hashWithSalt` pl
-      `hashWithSalt` descr
+      `hashWithSalt` docToText descr
       `hashWithSalt` orient
       `hashWithSalt` grow
       `hashWithSalt` yld
@@ -275,7 +277,7 @@ mkEntity ::
   -- | Entity name
   Text ->
   -- | Entity description
-  [Text] ->
+  Document Syntax ->
   -- | Properties
   [EntityProperty] ->
   -- | Capabilities
@@ -340,7 +342,7 @@ instance FromJSON Entity where
               <$> v .: "display"
               <*> v .: "name"
               <*> v .:? "plural"
-              <*> (map reflow <$> (v .: "description"))
+              <*> (v .: "description")
               <*> v .:? "orientation"
               <*> v .:? "growth"
               <*> v .:? "yields"
@@ -432,7 +434,7 @@ entityNameFor _ = to $ \e ->
 
 -- | A longer, free-form description of the entity.  Each 'Text' value
 --   represents a paragraph.
-entityDescription :: Lens' Entity [Text]
+entityDescription :: Lens' Entity (Document Syntax)
 entityDescription = hashedLens _entityDescription (\e x -> e {_entityDescription = x})
 
 -- | The direction this entity is facing (if it has one).

src/Swarm/Game/Exception.hs

@@ -107,8 +107,8 @@ formatIncapableFix = \case
 -- >>> import Control.Algebra (run)
 -- >>> import Swarm.Game.Failure (LoadingFailure)
 -- >>> :set -XTypeApplications
--- >>> w = mkEntity (defaultEntityDisplay 'l') "magic wand" [] [] [CAppear]
--- >>> r = mkEntity (defaultEntityDisplay 'o') "the one ring" [] [] [CAppear]
+-- >>> w = mkEntity (defaultEntityDisplay 'l') "magic wand" mempty mempty [CAppear]
+-- >>> r = mkEntity (defaultEntityDisplay 'o') "the one ring" mempty mempty [CAppear]
 -- >>> m = fromRight mempty . run . runThrow @LoadingFailure $ buildEntityMap [w,r]
 -- >>> incapableError cs t = putStr . unpack $ formatIncapable m FixByEquip cs t
 --

src/Swarm/Game/Robot.hs

@@ -99,6 +99,8 @@ import Swarm.Game.Universe
 import Swarm.Language.Capability (Capability)
 import Swarm.Language.Context qualified as Ctx
 import Swarm.Language.Requirement (ReqCtx)
+import Swarm.Language.Syntax (Syntax)
+import Swarm.Language.Text.Markdown (Document)
 import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Types (TCtx)
 import Swarm.Language.Value as V
@@ -444,7 +446,7 @@ mkRobot ::
   -- | Name of the robot.
   Text ->
   -- | Description of the robot.
-  [Text] ->
+  Document Syntax ->
   -- | Initial location.
   RobotLocation phase ->
   -- | Initial heading/direction.
@@ -501,7 +503,7 @@ instance FromJSONE EntityMap TRobot where
 
     mkRobot () Nothing
       <$> liftE (v .: "name")
-      <*> liftE (v .:? "description" .!= [])
+      <*> liftE (v .:? "description" .!= mempty)
       <*> liftE (v .:? "loc")
       <*> liftE (v .:? "dir" .!= zero)
       <*> localE (const defDisplay) (v ..:? "display" ..!= defDisplay)

src/Swarm/Game/Scenario/Objective.hs

@@ -66,7 +66,7 @@ instance FromJSON PrerequisiteConfig where
 -- | An objective is a condition to be achieved by a player in a
 --   scenario.
 data Objective = Objective
-  { _objectiveGoal :: [Markdown.Document Syntax]
+  { _objectiveGoal :: Markdown.Document Syntax
   , _objectiveTeaser :: Maybe Text
   , _objectiveCondition :: ProcessedTerm
   , _objectiveId :: Maybe ObjectiveLabel
@@ -84,7 +84,7 @@ instance ToSample Objective where
 
 -- | An explanation of the goal of the objective, shown to the player
 --   during play.  It is represented as a list of paragraphs.
-objectiveGoal :: Lens' Objective [Markdown.Document Syntax]
+objectiveGoal :: Lens' Objective (Markdown.Document Syntax)
 
 -- | A very short (3-5 words) description of the goal for
 -- displaying on the left side of the Objectives modal.
@@ -122,7 +122,7 @@ objectiveAchievement :: Lens' Objective (Maybe AchievementInfo)
 instance FromJSON Objective where
   parseJSON = withObject "objective" $ \v ->
     Objective
-      <$> (v .:? "goal" .!= [])
+      <$> (v .:? "goal" .!= mempty)
       <*> (v .:? "teaser")
       <*> (v .: "condition")
       <*> (v .:? "id")