Use markdown for entity description in haskell

src/Swarm/Doc/Gen.hs

@@ -65,6 +65,7 @@ import Swarm.Util (both, guardRight, listEnums, quote, simpleErrorHandle)
 import Text.Dot (Dot, NodeId, (.->.))
 import Text.Dot qualified as Dot
 import Witch (from)
+import Swarm.Language.Text.Markdown as Markdown (toText)
 
 -- ============================================================================
 -- MAIN ENTRYPOINT TO CLI DOCUMENTATION GENERATOR
@@ -368,7 +369,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.toText $ view E.entityDescription e]
  where
   props = view E.entityProperties e
   caps = Set.toList $ view E.entityCapabilities e

src/Swarm/Game/Entity.hs

@@ -106,11 +106,13 @@ import Swarm.Game.Failure (AssetData (Entities), prettyFailure)
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (getDataFileNameSafe)
 import Swarm.Language.Capability
-import Swarm.Util (binTuples, failT, findDup, plural, quote, reflow, (?))
+import Swarm.Util (binTuples, failT, findDup, plural, quote, (?))
 import Swarm.Util.Yaml
 import Text.Read (readMaybe)
 import Witch
 import Prelude hiding (lookup)
+import Swarm.Language.Text.Markdown (Document, toText)
+import Swarm.Language.Syntax (Syntax)
 
 ------------------------------------------------------------
 -- Properties
@@ -210,7 +212,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
@@ -242,7 +244,7 @@ instance Hashable Entity where
       `hashWithSalt` disp
       `hashWithSalt` nm
       `hashWithSalt` pl
-      `hashWithSalt` descr
+      `hashWithSalt` toText descr
       `hashWithSalt` orient
       `hashWithSalt` grow
       `hashWithSalt` yld
@@ -271,7 +273,7 @@ mkEntity ::
   -- | Entity name
   Text ->
   -- | Entity description
-  [Text] ->
+  Document Syntax ->
   -- | Properties
   [EntityProperty] ->
   -- | Capabilities
@@ -336,7 +338,7 @@ instance FromJSON Entity where
               <$> v .: "display"
               <*> v .: "name"
               <*> v .:? "plural"
-              <*> (map reflow <$> (v .: "description"))
+              <*> (v .: "description")
               <*> v .:? "orientation"
               <*> v .:? "growth"
               <*> v .:? "yields"
@@ -423,7 +425,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/Robot.hs

@@ -105,6 +105,8 @@ import Swarm.Language.Value as V
 import Swarm.Util.Lens (makeLensesExcluding)
 import Swarm.Util.Yaml
 import System.Clock (TimeSpec)
+import Swarm.Language.Text.Markdown (Document)
+import Swarm.Language.Syntax (Syntax)
 
 -- | A record that stores the information
 --   for all definitions stored in a 'Robot'
@@ -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/Step.hs

@@ -85,6 +85,7 @@ import Swarm.Language.Capability
 import Swarm.Language.Context hiding (delete)
 import Swarm.Language.Key (parseKeyComboFull)
 import Swarm.Language.Parse (runParser)
+import Swarm.Language.Text.Markdown qualified as Markdown
 import Swarm.Language.Pipeline
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Pretty (BulletList (BulletList, bulletListItems), prettyText)
@@ -384,7 +385,7 @@ hypotheticalRobot c =
     (-1)
     Nothing
     "hypothesis"
-    []
+    mempty
     defaultCosmicLocation
     zero
     defaultRobotDisplay
@@ -1082,7 +1083,7 @@ addSeedBot e (minT, maxT) loc ts =
         ()
         Nothing
         "seed"
-        ["A growing seed."]
+        "A growing seed."
         (Just loc)
         zero
         ( defaultEntityDisplay '.'
@@ -1958,7 +1959,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,7 @@ module Swarm.Language.Text.Markdown (
   Node (..),
   TxtAttr (..),
   fromTextM,
+  fromText,
 
   -- ** Token stream
   StreamNode' (..),
@@ -52,6 +54,7 @@ import Swarm.Language.Parse (readTerm)
 import Swarm.Language.Pipeline (ProcessedTerm (..), processParsedTerm)
 import Swarm.Language.Pretty (prettyText, prettyTypeErrText)
 import Swarm.Language.Syntax (Syntax)
+import GHC.Exts qualified (IsList(..), IsString(..)) 
 
 -- | The top-level markdown document.
 newtype Document c = Document {paragraphs :: [Paragraph c]}
@@ -108,13 +111,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]
@@ -159,13 +176,17 @@ instance ToJSON (Document Syntax) where
   toJSON = String . toText
 
 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`,
@@ -255,7 +276,7 @@ streamToText = T.concat . map nodeToText
     TextNode _a t -> t
     RawNode _s t -> t
     CodeNode stx -> stx
-    ParagraphBreak -> "\n"
+    ParagraphBreak -> "\n\n"
 
 -- | Convert elements to one dimensional stream of nodes,
 -- that is easy to format and layout.

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)