Pretty print code blocks according to widget size

src/swarm-lang/Swarm/Language/Pretty.hs

@@ -54,10 +54,25 @@ ppr = prettyPrec 0
 docToText :: Doc a -> Text
 docToText = RT.renderStrict . layoutPretty defaultLayoutOptions
 
+-- | Render a pretty-printed document as @Text@.
+--   This function consumes number of allowed characters in a
+--   line before introducing a line break. In other words, it
+--   expects the space of the layouter to be supplied.
+docToTextWidth :: Doc a -> Int -> Text
+docToTextWidth doc layoutWidth =
+  RT.renderStrict $ layoutPretty (LayoutOptions (AvailablePerLine layoutWidth 1.0)) doc
+
 -- | Pretty-print something and render it as @Text@.
 prettyText :: (PrettyPrec a) => a -> Text
 prettyText = docToText . ppr
 
+-- | Pretty-print something and render it as @Text@.
+--   This is different than @prettyText@ in the sense that it also
+--   consumes number of allowed characters in a line before introducing
+--   a line break.
+prettyTextWidth :: (PrettyPrec a) => a -> Int -> Text
+prettyTextWidth = docToTextWidth . ppr
+
 -- | Pretty-print something and render it as (preferably) one line @Text@.
 prettyTextLine :: (PrettyPrec a) => a -> Text
 prettyTextLine = RT.renderStrict . layoutPretty (LayoutOptions Unbounded) . group . ppr
@@ -77,6 +92,12 @@ pparens :: Bool -> Doc ann -> Doc ann
 pparens True = group . encloseWithIndent 2 lparen rparen
 pparens False = id
 
+-- | Same as pparens but does not indent the lines. Only encloses
+--   the document with parantheses.
+pparens' :: Bool -> Doc ann -> Doc ann
+pparens' True = group . enclose lparen rparen
+pparens' False = id
+
 encloseWithIndent :: Int -> Doc ann -> Doc ann -> Doc ann -> Doc ann
 encloseWithIndent i l r = nest i . enclose (l <> line') (nest (-2) $ line' <> r)
 
@@ -171,8 +192,8 @@ instance (UnchainableFun t, PrettyPrec t, SubstRec t) => PrettyPrec (TypeF t) wh
       let (iniF, lastF) = unsnocNE $ ty1 <| unchainFun ty2
           funs = (prettyPrec 2 <$> iniF) <> [prettyPrec 1 lastF]
           inLine l r = l <+> "->" <+> r
-          multiLine l r = l <+> "->" <> hardline <> r
-       in pparens (p > 1) . align $
+          multiLine l r = l <+> "->" <> softline <> r
+       in pparens' (p > 1) . align $
             flatAlt (concatWith multiLine funs) (concatWith inLine funs)
     TyRecF x ty ->
       pparens (p > 0) $

src/swarm-tui/Swarm/TUI/View.hs

@@ -118,7 +118,7 @@ import Swarm.Game.Universe
 import Swarm.Game.World.Coords
 import Swarm.Game.World.Gen (Seed)
 import Swarm.Language.Capability (Capability (..), constCaps)
-import Swarm.Language.Pretty (prettyText, prettyTextLine)
+import Swarm.Language.Pretty (prettyText, prettyTextLine, prettyTextWidth)
 import Swarm.Language.Syntax
 import Swarm.Language.Typecheck (inferConst)
 import Swarm.Log
@@ -1276,15 +1276,31 @@ explainCapabilities gs e
       ]
 
   renderCmdInfo c =
-    padTop (Pad 1) $
-      vBox
-        [ hBox
-            [ padRight (Pad 1) (txt . syntax $ constInfo c)
-            , padRight (Pad 1) (txt ":")
-            , withAttr magentaAttr . txt . prettyText $ inferConst c
-            ]
-        , padTop (Pad 1) . padLeft (Pad 1) . txtWrap . briefDoc . constDoc $ constInfo c
-        ]
+    Widget Fixed Fixed $ do
+      ctx <- getContext
+      let w = ctx ^. availWidthL
+          constType = inferConst c
+          info = constInfo c
+          requiredWidthForTypes = textWidth (syntax info <> " : " <> prettyTextLine constType)
+      render
+        . padTop (Pad 1)
+        $ vBox
+          [ hBox
+              [ padRight (Pad 1) (txt $ syntax info)
+              , padRight (Pad 1) (txt ":")
+              , if requiredWidthForTypes <= w
+                  then withAttr magentaAttr . txt $ prettyTextLine constType
+                  else emptyWidget
+              ]
+          , hBox $
+              if requiredWidthForTypes > w
+                then
+                  [ padRight (Pad 1) (txt " ")
+                  , withAttr magentaAttr . txt $ prettyTextWidth constType (w - 2)
+                  ]
+                else [emptyWidget]
+          , padTop (Pad 1) . padLeft (Pad 1) . txtWrap . briefDoc $ constDoc info
+          ]
 
   costWidget cmdsAndCost =
     if null ings