Render markdown in entity descriptions (#1413)

* use `Markdown.Document` as `entityDescription`
* add missing spaces in `chunksOf`
* fix code in `entities.yaml` (mostly types and few outdated snippets)
* add code markdown in craft tutorial
* use colours for types and entities

- closes #1408
- closes #1409

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")

src/Swarm/Game/Step.hs

@@ -88,6 +88,7 @@ import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Pretty (BulletList (BulletList, bulletListItems), prettyText)
 import Swarm.Language.Requirement qualified as R
 import Swarm.Language.Syntax
+import Swarm.Language.Text.Markdown qualified as Markdown
 import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Value
 import Swarm.Util hiding (both)
@@ -383,7 +384,7 @@ hypotheticalRobot c =
     (-1)
     Nothing
     "hypothesis"
-    []
+    mempty
     defaultCosmicLocation
     zero
     defaultRobotDisplay
@@ -1081,7 +1082,7 @@ addSeedBot e (minT, maxT) loc ts =
         ()
         Nothing
         "seed"
-        ["A growing seed."]
+        "A growing seed."
         (Just loc)
         zero
         ( defaultEntityDisplay '.'
@@ -1957,7 +1958,7 @@ execConst c vs s k = do
               ()
               (Just pid)
               displayName
-              ["A robot built by the robot named " <> r ^. robotName <> "."]
+              (Markdown.fromText $ "A robot built by the robot named " <> (r ^. robotName) <> ".")
               (Just (r ^. robotLocation))
               ( ((r ^. robotOrientation) >>= \dir -> guard (dir /= zero) >> return dir)
                   ? north

src/Swarm/Language/Text/Markdown.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- |
 -- SPDX-License-Identifier: BSD-3-Clause
@@ -19,6 +20,9 @@ module Swarm.Language.Text.Markdown (
   Node (..),
   TxtAttr (..),
   fromTextM,
+  fromText,
+  docToText,
+  docToMark,
 
   -- ** Token stream
   StreamNode' (..),
@@ -35,9 +39,10 @@ import Commonmark qualified as Mark
 import Commonmark.Extensions qualified as Mark (rawAttributeSpec)
 import Control.Applicative ((<|>))
 import Control.Arrow (left)
+import Control.Lens ((%~), (&), _head, _last)
 import Control.Monad (void)
+import Data.Char (isSpace)
 import Data.Functor.Identity (Identity (..))
-import Data.List qualified as List
 import Data.List.Split (chop)
 import Data.Maybe (catMaybes)
 import Data.Set (Set)
@@ -47,10 +52,11 @@ import Data.Text qualified as T
 import Data.Tuple.Extra (both, first)
 import Data.Vector (toList)
 import Data.Yaml
+import GHC.Exts qualified (IsList (..), IsString (..))
 import Swarm.Language.Module (moduleAST)
 import Swarm.Language.Parse (readTerm)
 import Swarm.Language.Pipeline (ProcessedTerm (..), processParsedTerm)
-import Swarm.Language.Pretty (prettyText, prettyTypeErrText)
+import Swarm.Language.Pretty (PrettyPrec (..), prettyText, prettyTypeErrText)
 import Swarm.Language.Syntax (Syntax)
 
 -- | The top-level markdown document.
@@ -92,6 +98,18 @@ addTextAttribute :: TxtAttr -> Node c -> Node c
 addTextAttribute a (LeafText as t) = LeafText (Set.insert a as) t
 addTextAttribute _ n = n
 
+normalise :: (Eq c, Semigroup c) => Paragraph c -> Paragraph c
+normalise (Paragraph a) = Paragraph $ go a
+ where
+  go = \case
+    [] -> []
+    (n : ns) -> let (n', ns') = mergeSame n ns in n' : go ns'
+  mergeSame = \case
+    l@(LeafText attrs1 t1) -> \case
+      (LeafText attrs2 t2 : rss) | attrs1 == attrs2 -> mergeSame (LeafText attrs1 $ t1 <> t2) rss
+      rs -> (l, rs)
+    l -> (l,)
+
 -- | Simple text attributes that make it easier to find key info in descriptions.
 data TxtAttr = Strong | Emphasis
   deriving (Eq, Show, Ord)
@@ -108,13 +126,27 @@ instance Mark.Rangeable (Document c) where
 instance Mark.HasAttributes (Document c) where
   addAttributes _ = id
 
+instance GHC.Exts.IsList (Document a) where
+  type Item (Document a) = Paragraph a
+  toList = paragraphs
+  fromList = Document
+
+instance GHC.Exts.IsString (Document Syntax) where
+  fromString = fromText . T.pack
+
+instance GHC.Exts.IsString (Paragraph Syntax) where
+  fromString s = case paragraphs $ GHC.Exts.fromString s of
+    [] -> mempty
+    [p] -> p
+    ps -> error $ "Error: expected one paragraph, but found " <> show (length ps)
+
 -- | Surround some text in double quotes if it is not empty.
 quoteMaybe :: Text -> Text
 quoteMaybe t = if T.null t then t else T.concat ["\"", t, "\""]
 
 instance Mark.IsInline (Paragraph Text) where
   lineBreak = pureP $ txt "\n"
-  softBreak = mempty
+  softBreak = pureP $ txt " "
   str = pureP . txt
   entity = Mark.str
   escapedChar c = Mark.str $ T.pack ['\\', c]
@@ -156,16 +188,20 @@ instance ToJSON (Paragraph Syntax) where
   toJSON = String . toText
 
 instance ToJSON (Document Syntax) where
-  toJSON = String . toText
+  toJSON = String . docToMark
 
 instance FromJSON (Document Syntax) where
-  parseJSON v = parsePars v <|> parseDoc v
+  parseJSON v = parseDoc v <|> parsePars v
    where
     parseDoc = withText "markdown" fromTextM
     parsePars = withArray "markdown paragraphs" $ \a -> do
       (ts :: [Text]) <- mapM parseJSON $ toList a
       fromTextM $ T.intercalate "\n\n" ts
 
+-- | Parse Markdown document, but throw on invalid code.
+fromText :: Text -> Document Syntax
+fromText = either error id . fromTextE
+
 -- | Read Markdown document and parse&validate the code.
 --
 -- If you want only the document with code as `Text`,
@@ -181,12 +217,20 @@ fromTextPure :: Text -> Either String (Document Text)
 fromTextPure t = do
   let spec = Mark.rawAttributeSpec <> Mark.defaultSyntaxSpec <> Mark.rawAttributeSpec
   let runSimple = left show . runIdentity
-  runSimple $ Mark.commonmarkWith spec "markdown" t
+  Document tokenizedDoc <- runSimple $ Mark.commonmarkWith spec "markdown" t
+  return . Document $ normalise <$> tokenizedDoc
 
 --------------------------------------------------------------
 -- DIY STREAM
 --------------------------------------------------------------
 
+-- | Convert 'Document' to 'Text'.
+--
+-- Note that this will strip some markdown, emphasis and bold marks.
+-- If you want to get markdown again, use 'docToMark'.
+docToText :: PrettyPrec a => Document a -> Text
+docToText = T.intercalate "\n\n" . map toText . paragraphs
+
 -- | This is the naive and easy way to get text from markdown document.
 toText :: ToStream a => a -> Text
 toText = streamToText . toStream
@@ -198,7 +242,6 @@ data StreamNode' t
   = TextNode (Set TxtAttr) t
   | CodeNode t
   | RawNode String t
-  | ParagraphBreak
   deriving (Eq, Show, Functor)
 
 type StreamNode = StreamNode' Text
@@ -208,11 +251,8 @@ unStream = \case
   TextNode a t -> (TextNode a, t)
   CodeNode t -> (CodeNode, t)
   RawNode a t -> (RawNode a, t)
-  ParagraphBreak -> error "Logic error: Paragraph break can not be unstreamed!"
 
 -- | Get chunks of nodes not exceeding length and broken at word boundary.
---
--- The split will end when no more nodes (then words) can fit or on 'ParagraphBreak'.
 chunksOf :: Int -> [StreamNode] -> [[StreamNode]]
 chunksOf n = chop (splitter True n)
  where
@@ -221,7 +261,6 @@ chunksOf n = chop (splitter True n)
   splitter :: Bool -> Int -> [StreamNode] -> ([StreamNode], [StreamNode])
   splitter start i = \case
     [] -> ([], [])
-    (ParagraphBreak : ss) -> ([ParagraphBreak], ss)
     (tn : ss) ->
       let l = nodeLength tn
        in if l <= i
@@ -230,13 +269,16 @@ chunksOf n = chop (splitter True n)
   cut :: Bool -> Int -> StreamNode -> (StreamNode, StreamNode)
   cut start i tn =
     let (con, t) = unStream tn
-     in case splitWordsAt i (T.words t) of
+        endSpace = T.takeWhileEnd isSpace t
+        startSpace = T.takeWhile isSpace t
+        twords = T.words t & _head %~ (startSpace <>) & _last %~ (<> endSpace)
+     in case splitWordsAt i twords of
           ([], []) -> (con "", con "")
           ([], ws@(ww : wws)) ->
             both (con . T.unwords) $
               -- In case single word (e.g. web link) does not fit on line we must put
               -- it there and guarantee progress (otherwise chop will cycle)
-              if start then ([ww], wws) else ([], ws)
+              if start then ([T.take i ww], T.drop i ww : wws) else ([], ws)
           splitted -> both (con . T.unwords) splitted
 
 splitWordsAt :: Int -> [Text] -> ([Text], [Text])
@@ -255,7 +297,6 @@ streamToText = T.concat . map nodeToText
     TextNode _a t -> t
     RawNode _s t -> t
     CodeNode stx -> stx
-    ParagraphBreak -> "\n"
 
 -- | Convert elements to one dimensional stream of nodes,
 -- that is easy to format and layout.
@@ -265,15 +306,36 @@ streamToText = T.concat . map nodeToText
 class ToStream a where
   toStream :: a -> [StreamNode]
 
-instance ToStream (Node Syntax) where
+instance PrettyPrec a => ToStream (Node a) where
   toStream = \case
-    LeafText a t -> TextNode a <$> T.lines t
-    LeafCode t -> CodeNode <$> T.lines (prettyText t)
-    LeafRaw s t -> RawNode s <$> T.lines t
-    LeafCodeBlock _i t -> ParagraphBreak : (CodeNode <$> T.lines (prettyText t)) <> [ParagraphBreak]
+    LeafText a t -> [TextNode a t]
+    LeafCode t -> [CodeNode (prettyText t)]
+    LeafRaw s t -> [RawNode s t]
+    LeafCodeBlock _i t -> [CodeNode (prettyText t)]
 
-instance ToStream (Paragraph Syntax) where
+instance PrettyPrec a => ToStream (Paragraph a) where
   toStream = concatMap toStream . nodes
 
-instance ToStream (Document Syntax) where
-  toStream = List.intercalate [ParagraphBreak] . map toStream . paragraphs
+--------------------------------------------------------------
+-- Markdown
+--------------------------------------------------------------
+
+nodeToMark :: PrettyPrec a => Node a -> Text
+nodeToMark = \case
+  LeafText a t -> foldl attr t a
+  LeafRaw _ c -> wrap "`" c
+  LeafCode c -> wrap "`" (prettyText c)
+  LeafCodeBlock f c -> codeBlock f $ prettyText c
+ where
+  codeBlock f t = wrap "```" $ T.pack f <> "\n" <> t <> "\n"
+  wrap c t = c <> t <> c
+  attr t a = case a of
+    Emphasis -> wrap "_" t
+    Strong -> wrap "**" t
+
+paragraphToMark :: PrettyPrec a => Paragraph a -> Text
+paragraphToMark = foldMap nodeToMark . nodes
+
+-- | Convert 'Document' to markdown text.
+docToMark :: PrettyPrec a => Document a -> Text
+docToMark = T.intercalate "\n\n" . map paragraphToMark . paragraphs

src/Swarm/TUI/Controller.hs

@@ -964,8 +964,8 @@ doGoalUpdates = do
         -- automatically popped up.
         gameState . announcementQueue .= mempty
 
-        isAutoplaying <- use $ uiState . uiIsAutoplay
-        unless isAutoplaying $
+        hideGoals <- use $ uiState . uiHideGoals
+        unless hideGoals $
           openModal GoalModal
 
       return goalWasUpdated

src/Swarm/TUI/Model/StateUpdate.hs

@@ -105,7 +105,7 @@ initPersistentState ::
 initPersistentState opts@(AppOpts {..}) = do
   (warnings :: Seq SystemFailure, (initRS, initUI)) <- runAccum mempty $ do
     rs <- initRuntimeState
-    ui <- initUIState speed (not (skipMenu opts)) (cheatMode || autoPlay)
+    ui <- initUIState speed (not (skipMenu opts)) cheatMode
     return (rs, ui)
   let initRS' = addWarnings initRS (F.toList warnings)
   return (initRS', initUI)
@@ -243,7 +243,8 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
     u
       & uiPlaying .~ True
       & uiGoal .~ emptyGoalDisplay
-      & uiIsAutoplay .~ isAutoplaying
+      & uiCheatMode ||~ isAutoplaying
+      & uiHideGoals .~ (isAutoplaying && not (u ^. uiCheatMode))
       & uiFocusRing .~ initFocusRing
       & uiInventory .~ Nothing
       & uiInventorySort .~ defaultSortOptions

src/Swarm/TUI/Model/UI.hs

@@ -26,7 +26,7 @@ module Swarm.TUI.Model.UI (
   uiError,
   uiModal,
   uiGoal,
-  uiIsAutoplay,
+  uiHideGoals,
   uiAchievements,
   lgTicksPerSecond,
   lastFrameTime,
@@ -113,7 +113,7 @@ data UIState = UIState
   , _uiError :: Maybe Text
   , _uiModal :: Maybe Modal
   , _uiGoal :: GoalDisplay
-  , _uiIsAutoplay :: Bool
+  , _uiHideGoals :: Bool
   , _uiAchievements :: Map CategorizedAchievement Attainment
   , _uiShowFPS :: Bool
   , _uiShowREPL :: Bool
@@ -199,8 +199,10 @@ uiModal :: Lens' UIState (Maybe Modal)
 --   has been displayed to the user initially.
 uiGoal :: Lens' UIState GoalDisplay
 
--- | When running with --autoplay, suppress the goal dialogs
-uiIsAutoplay :: Lens' UIState Bool
+-- | When running with --autoplay, suppress the goal dialogs.
+--
+-- For developement, the --cheat flag shows goals again.
+uiHideGoals :: Lens' UIState Bool
 
 -- | Map of achievements that were attained
 uiAchievements :: Lens' UIState (Map CategorizedAchievement Attainment)
@@ -333,7 +335,7 @@ initUIState speedFactor showMainMenu cheatMode = do
           , _uiError = Nothing
           , _uiModal = Nothing
           , _uiGoal = emptyGoalDisplay
-          , _uiIsAutoplay = False
+          , _uiHideGoals = False
           , _uiAchievements = M.fromList $ map (view achievement &&& id) achievements
           , _uiShowFPS = False
           , _uiShowREPL = True

src/Swarm/TUI/View.hs

@@ -1105,7 +1105,7 @@ explainEntry :: AppState -> Entity -> Widget Name
 explainEntry s e =
   vBox $
     [ displayProperties $ Set.toList (e ^. entityProperties)
-    , displayParagraphs (e ^. entityDescription)
+    , drawMarkdown (e ^. entityDescription)
     , explainRecipes s e
     ]
       <> [drawRobotMachine s False | e ^. entityCapabilities . Lens.contains CDebug]
@@ -1251,7 +1251,7 @@ drawRecipe me inv (Recipe ins outs reqs time _weight) =
 
 -- | Ad-hoc entity to represent time - only used in recipe drawing
 timeE :: Entity
-timeE = mkEntity (defaultEntityDisplay '.') "ticks" [] [] []
+timeE = mkEntity (defaultEntityDisplay '.') "ticks" mempty [] []
 
 drawReqs :: IngredientList Entity -> Widget Name
 drawReqs = vBox . map (hCenter . drawReq)

src/Swarm/TUI/View/Objective.hs

@@ -15,7 +15,6 @@ import Control.Lens hiding (Const, from)
 import Data.List (intercalate)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as M
-import Data.Maybe (listToMaybe)
 import Data.Vector qualified as V
 import Swarm.Game.Scenario.Objective
 import Swarm.Language.Text.Markdown qualified as Markdown
@@ -88,11 +87,11 @@ drawGoalListItem _isSelected e = case e of
   Header gs -> withAttr boldAttr $ str $ show gs
   Goal gs obj -> getCompletionIcon obj gs <+> titleWidget
    where
-    textSource = obj ^. objectiveTeaser <|> obj ^. objectiveId <|> listToMaybe (Markdown.toText <$> obj ^. objectiveGoal)
+    textSource = obj ^. objectiveTeaser <|> obj ^. objectiveId <|> Just (Markdown.docToText $ obj ^. objectiveGoal)
     titleWidget = maybe (txt "?") (withEllipsis End) textSource
 
 singleGoalDetails :: GoalEntry -> Widget Name
 singleGoalDetails = \case
-  Goal _gs obj -> layoutParagraphs $ drawMarkdown <$> obj ^. objectiveGoal
+  Goal _gs obj -> drawMarkdown $ obj ^. objectiveGoal
   -- Only Goal entries are selectable, so we should never see this:
   _ -> emptyWidget

src/Swarm/TUI/View/Util.hs

@@ -124,17 +124,20 @@ drawMarkdown d = do
   Widget Greedy Fixed $ do
     ctx <- getContext
     let w = ctx ^. availWidthL
-    let docLines = Markdown.chunksOf w $ Markdown.toStream d
-    render $ vBox $ map (hBox . map mTxt) docLines
+    let docLines = Markdown.chunksOf w . Markdown.toStream <$> Markdown.paragraphs d
+    render . layoutParagraphs $ vBox . map (hBox . map mTxt) <$> docLines
  where
   mTxt = \case
     Markdown.TextNode as t -> foldr applyAttr (txt t) as
     Markdown.CodeNode t -> withAttr highlightAttr $ txt t
-    Markdown.RawNode _f t -> withAttr highlightAttr $ txt t
-    Markdown.ParagraphBreak -> txt ""
+    Markdown.RawNode f t -> withAttr (rawAttr f) $ txt t
   applyAttr a = withAttr $ case a of
     Markdown.Strong -> boldAttr
     Markdown.Emphasis -> italicAttr
+  rawAttr = \case
+    "entity" -> greenAttr
+    "type" -> magentaAttr
+    _snippet -> highlightAttr -- same as plain code
 
 drawLabeledTerrainSwatch :: TerrainType -> Widget Name
 drawLabeledTerrainSwatch a =

test/unit/TestInventory.hs

@@ -109,6 +109,6 @@ testInventory =
         )
     ]
  where
-  x = E.mkEntity (defaultEntityDisplay 'X') "fooX" [] [] []
-  y = E.mkEntity (defaultEntityDisplay 'Y') "fooY" [] [] []
-  z = E.mkEntity (defaultEntityDisplay 'Z') "fooZ" [] [] []
+  x = E.mkEntity (defaultEntityDisplay 'X') "fooX" mempty [] []
+  y = E.mkEntity (defaultEntityDisplay 'Y') "fooY" mempty [] []
+  z = E.mkEntity (defaultEntityDisplay 'Z') "fooZ" mempty [] []