From 1addecd9b509476361dcc675c8bf5eb18ab0db58 Mon Sep 17 00:00:00 2001 From: Nitin Prakash Date: Tue, 4 Jun 2024 11:08:48 +0530 Subject: [PATCH 1/5] Pretty print code blocks according to widget size --- src/swarm-lang/Swarm/Language/Pretty.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index 8d11deace..c85ab655e 100644 --- a/src/swarm-lang/Swarm/Language/Pretty.hs +++ b/src/swarm-lang/Swarm/Language/Pretty.hs @@ -170,7 +170,7 @@ instance ((UnchainableFun t), (PrettyPrec t)) => PrettyPrec (TypeF t) where 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 + multiLine l r = l <+> "-> " <> softline' <> r in pparens (p > 1) . align $ flatAlt (concatWith multiLine funs) (concatWith inLine funs) -- Fallthrough cases for type constructor application. Handles base From bb92c9a1cd49fccc8b85371b4e920a070b9dc7fe Mon Sep 17 00:00:00 2001 From: Nitin Prakash Date: Wed, 5 Jun 2024 15:09:32 +0530 Subject: [PATCH 2/5] utilities for widget aware text --- src/swarm-lang/Swarm/Language/Pretty.hs | 15 +++++++++++++++ src/swarm-tui/Swarm/TUI/View.hs | 24 ++++++++++++++---------- 2 files changed, 29 insertions(+), 10 deletions(-) diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index c85ab655e..46651e006 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 diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs index bf7fe1e17..fb9078f7c 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 qualified as W 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,19 @@ 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 + render + . padTop (Pad 1) + $ vBox + [ hBox + [ padRight (Pad 1) (txt . syntax $ constInfo c) + , padRight (Pad 1) (txt ":") + , withAttr magentaAttr . txt $ prettyTextWidth (inferConst c) w + ] + , padTop (Pad 1) . padLeft (Pad 1) . txtWrap . briefDoc . constDoc $ constInfo c + ] costWidget cmdsAndCost = if null ings From ba09e0c8bec03ac2c44492950774a1efe308773b Mon Sep 17 00:00:00 2001 From: Nitin Prakash Date: Sat, 15 Jun 2024 22:15:18 +0530 Subject: [PATCH 3/5] fixes --- src/swarm-lang/Swarm/Language/Pretty.hs | 2 +- src/swarm-tui/Swarm/TUI/View.hs | 18 +++++++++++++++--- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index 389db9fa3..7ce4fa10a 100644 --- a/src/swarm-lang/Swarm/Language/Pretty.hs +++ b/src/swarm-lang/Swarm/Language/Pretty.hs @@ -186,7 +186,7 @@ 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 + multiLine l r = l <+> "->" <+> softline' <> r in pparens (p > 1) . align $ flatAlt (concatWith multiLine funs) (concatWith inLine funs) TyRecF x ty -> diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs index fb9078f7c..675a7bf91 100644 --- a/src/swarm-tui/Swarm/TUI/View.hs +++ b/src/swarm-tui/Swarm/TUI/View.hs @@ -1279,15 +1279,27 @@ explainCapabilities gs e 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 $ constInfo c) + [ padRight (Pad 1) (txt $ syntax info) , padRight (Pad 1) (txt ":") - , withAttr magentaAttr . txt $ prettyTextWidth (inferConst c) w + , if requiredWidthForTypes <= w + then withAttr magentaAttr . txt $ prettyTextLine constType + else emptyWidget ] - , padTop (Pad 1) . padLeft (Pad 1) . txtWrap . briefDoc . constDoc $ constInfo c + , 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 = From 3e1cdbcfd59c27be87a84f4bca7760091c186259 Mon Sep 17 00:00:00 2001 From: Nitin Prakash Date: Sat, 15 Jun 2024 23:11:04 +0530 Subject: [PATCH 4/5] softline' -> softline --- src/swarm-lang/Swarm/Language/Pretty.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index 7ce4fa10a..74677191a 100644 --- a/src/swarm-lang/Swarm/Language/Pretty.hs +++ b/src/swarm-lang/Swarm/Language/Pretty.hs @@ -186,7 +186,7 @@ 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 <+> "->" <+> softline' <> r + multiLine l r = l <+> "->" <+> softline <> r in pparens (p > 1) . align $ flatAlt (concatWith multiLine funs) (concatWith inLine funs) TyRecF x ty -> From b167c3cafdfa8ea1bc67d1d0b4e399bc17be57b1 Mon Sep 17 00:00:00 2001 From: Nitin Prakash Date: Sun, 16 Jun 2024 00:52:34 +0530 Subject: [PATCH 5/5] new helper --- src/swarm-lang/Swarm/Language/Pretty.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/swarm-lang/Swarm/Language/Pretty.hs b/src/swarm-lang/Swarm/Language/Pretty.hs index 74677191a..357d8b57f 100644 --- a/src/swarm-lang/Swarm/Language/Pretty.hs +++ b/src/swarm-lang/Swarm/Language/Pretty.hs @@ -92,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) @@ -186,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 <+> "->" <+> softline <> 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) $