diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index 40325e71e..357d8b57f 100644 --- a/src/swarm-lang/Swarm/Language/Pretty.hs +++ b/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) $ diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs index 8ccd6ec32..d77163257 100644 --- a/src/swarm-tui/Swarm/TUI/View.hs +++ b/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