From 3295054fa213e586ebbe46adfb0dd607f8b394d7 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Thu, 17 Feb 2022 17:05:45 -0800 Subject: [PATCH] Add DocBox printer for 2D layout. (#8) --- README.md | 7 + spago.dhall | 3 + src/Dodo.purs | 14 +- src/Dodo/Box.purs | 527 ++++++++++++++++++++++++++++++++++ src/Dodo/Internal.purs | 4 +- test/snapshots/DodoBox.output | 58 ++++ test/snapshots/DodoBox.purs | 149 ++++++++++ 7 files changed, 758 insertions(+), 4 deletions(-) create mode 100644 src/Dodo/Box.purs create mode 100644 test/snapshots/DodoBox.output create mode 100644 test/snapshots/DodoBox.purs diff --git a/README.md b/README.md index 9fe8273..d387aa2 100644 --- a/README.md +++ b/README.md @@ -162,7 +162,14 @@ Hello, Dodo inserts the break and indent. "Hello, World!" on a single line would exceed the maximum page width, so it uses the flex default (`break`) instead. +### Two-Dimensional Layouts + +Dodo also supports two-dimensional layouts through the `Dodo.Box` interface. +Boxes can be joined and aligned both vertically and horizontally to create +complex layouts such as tables or grids. + ## Examples * Colorful, flexible JSON printer ([code](test/snapshots/DodoExampleJson.purs), [output](test/snapshots/DodoExampleJson.output)) * Text paragraphs ([code](test/snapshots/DodoTextParagraph.purs), [output](test/snapshots/DodoTextParagraph.output)) +* 2D layout ([code](test/snapshots/DodoBox.purs), [output](test/snapshots/DodoBox.output)) diff --git a/spago.dhall b/spago.dhall index ad5d465..87e678c 100644 --- a/spago.dhall +++ b/spago.dhall @@ -18,6 +18,7 @@ You can edit this file as you like. , "lists" , "maybe" , "minibench" + , "newtype" , "node-buffer" , "node-child-process" , "node-fs-aff" @@ -25,9 +26,11 @@ You can edit this file as you like. , "node-process" , "node-streams" , "parallel" + , "partial" , "posix-types" , "prelude" , "psci-support" + , "safe-coerce" , "strings" , "tuples" ] diff --git a/src/Dodo.purs b/src/Dodo.purs index bb904f3..35e8331 100644 --- a/src/Dodo.purs +++ b/src/Dodo.purs @@ -29,6 +29,7 @@ module Dodo , foldWithSeparator , foldWith , locally + , withLocalOptions , print , Printer(..) , plainText @@ -49,6 +50,7 @@ import Data.String as String import Data.String.Regex as Regex import Data.String.Regex.Flags (global) import Data.String.Regex.Unsafe (unsafeRegex) +import Data.Tuple (Tuple(..)) import Dodo.Internal (Doc(..), Position, LocalOptions, bothNotEmpty, isEmpty, notEmpty) import Dodo.Internal (Doc, Position, bothNotEmpty, isEmpty, notEmpty) as Exports import Dodo.Internal.Buffer (Buffer) @@ -197,7 +199,13 @@ foldWith f = foldr (bothNotEmpty f) mempty -- | *EXPERIMENTAL:* modifies printing state and options locally for a document. -- | This may change or be removed at any time. locally :: forall a. (LocalOptions -> LocalOptions) -> Doc a -> Doc a -locally = Local +locally k doc = Local \options -> Tuple (k options) doc + +-- | *EXPERIMENTAL:* modifies printing state and options locally for a document. +-- | This may change or be removed at any time. Differs from `locally` in that the +-- | document can be responsive to options. +withLocalOptions :: forall a. (LocalOptions -> Tuple LocalOptions (Doc a)) -> Doc a +withLocalOptions = Local -- | Custom printers can be used to render richer documents than just plain -- | text. @@ -453,7 +461,7 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc { annotations = ann : state.annotations , buffer = Buffer.modify (printer.enterAnnotation ann state.annotations) state.buffer } - Local k doc1 -> do + Local k -> do let prevOptions = { indent: state.position.indent @@ -463,7 +471,7 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc , pageWidth: state.options.pageWidth , ribbonRatio: state.options.ribbonRatio } - localOptions = k prevOptions + Tuple localOptions doc1 = k prevOptions go (Doc doc1 : LeaveLocal prevOptions: stk) $ storeOptions state.position.indent localOptions state Empty -> go stk state diff --git a/src/Dodo/Box.purs b/src/Dodo/Box.purs new file mode 100644 index 0000000..e1c53b9 --- /dev/null +++ b/src/Dodo/Box.purs @@ -0,0 +1,527 @@ +module Dodo.Box + ( DocBox + , DocBoxBuffer + , DocAnnStk + , Vertical(..) + , Horizontal(..) + , Align(..) + , BoxSize + , valign + , halign + , vappend + , happend + , vertical + , verticalWithAlign + , horizontal + , horizontalWithAlign + , resize + , fill + , vpadding + , hpadding + , sizeOf + , isEmpty + , empty + , toDoc + , docBox + ) where + +import Prelude + +import Data.Either (Either(..), isLeft) +import Data.Foldable (class Foldable, foldl, foldr) +import Data.Int as Int +import Data.List (List, (:)) +import Data.List as List +import Data.Maybe (Maybe(..)) +import Data.Monoid (power) +import Data.Newtype (class Newtype, under) +import Dodo (Doc, Printer(..), annotate) +import Dodo as Dodo +import Dodo.Internal as Internal +import Partial.Unsafe (unsafeCrashWith) +import Safe.Coerce (coerce) + +data Align + = Start + | Middle + | End + +derive instance Eq Align + +type BoxSize = + { width :: Int + , height :: Int + } + +-- | Unlike `Doc`s, which can only be joined along a line, `DocBox`es +-- | are two-dimensional units which can be stacked vertically and +-- | horizontally (eg. for tables). +-- | +-- | `Doc`s can be lifted into `DocBox` by using the `doxBox` printer. +-- | ```purescript +-- | example = Dodo.print docBox twoSpaces myDoc +-- | ```` +data DocBox a + = DocLine (Doc a) Int + | DocVApp (DocBox a) (DocBox a) BoxSize + | DocHApp (DocBox a) (DocBox a) BoxSize + | DocAlign Align Align (DocBox a) + | DocPad BoxSize + | DocEmpty + +derive instance Functor DocBox + +-- | A newtype whose Semigroup instance stacks DocBoxes vertically. +newtype Vertical a = Vertical (DocBox a) + +derive instance Newtype (Vertical a) _ + +derive newtype instance Functor Vertical + +instance Semigroup (Vertical a) where + append = coerce (vappend :: DocBox a -> _ -> _) + +instance Monoid (Vertical a) where + mempty = Vertical DocEmpty + +-- | A newtype whose Semigroup instance stacks DocBoxes horizontally. +newtype Horizontal a = Horizontal (DocBox a) + +derive instance Newtype (Horizontal a) _ + +derive newtype instance Functor Horizontal + +instance Semigroup (Horizontal a) where + append = coerce (happend :: DocBox a -> _ -> _) + +instance Monoid (Horizontal a) where + mempty = Horizontal DocEmpty + +-- | Joins DocBoxes in a vertical run. +vertical :: forall f a. Foldable f => f (DocBox a) -> DocBox a +vertical = foldr vappend DocEmpty + +-- | Joins DocBoxes in a vertical run with uniform horizontal alignment. +verticalWithAlign :: forall f a. Foldable f => Align -> f (DocBox a) -> DocBox a +verticalWithAlign align = foldr (\a b -> halign align a `vappend` b) DocEmpty + +-- | Joins DocBoxes in a horizontal run. +horizontal :: forall f a. Foldable f => f (DocBox a) -> DocBox a +horizontal = foldr happend DocEmpty + +-- | Joins DocBoxes in a horizontal run with uniform vertical alignment. +horizontalWithAlign :: forall f a. Foldable f => Align -> f (DocBox a) -> DocBox a +horizontalWithAlign align = foldr (\a b -> valign align a `happend` b) DocEmpty + +-- | Joins two DocBoxes vertically on top of each other. +vappend :: forall a. DocBox a -> DocBox a -> DocBox a +vappend = case _, _ of + DocEmpty, b -> b + a, DocEmpty -> a + DocPad sizea, DocPad sizeb -> + DocPad (scale sizea sizeb) + a, b -> + DocVApp a b (scale (sizeOf a) (sizeOf b)) + where + scale sizea sizeb = + { width: max sizea.width sizeb.width + , height: sizea.height + sizeb.height + } + +-- | Joins two DocBoxes horizontally next to each other. +happend :: forall a. DocBox a -> DocBox a -> DocBox a +happend = case _, _ of + DocEmpty, b -> b + a, DocEmpty -> a + DocPad sizea, DocPad sizeb -> + DocPad (scale sizea sizeb) + a, b -> do + DocHApp a b (scale (sizeOf a) (sizeOf b)) + where + scale sizea sizeb = + { width: sizea.width + sizeb.width + , height: max sizea.height sizeb.height + } + +-- | Pads a DocBox vertically to fit the tallest box within a +-- | horizontal run. +-- | ```purescript +-- | example = +-- | valign Middle shortDoc +-- | `happend` tallDoc +-- | ``` +valign :: forall a. Align -> DocBox a -> DocBox a +valign a = case _ of + DocAlign _ b doc + | Start <- a, Start <- b -> doc + | otherwise -> + DocAlign a b doc + other -> + DocAlign a Start other + +-- | Pads a DocBox horizontally to fit the widest line within a +-- | vertical run. +-- | ```purescript +-- | example = +-- | halign Middle skinnyDoc +-- | `vappend` wideDoc +-- | ``` +halign :: forall a. Align -> DocBox a -> DocBox a +halign b = case _ of + DocAlign a _ doc + | Start <- a, Start <- b -> doc + | otherwise -> + DocAlign a b doc + other -> + DocAlign Start b other + +-- | Resizes a box to a larger or equivalent size, positioning its content +-- | according to its alignment. +resize :: forall a. BoxSize -> DocBox a -> DocBox a +resize newSize box = vdoc + where + box' = case box of + DocAlign _ _ b -> b + _ -> box + size = sizeOf box + hpad = newSize.width - size.width + vpad = newSize.height - size.height + hdoc + | hpad <= 0 = valign Start box' + | otherwise = padWithAlign happend hpadding hpad box (halignOf box) + vdoc + | vpad <= 0 = halign Start hdoc + | otherwise = padWithAlign vappend vpadding vpad hdoc (valignOf box) + +padWithAlign :: forall a. (a -> a -> a) -> (Int -> a) -> Int -> a -> Align -> a +padWithAlign appendFn paddingFn padWidth doc = case _ of + Start -> + doc `appendFn` paddingFn padWidth + Middle -> do + let mid = Int.toNumber padWidth / 2.0 + paddingFn (Int.floor mid) + `appendFn` doc + `appendFn` paddingFn (Int.ceil mid) + End -> + paddingFn padWidth `appendFn` doc + +-- | Fills a box to a given size with a Doc. The Doc is assumed +-- | to be 1x1. Providing a Doc of a different size will result +-- | in incorrect layouts. +-- | ``` +-- | example = +-- | fill (Ansi.dim (Dodo.text "-")) +-- | { width: 100 +-- | , height: 1 +-- | } +-- | ``` +fill :: forall a. Doc a -> BoxSize -> DocBox a +fill ch { width, height } = under Vertical (flip power height) line + where + line = case ch of + Internal.Annotate a doc -> + DocLine (annotate a (power doc width)) width + _ -> + DocLine (power ch width) width + +-- | Vertical padding of a specific height. +vpadding :: forall a. Int -> DocBox a +vpadding height + | height <= 0 = DocEmpty + | otherwise = DocPad { height, width: 0 } + +-- | Horizontal padding of a specific width. +hpadding :: forall a. Int -> DocBox a +hpadding width + | width <= 0 = DocEmpty + | otherwise = DocPad { height: 1, width } + +-- | Returns the size of a DocBox. +sizeOf :: forall a. DocBox a -> BoxSize +sizeOf = case _ of + DocLine _ width -> { width, height: 1 } + DocVApp _ _ size -> size + DocHApp _ _ size -> size + DocAlign _ _ doc -> sizeOf doc + DocPad size -> size + DocEmpty -> { width: 0, height: 0 } + +valignOf :: forall a. DocBox a -> Align +valignOf = case _ of + DocAlign v _ _ -> v + _ -> Start + +halignOf :: forall a. DocBox a -> Align +halignOf = case _ of + DocAlign _ h _ -> h + _ -> Start + +-- | The identity DocBox. +empty :: forall a. DocBox a +empty = DocEmpty + +-- | Checks whether a DocBox is empty. +isEmpty :: forall a. DocBox a -> Boolean +isEmpty = case _ of + DocEmpty -> true + _ -> false + +-- | Converts a DocBox back into Doc for printing. +toDoc :: forall a. DocBox a -> Doc a +toDoc = go1 <<< resume <<< build AsIs StpDone + where + go1 = case _ of + Nothing -> mempty + Just { line, next } -> + go2 (formatLine line) (resume next) + + go2 acc = case _ of + Nothing -> acc + Just { line, next } -> + go2 (acc <> Dodo.break <> formatLine line) (resume next) + +formatLine :: forall a. DocLine a -> Doc a +formatLine = go mempty <<< List.singleton + where + go acc = case _ of + List.Nil -> + acc + line : lines -> + case line of + LinePad w + | Dodo.isEmpty acc -> + go acc lines + | otherwise -> + go (power Dodo.space w <> acc) lines + LineDoc doc -> + go (doc <> acc) lines + LineAppend a b -> + go acc (b : a : lines) + +data DocBoxStep a + = StpDone + | StpLine (Doc a) (DocBoxStep a) + | StpPad Int Int (DocBoxStep a) + | StpHorz (DocBoxStep a) (DocBoxStep a) (DocBoxStep a) + +data DocBuildSize + = FullHeight Int + | FullWidth Int + | AsIs + +data DocBuildCmd a + = BuildEnter DocBuildSize (DocBoxStep a) (DocBox a) + | BuildLeave (DocBoxStep a) + +data DocBuildStk a + = BuildVAppR Int (DocBox a) (DocBuildStk a) + | BuildHAppR Int (DocBox a) (DocBoxStep a) (DocBuildStk a) + | BuildHAppH (DocBoxStep a) (DocBoxStep a) (DocBuildStk a) + | BuildNil + +build :: forall a. DocBuildSize -> DocBoxStep a -> DocBox a -> DocBoxStep a +build = (\size next box -> go (BuildEnter size next box) BuildNil) + where + go cmd stack = case cmd of + BuildEnter size next box -> + case size of + FullHeight height -> + case box of + DocHApp a b _ -> + go (BuildEnter size StpDone b) (BuildHAppR height a next stack) + _ -> + go (BuildEnter AsIs next (resize { width: 0, height } box)) stack + FullWidth width -> + case box of + DocVApp a b _ -> + go (BuildEnter size next b) (BuildVAppR width a stack) + _ -> + go (BuildEnter AsIs next (resize { width, height: 0 } box)) stack + AsIs -> + case box of + DocVApp a b { width } -> + go (BuildEnter (FullWidth width) next b) (BuildVAppR width a stack) + DocHApp a b { height } -> + go (BuildEnter (FullHeight height) StpDone b) (BuildHAppR height a next stack) + DocAlign _ _ a -> + go (BuildEnter size next a) stack + DocLine line _ -> + go (BuildLeave (StpLine line next)) stack + DocPad padSize -> + go (BuildLeave (StpPad padSize.width padSize.height next)) stack + DocEmpty -> + go (BuildLeave StpDone) stack + BuildLeave step -> + case stack of + BuildVAppR width boxa stk -> + go (BuildEnter (FullWidth width) step boxa) stk + BuildHAppR height boxa next stk -> + go (BuildEnter (FullHeight height) StpDone boxa) (BuildHAppH step next stk) + BuildHAppH stepb next stk -> + go (BuildLeave (StpHorz step stepb next)) stk + BuildNil -> + step + +data DocLine a + = LinePad Int + | LineDoc (Doc a) + | LineAppend (DocLine a) (DocLine a) + +type DocProducer a = + { line :: DocLine a + , next :: DocBoxStep a + } + +data DocResumeCmd a + = ResumeEnter (DocBoxStep a) + | ResumeLeave (Maybe (DocProducer a)) + +data DocResumeStk a + = ResumeHorzR (DocBoxStep a) (DocBoxStep a) (DocResumeStk a) + | ResumeHorzH (Maybe (DocProducer a)) (DocBoxStep a) (DocResumeStk a) + | ResumeNil + +resume :: forall a. DocBoxStep a -> Maybe (DocProducer a) +resume = flip go ResumeNil <<< ResumeEnter + where + go cmd stack = case cmd of + ResumeEnter step -> + case step of + StpDone -> + go (ResumeLeave Nothing) stack + StpLine doc next -> do + go (ResumeLeave $ Just { line: LineDoc doc, next }) stack + StpPad width height next -> + if height == 0 then + go (ResumeEnter next) stack + else + go + ( ResumeLeave $ Just + { line: LinePad width + , next: StpPad width (height - 1) next + } + ) + stack + StpHorz a b next -> + go (ResumeEnter b) (ResumeHorzR a next stack) + ResumeLeave prod -> + case stack of + ResumeHorzR stepa next stk -> + go (ResumeEnter stepa) (ResumeHorzH prod next stk) + ResumeHorzH prodb next stk -> + case prod, prodb of + Just a, Just b -> + go + ( ResumeLeave $ Just + { line: LineAppend a.line b.line + , next: StpHorz a.next b.next next + } + ) + stk + _, _ -> + go (ResumeEnter next) stk + ResumeNil -> + prod + +type DocAnnStk a = List (Either a (Doc a)) + +newtype DocBoxBuffer a = DocBoxBuffer + { currentIndent :: Doc a + , currentLine :: DocAnnStk a + , currentWidth :: Int + , lines :: DocBox a + } + +-- | A printer which can lift a Doc into DocBox. It is assumed that +-- | the Doc's annotations respect a distributive law: +-- | ``` purescript +-- | annotate ann (a <> b) = annotate ann a <> annotate ann b +-- | ```` +docBox :: forall a. Printer (DocBoxBuffer a) a (DocBox a) +docBox = Printer + { emptyBuffer + , writeText + , writeIndent + , writeBreak + , enterAnnotation + , leaveAnnotation + , flushBuffer + } + where + emptyBuffer :: DocBoxBuffer a + emptyBuffer = DocBoxBuffer + { currentIndent: mempty + , currentLine: List.Nil + , currentWidth: 0 + , lines: DocEmpty + } + + writeText :: Int -> String -> DocBoxBuffer a -> DocBoxBuffer a + writeText width text (DocBoxBuffer buff) = do + let + doc' = Internal.Text width text + line = case buff.currentLine of + Right doc : rest -> + Right (doc <> doc') : rest + rest -> + Right doc' : rest + DocBoxBuffer buff + { currentLine = line + , currentWidth = buff.currentWidth + width + } + + writeIndent :: Int -> String -> DocBoxBuffer a -> DocBoxBuffer a + writeIndent width text (DocBoxBuffer buff) = do + let doc = Internal.Text width text + DocBoxBuffer buff + { currentIndent = buff.currentIndent <> doc + , currentWidth = buff.currentWidth + width + } + + writeBreak :: DocBoxBuffer a -> DocBoxBuffer a + writeBreak (DocBoxBuffer buff) = do + let line = stkToDoc buff.currentLine + DocBoxBuffer buff + { currentIndent = mempty + , currentLine = List.filter isLeft buff.currentLine + , currentWidth = 0 + , lines = buff.lines `vappend` DocLine (buff.currentIndent <> line) buff.currentWidth + } + + enterAnnotation :: a -> List a -> DocBoxBuffer a -> DocBoxBuffer a + enterAnnotation ann _ (DocBoxBuffer buff) = + DocBoxBuffer buff + { currentLine = Left ann : buff.currentLine + } + + leaveAnnotation :: a -> List a -> DocBoxBuffer a -> DocBoxBuffer a + leaveAnnotation _ _ (DocBoxBuffer buff) = do + let + line = case buff.currentLine of + Right doc : Left ann : rest -> + Right (annotate ann doc) : rest + Left _ : rest -> + rest + _ -> + unsafeCrashWith "leaveAnnotation: docs and annotations must be interleaved" + DocBoxBuffer buff + { currentLine = line + } + + flushBuffer :: DocBoxBuffer a -> DocBox a + flushBuffer (DocBoxBuffer buff) + | isEmpty buff.lines && List.null buff.currentLine = + DocEmpty + | otherwise = do + let line = stkToDoc buff.currentLine + buff.lines `vappend` DocLine (buff.currentIndent <> line) buff.currentWidth + + stkToDoc :: DocAnnStk a -> Doc a + stkToDoc = foldl + ( \doc -> case _ of + Left ann -> + annotate ann doc + Right doc' -> + doc' <> doc + ) + mempty diff --git a/src/Dodo/Internal.purs b/src/Dodo/Internal.purs index b18a00c..b3a2c05 100644 --- a/src/Dodo/Internal.purs +++ b/src/Dodo/Internal.purs @@ -2,6 +2,8 @@ module Dodo.Internal where import Prelude +import Data.Tuple (Tuple) + -- | Document lines and columns are 0-based offsets. type Position = { line :: Int @@ -23,7 +25,7 @@ data Doc a | FlexSelect (Doc a) (Doc a) (Doc a) | FlexAlt (Doc a) (Doc a) | WithPosition (Position -> Doc a) - | Local (LocalOptions -> LocalOptions) (Doc a) + | Local (LocalOptions -> Tuple LocalOptions (Doc a)) | Text Int String | Break | Empty diff --git a/test/snapshots/DodoBox.output b/test/snapshots/DodoBox.output new file mode 100644 index 0000000..a980c42 --- /dev/null +++ b/test/snapshots/DodoBox.output @@ -0,0 +1,58 @@ +Example JSON +------------------------------------------------------------------------------------------------------------------------ +************************************************************************************************************************ + { + "bool": true, + "string": "bar", + "number": 1234.0, NOTE + "array": [null, "two", ["three"]], Vestibulum ante ipsum primis in faucibus + "object": {}, orci luctus et ultrices posuere cubilia + "wideObject": { curae; Suspendisse eget tortor. + "key": "1111111111111111111111111111111111111111" + } + } +Example JSON +------------------------------------------------------------------------------------------------------------------------ +************************************************************************************************************************ + { + "bool": true, + "string": "bar", + "number": 1234.0, NOTE + "array": [null, "two", ["three"]], Vestibulum ante ipsum primis in faucibus + "object": {}, orci luctus et ultrices posuere cubilia + "wideObject": { curae; Suspendisse eget tortor. + "key": "1111111111111111111111111111111111111111" + } + } ++---------------------------------------------------------------------+----------------------------------------------------------+ +| Example | Comment | ++---------------------------------------------------------------------+----------------------------------------------------------+ +| { | | +| "bool": true, | | +| "string": "bar", | | +| "number": 1234.0, | Vestibulum ante ipsum primis in faucibus | +| "array": [null, "two", ["three"]], | orci luctus et ultrices posuere cubilia | +| "object": {}, | curae; Suspendisse eget tortor. | +| "wideObject": { | | +| "key": "1111111111111111111111111111111111111111" | | +| } | | +| } | | ++---------------------------------------------------------------------+----------------------------------------------------------+ +| { | | +| "bool": true, | | +| "string": "bar", | | +| "number": 1234.0, | Vestibulum ante ipsum primis in faucibus orci luctus et | +| "array": [null, "two", ["three"]], | ultrices posuere cubilia curae; Suspendisse eget tortor. | +| "object": {}, | | +| "wideObject": {"key": "1111111111111111111111111111111111111111"} | | +| } | | ++---------------------------------------------------------------------+----------------------------------------------------------+ +| { | Vestibulum ante ipsum primis in faucibus orci luctus et | +| "bool": true, | ultrices posuere cubilia curae; Suspendisse eget tortor. | +| "string": "bar", | | +| "number": 1234.0, | | +| "array": [null, "two", ["three"]], | | +| "object": {}, | | +| "wideObject": {"key": "1111111111111111111111111111111111111111"} | | +| } | | ++---------------------------------------------------------------------+----------------------------------------------------------+ diff --git a/test/snapshots/DodoBox.purs b/test/snapshots/DodoBox.purs new file mode 100644 index 0000000..c11097d --- /dev/null +++ b/test/snapshots/DodoBox.purs @@ -0,0 +1,149 @@ +module DodoBox where + +import Prelude + +import Ansi.Codes (GraphicsParam) +import Data.Array (intersperse) +import Data.Array as Array +import Data.Maybe (fromMaybe) +import Dodo (Doc, plainText, print, textParagraph, twoSpaces) +import Dodo as Dodo +import Dodo.Ansi (ansiGraphics) +import Dodo.Ansi as Ansi +import Dodo.Box (Align(..), DocBox, docBox, fill, halign, horizontal, hpadding, resize, sizeOf, valign, vertical) +import Dodo.Box as Box +import DodoExampleJson (exampleJson, printJson) +import Effect (Effect) +import Effect.Class.Console as Console + +para2 :: forall a. Doc a +para2 = textParagraph + """ + Vestibulum ante ipsum primis in faucibus orci luctus et ultrices posuere + cubilia curae; Suspendisse eget tortor. + """ + +textBox :: forall a. Int -> Doc a -> DocBox a +textBox pageWidth = print docBox (twoSpaces { pageWidth = pageWidth }) + +heading :: DocBox GraphicsParam -> DocBox GraphicsParam -> DocBox GraphicsParam +heading head body = + vertical + [ head + , fill (Ansi.dim (Dodo.text "-")) + { width: max (sizeOf head).width (sizeOf body).width + , height: 1 + } + , body + ] + +test :: Doc GraphicsParam +test = Box.toDoc do + heading + (textBox 40 (Ansi.bold (Dodo.text "Example JSON"))) + ( vertical + [ fill (Ansi.dim (Dodo.text "*")) { width: 120, height: 1 } + , halign Middle $ horizontal $ intersperse (hpadding 4) + [ textBox 40 (printJson exampleJson) + , valign Middle $ vertical + [ halign Middle $ textBox 40 (Ansi.bold (Dodo.text "NOTE")) + , textBox 40 (Ansi.italic para2) + ] + ] + ] + ) + +table + :: forall a + . { headers :: Array (DocBox a) + , rows :: Array (Array (DocBox a)) + } + -> DocBox a +table { headers, rows } = + vertical + [ rowSep + , vertical $ Array.intersperse rowSep $ map columns $ Array.cons headers rows + , rowSep + ] + where + joint = + fill (Dodo.text "+") { width: 1, height: 1 } + + rowSep = + horizontal + [ joint + , horizontal $ Array.intersperse joint $ map + ( \width -> + fill (Dodo.text "-") + { width: width + 2 + , height: 1 + } + ) + widths + , joint + ] + + columns cols = do + let + height = + Array.foldr (max <<< _.height <<< Box.sizeOf) 0 cols + + colBoxes = Array.mapWithIndex + ( \ix col -> + horizontal + [ hpadding 1 + , resize + { width: fromMaybe 0 (Array.index widths ix) + , height + } + col + , hpadding 1 + ] + ) + cols + + sep = fill (Dodo.text "|") { width: 1, height } + + horizontal + [ sep + , horizontal $ Array.intersperse sep colBoxes + , sep + ] + + widths = Array.mapWithIndex + ( \ix hd -> + Array.foldr + ( flip Array.index ix + >>> map (_.width <<< Box.sizeOf) + >>> fromMaybe 0 + >>> max + ) + (Box.sizeOf hd).width + rows + ) + headers + +testTable :: Doc GraphicsParam +testTable = Box.toDoc $ table + { headers: + [ valign Middle $ halign Middle $ textBox 20 $ Dodo.text "Example" + , valign Middle $ halign Middle $ textBox 20 $ Dodo.text "Comment" + ] + , rows: + [ [ textBox 40 (printJson exampleJson) + , valign Middle $ halign Middle $ textBox 40 (Ansi.italic para2) + ] + , [ textBox 120 (printJson exampleJson) + , valign Middle $ textBox 60 (Ansi.italic para2) + ] + , [ textBox 120 (printJson exampleJson) + , textBox 60 (Ansi.italic para2) + ] + ] + } + +main :: Effect Unit +main = do + Console.log $ print plainText (twoSpaces { pageWidth = top }) test + Console.log $ print ansiGraphics (twoSpaces { pageWidth = top }) test + Console.log $ print plainText (twoSpaces { pageWidth = top }) testTable