fix wrapping bug

jaspervdj · Feb 11, 2024 · 2ee5557 · 2ee5557
1 parent 6f1f78f
commit 2ee5557
Show file tree

Hide file tree

Showing 4 changed files with 48 additions and 19 deletions.
diff --git a/README.md b/README.md
@@ -343,7 +343,6 @@ use both `left: auto` and `right: auto`.  For example:
 title: Centered presentation
 author: John Doe
 patat:
-    wrap: true
     margins:
         left: auto
         right: auto

diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs
@@ -179,33 +179,41 @@ prettyFragment ds (Fragment blocks) = vertical $
         []   -> mempty
         refs -> PP.hardline <> PP.vcat (map horizontal refs)
   where
+    Size rows columns = dsSize ds
+    Margins {..} = dsMargins ds
+
     vertical doc0 =
         mconcat (replicate top PP.hardline) <> doc0
       where
-        (Size rows _) = dsSize ds
-        top = case mTop (dsMargins ds) of
+        top = case mTop of
             Auto -> let (r, _) = PP.dimensions doc0 in (rows - r) `div` 2
             NotAuto x -> x
 
-    horizontal doc0 = wrap $ indent doc1
+    horizontal = horizontalIndent . horizontalWrap
+
+    horizontalIndent doc0 = PP.indent indentation indentation doc1
       where
-        (Size _ columns) = dsSize ds
-        Margins {..} = dsMargins ds
         doc1 = case (mLeft, mRight) of
             (Auto, Auto) -> PP.deindent doc0
             _            -> doc0
         (_, dcols) = PP.dimensions doc1
-        wrap = if dsWrap ds then PP.wrapAt (Just $ columns - right) else id
-        right = case mRight of
-            Auto      -> 0
-            NotAuto x -> x
         left = case mLeft of
             NotAuto x -> x
             Auto      -> case mRight of
                 NotAuto _ -> 0
                 Auto      -> (columns - dcols) `div` 2
         indentation = PP.Indentation left mempty
-        indent = PP.indent indentation indentation
+
+    horizontalWrap doc0
+        | dsWrap ds = PP.wrapAt (Just $ columns - right - left) doc0
+        | otherwise = doc0
+      where
+        right = case mRight of
+            Auto      -> 0
+            NotAuto x -> x
+        left = case mLeft of
+            Auto      -> 0
+            NotAuto x -> x
 
 
 --------------------------------------------------------------------------------

diff --git a/lib/Patat/PrettyPrint/Internal.hs b/lib/Patat/PrettyPrint/Internal.hs
@@ -171,6 +171,12 @@ data Indentation a = Indentation Int a
     deriving (Foldable, Functor, Traversable)
 
 
+--------------------------------------------------------------------------------
+indentationToChunks :: Indentation [Chunk] -> [Chunk]
+indentationToChunks (Indentation 0 c) = c
+indentationToChunks (Indentation n c) = StringChunk [] (replicate n ' ') : c
+
+
 --------------------------------------------------------------------------------
 bufferToChunks :: LineBuffer -> Chunks
 bufferToChunks (LineBuffer ind chunks) = case chunks of
@@ -181,9 +187,6 @@ bufferToChunks (LineBuffer ind chunks) = case chunks of
     emptyIndentation (Indentation _ []) = True
     emptyIndentation _                  = False
 
-    indentationToChunks (Indentation 0 c) = c
-    indentationToChunks (Indentation n c) = StringChunk [] (replicate n ' ') : c
-
 
 --------------------------------------------------------------------------------
 docToChunks :: Doc -> Chunks
@@ -222,7 +225,8 @@ docToChunks doc0 =
         go docs
 
     go (WrapAt {..} : docs) = do
-        local (\env -> env {deWrap = wrapAtCol}) $ go (unDoc wrapDoc)
+        il <- asks $ wcchunkswidth . concatMap indentationToChunks . deIndent
+        local (\env -> env {deWrap = fmap (+ il) wrapAtCol}) $ go (unDoc wrapDoc)
         go docs
 
     go (Ansi {..} : docs) = do
@@ -231,7 +235,7 @@ docToChunks doc0 =
         go docs
 
     go (Indent {..} : docs) = do
-        local (\env -> env {deIndent = indentOtherLines : deIndent env}) $ do
+        local (\e -> e {deIndent = indentOtherLines : deIndent e}) $ do
             modify $ \(LineBuffer i c) -> LineBuffer (indentFirstLine : i) c
             go (unDoc indentDoc)
         go docs
@@ -257,8 +261,8 @@ docToChunks doc0 =
             Nothing     -> return hard
             Just maxCol -> do
                 -- Slow.
-                currentLine <- gets (concatMap chunkToString . bufferToChunks)
-                let currentCol = wcstrwidth currentLine
+                currentLine <- gets bufferToChunks
+                let currentCol = wcchunkswidth currentLine
                 case nextWordLength docs of
                     Nothing                            -> return hard
                     Just l
@@ -284,6 +288,8 @@ docToChunks doc0 =
     nextWordLength (Indent {..} : xs) = nextWordLength (unDoc indentDoc ++ xs)
     nextWordLength (Control _ : _)    = Nothing
 
+    wcchunkswidth = wcstrwidth . concatMap chunkToString
+
 
 --------------------------------------------------------------------------------
 toString :: Doc -> String

diff --git a/tests/golden/outputs/margins-auto-wrap.md.dump b/tests/golden/outputs/margins-auto-wrap.md.dump
@@ -12,4 +12,20 @@
 [mHello world Hello world Hello world Hello world Hello world Hello world[0m
 [mHello world Hello world Hello world Hello world Hello world Hello world[0m
 
-[33m John Doe                                                         1 / 1 [0m
+[33m John Doe                                                         1 / 2 [0m
+
+[m{slide}[0m
+[33m                         Centered presentation                          [0m
+
+
+
+
+
+
+
+
+
+
+[m                       Hello world This is a test[0m
+
+[33m John Doe                                                         2 / 2 [0m