Refactor Trimmable into Indentation

lib/Patat/Presentation/Display.hs

@@ -114,7 +114,7 @@ displayPresentation size pres@Presentation {..} =
                 Margins {..}   = margins (activeSettings pres)
                 offsetRow      = (sRows canvasSize `div` 2) - (prows `div` 2)
                 offsetCol      = ((sCols canvasSize - mLeft - mRight) `div` 2) - (pcols `div` 2)
-                spaces         = PP.NotTrimmable $ PP.spaces offsetCol in
+                spaces         = PP.Indentation offsetCol mempty in
             mconcat (replicate (offsetRow - 3) PP.hardline) <$$>
             PP.indent spaces spaces pblock
 
@@ -185,7 +185,7 @@ formatWith ps = wrap . indent
     wrap = case (psWrap ps, psColumns ps) of
         (Just True,  Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - mRight)
         _                                      -> id
-    spaces = PP.NotTrimmable $ PP.spaces mLeft
+    spaces = PP.Indentation mLeft mempty
     indent = PP.indent spaces spaces
 
 
@@ -215,13 +215,13 @@ prettyBlock ds (Pandoc.CodeBlock (_, classes, _) txt) =
 
 prettyBlock ds (Pandoc.BulletList bss) = PP.vcat
     [ PP.indent
-        (PP.NotTrimmable $ themed ds themeBulletList prefix)
-        (PP.Trimmable "    ")
+        (PP.Indentation 2 $ themed ds themeBulletList prefix)
+        (PP.Indentation 4 mempty)
         (prettyBlocks ds' bs)
     | bs <- bss
     ] <> PP.hardline
   where
-    prefix = "  " <> PP.string [marker] <> " "
+    prefix = PP.string [marker] <> " "
     marker = case T.unpack <$> themeBulletListMarkers theme of
         Just (x : _) -> x
         _            -> '-'
@@ -236,8 +236,8 @@ prettyBlock ds (Pandoc.BulletList bss) = PP.vcat
 
 prettyBlock ds (Pandoc.OrderedList _ bss) = PP.vcat
     [ PP.indent
-        (PP.NotTrimmable $ themed ds themeOrderedList $ PP.string prefix)
-        (PP.Trimmable "    ")
+        (PP.Indentation 0 $ themed ds themeOrderedList $ PP.string prefix)
+        (PP.Indentation 4 mempty)
         (prettyBlocks ds bs)
     | (prefix, bs) <- zip padded bss
     ] <> PP.hardline
@@ -253,7 +253,7 @@ prettyBlock _ds (Pandoc.RawBlock _ t) = PP.text t <> PP.hardline
 prettyBlock _ds Pandoc.HorizontalRule = "---"
 
 prettyBlock ds (Pandoc.BlockQuote bs) =
-    let quote = PP.NotTrimmable (themed ds themeBlockQuote "> ") in
+    let quote = PP.Indentation 0 (themed ds themeBlockQuote "> ") in
     PP.indent quote quote (themed ds themeBlockQuote $ prettyBlocks ds bs)
 
 prettyBlock ds (Pandoc.DefinitionList terms) =
@@ -263,8 +263,8 @@ prettyBlock ds (Pandoc.DefinitionList terms) =
         themed ds themeDefinitionTerm (prettyInlines ds term) <$$>
         PP.hardline <> PP.vcat
         [ PP.indent
-            (PP.NotTrimmable (themed ds themeDefinitionList ":   "))
-            (PP.Trimmable "    ") $
+            (PP.Indentation 0 (themed ds themeDefinitionList ":   "))
+            (PP.Indentation 4 mempty) $
             prettyBlocks ds (Pandoc.plainToPara definition)
         | definition <- definitions
         ]
@@ -289,7 +289,7 @@ prettyBlock ds (Pandoc.Table _ caption specs thead tbodies tfoot) =
 prettyBlock ds (Pandoc.Div _attrs blocks) = prettyBlocks ds blocks
 
 prettyBlock ds (Pandoc.LineBlock inliness) =
-    let ind = PP.NotTrimmable (themed ds themeLineBlock "| ") in
+    let ind = PP.Indentation 0 (themed ds themeLineBlock "| ") in
     PP.wrapAt Nothing $
     PP.indent ind ind $
     PP.vcat $

lib/Patat/Presentation/Display/CodeBlock.hs

@@ -76,7 +76,7 @@ prettyCodeBlock ds classes rawCodeBlock =
     blockified :: Skylighting.SourceLine -> PP.Doc
     blockified line =
         let len    = sourceLineLength line
-            indent = PP.NotTrimmable "   " in
+            indent = PP.Indentation 3 mempty in
         PP.indent indent indent $
         themed ds themeCodeBlock $
             " " <>

lib/Patat/Presentation/Display/Table.hs

@@ -30,7 +30,7 @@ data Table = Table
 --------------------------------------------------------------------------------
 prettyTable :: DisplaySettings -> Table -> PP.Doc
 prettyTable ds Table {..} =
-    PP.indent (PP.Trimmable "  ") (PP.Trimmable "  ") $
+    PP.indent indentation indentation $
         lineIf (not isHeaderLess) (hcat2 headerHeight
             [ themed ds themeTableHeader $
                 PP.align w a (vpad headerHeight header)
@@ -48,6 +48,8 @@ prettyTable ds Table {..} =
         lineIf
             (not $ PP.null tCaption) (PP.hardline <> "Table: " <> tCaption)
   where
+    indentation = PP.Indentation 2 mempty
+
     lineIf cond line = if cond then line <> PP.hardline else mempty
 
     joinRows

lib/Patat/PrettyPrint.hs

@@ -24,7 +24,7 @@ module Patat.PrettyPrint
 
     , wrapAt
 
-    , Trimmable (..)
+    , Indentation (..)
     , indent
 
     , ansi
@@ -91,10 +91,10 @@ wrapAt wrapAtCol wrapDoc = mkDoc WrapAt {..}
 
 
 --------------------------------------------------------------------------------
-indent :: Trimmable Doc -> Trimmable Doc -> Doc -> Doc
+indent :: Indentation Doc -> Indentation Doc -> Doc -> Doc
 indent firstLineDoc otherLinesDoc doc = mkDoc $ Indent
-    { indentFirstLine  = traverse docToChunks firstLineDoc
-    , indentOtherLines = traverse docToChunks otherLinesDoc
+    { indentFirstLine  = fmap docToChunks firstLineDoc
+    , indentOtherLines = fmap docToChunks otherLinesDoc
     , indentDoc        = doc
     }
 

lib/Patat/PrettyPrint/Internal.hs

@@ -15,11 +15,11 @@ module Patat.PrettyPrint.Internal
     , DocE (..)
     , chunkToDocE
 
+    , Indentation (..)
+
     , Doc (..)
     , docToChunks
 
-    , Trimmable (..)
-
     , toString
     , dimensions
     , null
@@ -119,8 +119,8 @@ data DocE d
         , ansiDoc  :: d
         }
     | Indent
-        { indentFirstLine  :: LineBuffer
-        , indentOtherLines :: LineBuffer
+        { indentFirstLine  :: Indentation [Chunk]
+        , indentOtherLines :: Indentation [Chunk]
         , indentDoc        :: d
         }
     | Control Control
@@ -151,9 +151,9 @@ instance IsString Doc where
 
 --------------------------------------------------------------------------------
 data DocEnv = DocEnv
-    { deCodes  :: [Ansi.SGR]  -- ^ Most recent ones first in the list
-    , deIndent :: LineBuffer  -- ^ Don't need to store first-line indent
-    , deWrap   :: Maybe Int   -- ^ Wrap at columns
+    { deCodes  :: [Ansi.SGR]             -- ^ Most recent ones first in the list
+    , deIndent :: [Indentation [Chunk]]  -- ^ No need to store first-line indent
+    , deWrap   :: Maybe Int              -- ^ Wrap at columns
     }
 
 
@@ -162,33 +162,34 @@ type DocM = RWS DocEnv Chunks LineBuffer
 
 
 --------------------------------------------------------------------------------
-data Trimmable a
-    = NotTrimmable !a
-    | Trimmable    !a
-    deriving (Foldable, Functor, Traversable)
+-- | Note that these are reversed so we have fast append
+data LineBuffer = LineBuffer [Indentation [Chunk]] [Chunk]
 
 
 --------------------------------------------------------------------------------
--- | Note that this is reversed so we have fast append
-type LineBuffer = [Trimmable Chunk]
+data Indentation a = Indentation Int a
+    deriving (Foldable, Functor, Traversable)
 
 
 --------------------------------------------------------------------------------
 bufferToChunks :: LineBuffer -> Chunks
-bufferToChunks = map trimmableToChunk . reverse . dropWhile isTrimmable
+bufferToChunks (LineBuffer ind chunks) = case chunks of
+    [] -> concatMap indentationToChunks $ reverse $
+        dropWhile emptyIndentation ind
+    _ -> concatMap indentationToChunks (reverse ind) ++ reverse chunks
   where
-    isTrimmable (NotTrimmable _) = False
-    isTrimmable (Trimmable    _) = True
+    emptyIndentation (Indentation _ []) = True
+    emptyIndentation _                  = False
 
-    trimmableToChunk (NotTrimmable c) = c
-    trimmableToChunk (Trimmable    c) = c
+    indentationToChunks (Indentation 0 c) = c
+    indentationToChunks (Indentation n c) = StringChunk [] (replicate n ' ') : c
 
 
 --------------------------------------------------------------------------------
 docToChunks :: Doc -> Chunks
 docToChunks doc0 =
     let env0        = DocEnv [] [] Nothing
-        ((), b, cs) = runRWS (go $ unDoc doc0) env0 mempty in
+        ((), b, cs) = runRWS (go $ unDoc doc0) env0 (LineBuffer [] []) in
     optimizeChunks (cs <> bufferToChunks b)
   where
     go :: [DocE Doc] -> DocM ()
@@ -197,7 +198,7 @@ docToChunks doc0 =
 
     go (String str : docs) = do
         chunk <- makeChunk str
-        modify (NotTrimmable chunk :)
+        appendChunk chunk
         go docs
 
     go (Softspace : docs) = do
@@ -206,7 +207,7 @@ docToChunks doc0 =
 
     go (Hardspace : docs) = do
         chunk <- makeChunk " "
-        modify (NotTrimmable chunk :)
+        appendChunk chunk
         go docs
 
     go (Softline : docs) = do
@@ -217,7 +218,7 @@ docToChunks doc0 =
         buffer <- get
         tell $ bufferToChunks buffer <> [NewlineChunk]
         indentation <- asks deIndent
-        modify $ \_ -> if L.null docs then [] else indentation
+        modify $ \_ -> LineBuffer (if L.null docs then [] else indentation) []
         go docs
 
     go (WrapAt {..} : docs) = do
@@ -230,8 +231,8 @@ docToChunks doc0 =
         go docs
 
     go (Indent {..} : docs) = do
-        local (\env -> env {deIndent = indentOtherLines ++ deIndent env}) $ do
-            modify (indentFirstLine ++)
+        local (\env -> env {deIndent = indentOtherLines : deIndent env}) $ do
+            modify $ \(LineBuffer i c) -> LineBuffer (indentFirstLine : i) c
             go (unDoc indentDoc)
         go docs
 
@@ -245,6 +246,9 @@ docToChunks doc0 =
         codes <- asks deCodes
         return $ StringChunk codes str
 
+    appendChunk :: Chunk -> DocM ()
+    appendChunk c = modify $ \(LineBuffer i cs) -> LineBuffer i (c : cs)
+
     -- Convert 'Softspace' or 'Softline' to 'Hardspace' or 'Hardline'
     softConversion :: DocE Doc -> [DocE Doc] -> DocM (DocE Doc)
     softConversion soft docs = do
@@ -316,4 +320,5 @@ mkDoc e = Doc [e]
 
 --------------------------------------------------------------------------------
 string :: String -> Doc
-string = mkDoc . String  -- TODO (jaspervdj): Newline conversion?
+string ""  = Doc []
+string str = mkDoc $ String str  -- TODO (jaspervdj): Newline conversion?