From a451255b0224d3a295796498746bf460ee1cbcdb Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 7 Feb 2024 20:37:48 +0100 Subject: [PATCH 01/20] refactor --- lib/Patat/Presentation/Display.hs | 32 +++++++++++++++++++++------- lib/Patat/Presentation/Internal.hs | 12 ++++++----- lib/Patat/Presentation/Settings.hs | 17 ++++++++++++--- stack.yaml | 2 +- tests/golden/outputs/margins.md.dump | 25 ++++++++++------------ 5 files changed, 57 insertions(+), 31 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index 69c8df6..298708f 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -23,6 +23,7 @@ import Patat.Presentation.Display.CodeBlock import Patat.Presentation.Display.Internal import Patat.Presentation.Display.Table import Patat.Presentation.Internal +import Patat.Presentation.Settings import Patat.PrettyPrint ((<$$>), (<+>)) import qualified Patat.PrettyPrint as PP import Patat.Size @@ -49,7 +50,6 @@ displayWithBorders (Size rows columns) pres@Presentation {..} f = let titleRemainder = columns - titleWidth - titleOffset wrappedTitle = PP.spaces titleOffset <> PP.string title <> PP.spaces titleRemainder in borders wrappedTitle <> PP.hardline) <> - mconcat (replicate topMargin PP.hardline) <> formatWith settings (f canvasSize ds) <> PP.hardline <> PP.goToLine (rows - 2) <> borders (PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space) <> @@ -82,7 +82,9 @@ displayWithBorders (Size rows columns) pres@Presentation {..} f = borders = themed ds themeBorders -- Room left for content - topMargin = mTop $ margins settings + topMargin = case mTop $ margins settings of + Auto -> error "auto" + NotAuto x -> x canvasSize = Size (rows - 2 - topMargin) columns -- Compute footer. @@ -113,7 +115,13 @@ displayPresentation size pres@Presentation {..} = (prows, pcols) = PP.dimensions pblock Margins {..} = margins (activeSettings pres) offsetRow = (sRows canvasSize `div` 2) - (prows `div` 2) - offsetCol = ((sCols canvasSize - mLeft - mRight) `div` 2) - (pcols `div` 2) + left = case mLeft of + Auto -> error "auto" + NotAuto x -> x + right = case mRight of + Auto -> error "auto" + NotAuto x -> x + offsetCol = ((sCols canvasSize - left - right) `div` 2) - (pcols `div` 2) spaces = PP.NotTrimmable $ PP.spaces offsetCol in mconcat (replicate (offsetRow - 3) PP.hardline) <$$> PP.indent spaces spaces pblock @@ -149,8 +157,7 @@ dumpPresentation pres@Presentation {..} = dumpSlide :: Int -> [PP.Doc] dumpSlide i = do slide <- maybeToList $ getSlide i pres - map (formatWith (getSettings i pres)) $ - dumpComment slide <> L.intercalate ["{fragment}"] + dumpComment slide <> L.intercalate ["{fragment}"] [ dumpFragment (i, j) | j <- [0 .. numFragments slide - 1] ] @@ -179,13 +186,22 @@ dumpPresentation pres@Presentation {..} = -------------------------------------------------------------------------------- formatWith :: PresentationSettings -> PP.Doc -> PP.Doc -formatWith ps = wrap . indent +formatWith ps doc = wrap . indent $ + mconcat (replicate topMargin PP.hardline) <> doc where Margins {..} = margins ps + right = case mRight of + Auto -> error "auto" + NotAuto x -> x + topMargin = case mTop of + Auto -> error "auto" + NotAuto x -> x wrap = case (psWrap ps, psColumns ps) of - (Just True, Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - mRight) + (Just True, Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - right) _ -> id - spaces = PP.NotTrimmable $ PP.spaces mLeft + spaces = PP.NotTrimmable $ PP.spaces $ case mLeft of + Auto -> error "auto" + NotAuto x -> x indent = PP.indent spaces spaces diff --git a/lib/Patat/Presentation/Internal.hs b/lib/Patat/Presentation/Internal.hs index e37d0bf..90f02ae 100644 --- a/lib/Patat/Presentation/Internal.hs +++ b/lib/Patat/Presentation/Internal.hs @@ -78,9 +78,9 @@ data Presentation = Presentation -------------------------------------------------------------------------------- data Margins = Margins - { mTop :: Int - , mLeft :: Int - , mRight :: Int + { mTop :: AutoOr Int + , mLeft :: AutoOr Int + , mRight :: AutoOr Int } deriving (Show) @@ -92,8 +92,10 @@ margins ps = Margins , mTop = get 1 msTop } where - get def f = fromMaybe def . fmap A.unFlexibleNum $ psMargins ps >>= f - + get def f = case psMargins ps >>= f of + Just Auto -> Auto + Nothing -> NotAuto def + Just (NotAuto fn) -> NotAuto $ A.unFlexibleNum fn -------------------------------------------------------------------------------- data Slide = Slide diff --git a/lib/Patat/Presentation/Settings.hs b/lib/Patat/Presentation/Settings.hs index ac86cb5..e3c4649 100644 --- a/lib/Patat/Presentation/Settings.hs +++ b/lib/Patat/Presentation/Settings.hs @@ -6,6 +6,7 @@ module Patat.Presentation.Settings ( PresentationSettings (..) , defaultPresentationSettings + , AutoOr (..) , MarginSettings (..) , ExtensionList (..) @@ -100,11 +101,21 @@ defaultPresentationSettings = mempty } +-------------------------------------------------------------------------------- +data AutoOr a = Auto | NotAuto a deriving (Show) + + +-------------------------------------------------------------------------------- +instance A.FromJSON a => A.FromJSON (AutoOr a) where + parseJSON (A.String "auto") = pure Auto + parseJSON val = NotAuto <$> A.parseJSON val + + -------------------------------------------------------------------------------- data MarginSettings = MarginSettings - { msTop :: !(Maybe (A.FlexibleNum Int)) - , msLeft :: !(Maybe (A.FlexibleNum Int)) - , msRight :: !(Maybe (A.FlexibleNum Int)) + { msTop :: !(Maybe (AutoOr (A.FlexibleNum Int))) + , msLeft :: !(Maybe (AutoOr (A.FlexibleNum Int))) + , msRight :: !(Maybe (AutoOr (A.FlexibleNum Int))) } deriving (Show) diff --git a/stack.yaml b/stack.yaml index 9d92bf7..9104ae5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -11,5 +11,5 @@ flags: nix: packages: - - 'pkgconfig' + - 'pkg-config' - 'zlib' diff --git a/tests/golden/outputs/margins.md.dump b/tests/golden/outputs/margins.md.dump index 5622549..62c2eae 100644 --- a/tests/golden/outputs/margins.md.dump +++ b/tests/golden/outputs/margins.md.dump @@ -1,17 +1,14 @@ -  margins.md  + margins.md    - This text will have 10 spaces on - the left. -  -  - So -  * will -  * these -  * bullets + This text will have 10 spaces on the left. +  +  - So +  * will +  * these +  * bullets -  - This line will have 10 spaces on - the left, but will also break - after "left". +  + This line will have 10 spaces on the left, + but will also break after "left". -   -  1 / 1  + 1 / 1  From bf124d6bd991f8d0dd746577ced17891cbfb2230 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 8 Feb 2024 16:25:38 +0100 Subject: [PATCH 02/20] understand columns --- lib/Patat/Presentation/Display.hs | 17 +++++++++-------- tests/golden/inputs/margins.md | 1 + tests/golden/outputs/margins.md.dump | 2 +- 3 files changed, 11 insertions(+), 9 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index 298708f..cf7212c 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -158,9 +158,9 @@ dumpPresentation pres@Presentation {..} = dumpSlide i = do slide <- maybeToList $ getSlide i pres dumpComment slide <> L.intercalate ["{fragment}"] - [ dumpFragment (i, j) - | j <- [0 .. numFragments slide - 1] - ] + [ dumpFragment (i, j) + | j <- [0 .. numFragments slide - 1] + ] dumpComment :: Slide -> [PP.Doc] dumpComment slide = do @@ -186,16 +186,17 @@ dumpPresentation pres@Presentation {..} = -------------------------------------------------------------------------------- formatWith :: PresentationSettings -> PP.Doc -> PP.Doc -formatWith ps doc = wrap . indent $ - mconcat (replicate topMargin PP.hardline) <> doc +formatWith ps doc = + mconcat (replicate topMargin PP.hardline) <> + wrap (indent doc) where Margins {..} = margins ps - right = case mRight of - Auto -> error "auto" - NotAuto x -> x topMargin = case mTop of Auto -> error "auto" NotAuto x -> x + right = case mRight of + Auto -> error "auto" + NotAuto x -> x wrap = case (psWrap ps, psColumns ps) of (Just True, Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - right) _ -> id diff --git a/tests/golden/inputs/margins.md b/tests/golden/inputs/margins.md index 5d0a59c..cf49fd1 100644 --- a/tests/golden/inputs/margins.md +++ b/tests/golden/inputs/margins.md @@ -1,4 +1,5 @@ --- +author: 'Jasper' patat: wrap: true columns: 57 # 10 + 42 + 5 diff --git a/tests/golden/outputs/margins.md.dump b/tests/golden/outputs/margins.md.dump index 62c2eae..265cfc0 100644 --- a/tests/golden/outputs/margins.md.dump +++ b/tests/golden/outputs/margins.md.dump @@ -1,5 +1,5 @@  margins.md  -  +  This text will have 10 spaces on the left.     - So From c01a9676681e4b40abc2fce51260b57d77086cb6 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 8 Feb 2024 19:17:37 +0100 Subject: [PATCH 03/20] progress --- lib/Patat/Presentation/Display.hs | 69 +++++++++++----------- lib/Patat/Presentation/Display/Internal.hs | 4 +- tests/golden/outputs/margins.md.dump | 2 +- 3 files changed, 40 insertions(+), 35 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index cf7212c..da9803a 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -42,24 +42,26 @@ data Display = DisplayDoc PP.Doc | DisplayImage FilePath deriving (Show) -- | Display something within the presentation borders that draw the title and -- the active slide number and so on. displayWithBorders - :: Size -> Presentation -> (Size -> DisplaySettings -> PP.Doc) -> PP.Doc -displayWithBorders (Size rows columns) pres@Presentation {..} f = + :: Size -> Presentation -> (DisplaySettings -> PP.Doc) -> PP.Doc +displayWithBorders size@(Size rows columns) pres@Presentation {..} f = (if null title then mempty else let titleRemainder = columns - titleWidth - titleOffset wrappedTitle = PP.spaces titleOffset <> PP.string title <> PP.spaces titleRemainder in borders wrappedTitle <> PP.hardline) <> - formatWith settings (f canvasSize ds) <> PP.hardline <> + mconcat (replicate topMargin PP.hardline) <> + formatWith size (activeSettings pres) body <> PP.hardline <> PP.goToLine (rows - 2) <> borders (PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space) <> PP.hardline where -- Get terminal width/title - (sidx, _) = pActiveFragment - settings = (activeSettings pres) {psColumns = Just $ A.FlexibleNum columns} - ds = DisplaySettings - { dsTheme = fromMaybe Theme.defaultTheme (psTheme settings) + (sidx, _) = pActiveFragment + settings = activeSettings pres + ds = DisplaySettings + { dsSize = canvasSize + , dsTheme = fromMaybe Theme.defaultTheme (psTheme settings) , dsSyntaxMap = pSyntaxMap } @@ -82,11 +84,13 @@ displayWithBorders (Size rows columns) pres@Presentation {..} f = borders = themed ds themeBorders -- Room left for content - topMargin = case mTop $ margins settings of - Auto -> error "auto" + topMargin = case mTop $ margins settings of + Auto -> let (r, _) = PP.dimensions body in (rows - 4 - r) `div` 2 NotAuto x -> x canvasSize = Size (rows - 2 - topMargin) columns + body = f ds + -- Compute footer. active | fromMaybe True $ psSlideNumber settings = show (sidx + 1) ++ " / " ++ show (length pSlides) @@ -107,19 +111,20 @@ displayPresentation size pres@Presentation {..} = , Just image <- onlyImage fragment -> DisplayImage $ T.unpack image Just (ActiveContent fragment) -> DisplayDoc $ - displayWithBorders size pres $ \_canvasSize theme -> + displayWithBorders size pres $ \theme -> prettyFragment theme fragment Just (ActiveTitle block) -> DisplayDoc $ - displayWithBorders size pres $ \canvasSize theme -> - let pblock = prettyBlock theme block + displayWithBorders size pres $ \theme -> + let canvasSize = dsSize theme + pblock = prettyBlock theme block (prows, pcols) = PP.dimensions pblock Margins {..} = margins (activeSettings pres) offsetRow = (sRows canvasSize `div` 2) - (prows `div` 2) left = case mLeft of - Auto -> error "auto" + Auto -> 0 NotAuto x -> x right = case mRight of - Auto -> error "auto" + Auto -> 0 NotAuto x -> x offsetCol = ((sCols canvasSize - left - right) `div` 2) - (pcols `div` 2) spaces = PP.NotTrimmable $ PP.spaces offsetCol in @@ -140,11 +145,10 @@ displayPresentation size pres@Presentation {..} = -- | Displays an error in the place of the presentation. This is useful if we -- want to display an error but keep the presentation running. displayPresentationError :: Size -> Presentation -> String -> PP.Doc -displayPresentationError size pres err = - displayWithBorders size pres $ \_ ds -> - themed ds themeStrong "Error occurred in the presentation:" <$$> - "" <$$> - (PP.string err) +displayPresentationError size pres err = displayWithBorders size pres $ \ds -> + themed ds themeStrong "Error occurred in the presentation:" <$$> + "" <$$> + (PP.string err) -------------------------------------------------------------------------------- @@ -185,24 +189,23 @@ dumpPresentation pres@Presentation {..} = -------------------------------------------------------------------------------- -formatWith :: PresentationSettings -> PP.Doc -> PP.Doc -formatWith ps doc = - mconcat (replicate topMargin PP.hardline) <> - wrap (indent doc) +formatWith :: Size -> PresentationSettings -> PP.Doc -> PP.Doc +formatWith (Size _ columns) ps doc = wrap $ indent doc where Margins {..} = margins ps - topMargin = case mTop of - Auto -> error "auto" - NotAuto x -> x - right = case mRight of - Auto -> error "auto" - NotAuto x -> x - wrap = case (psWrap ps, psColumns ps) of - (Just True, Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - right) - _ -> id + (_, dcols) = PP.dimensions doc + wrap = case psWrap ps of + Just True -> + let right = case mRight of + Auto -> 0 + NotAuto x -> x in + PP.wrapAt (Just $ columns - right) + _ -> id spaces = PP.NotTrimmable $ PP.spaces $ case mLeft of - Auto -> error "auto" NotAuto x -> x + Auto -> case mRight of + NotAuto _ -> 0 + Auto -> (columns - dcols) `div` 2 indent = PP.indent spaces spaces diff --git a/lib/Patat/Presentation/Display/Internal.hs b/lib/Patat/Presentation/Display/Internal.hs index 242b11d..984b110 100644 --- a/lib/Patat/Presentation/Display/Internal.hs +++ b/lib/Patat/Presentation/Display/Internal.hs @@ -6,6 +6,7 @@ module Patat.Presentation.Display.Internal -------------------------------------------------------------------------------- +import Patat.Size (Size) import qualified Patat.PrettyPrint as PP import qualified Patat.Theme as Theme import qualified Skylighting as Skylighting @@ -13,7 +14,8 @@ import qualified Skylighting as Skylighting -------------------------------------------------------------------------------- data DisplaySettings = DisplaySettings - { dsTheme :: !Theme.Theme + { dsSize :: !Size + , dsTheme :: !Theme.Theme , dsSyntaxMap :: !Skylighting.SyntaxMap } diff --git a/tests/golden/outputs/margins.md.dump b/tests/golden/outputs/margins.md.dump index 265cfc0..806b3b3 100644 --- a/tests/golden/outputs/margins.md.dump +++ b/tests/golden/outputs/margins.md.dump @@ -11,4 +11,4 @@  This line will have 10 spaces on the left,  but will also break after "left". - 1 / 1  + Jasper 1 / 1  From 0979190d8a81c2d1b210ae24696c5729b36e4b4b Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 08:23:53 +0100 Subject: [PATCH 04/20] wip --- lib/Patat/Presentation/Display.hs | 58 ++++++++++----------- lib/Patat/Presentation/Display/CodeBlock.hs | 2 +- lib/Patat/Presentation/Display/Internal.hs | 11 ++-- 3 files changed, 36 insertions(+), 35 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index da9803a..5e3b38a 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -43,7 +43,7 @@ data Display = DisplayDoc PP.Doc | DisplayImage FilePath deriving (Show) -- the active slide number and so on. displayWithBorders :: Size -> Presentation -> (DisplaySettings -> PP.Doc) -> PP.Doc -displayWithBorders size@(Size rows columns) pres@Presentation {..} f = +displayWithBorders (Size rows columns) pres@Presentation {..} f = (if null title then mempty else @@ -51,7 +51,7 @@ displayWithBorders size@(Size rows columns) pres@Presentation {..} f = wrappedTitle = PP.spaces titleOffset <> PP.string title <> PP.spaces titleRemainder in borders wrappedTitle <> PP.hardline) <> mconcat (replicate topMargin PP.hardline) <> - formatWith size (activeSettings pres) body <> PP.hardline <> + body <> PP.hardline <> PP.goToLine (rows - 2) <> borders (PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space) <> PP.hardline @@ -60,9 +60,11 @@ displayWithBorders size@(Size rows columns) pres@Presentation {..} f = (sidx, _) = pActiveFragment settings = activeSettings pres ds = DisplaySettings - { dsSize = canvasSize - , dsTheme = fromMaybe Theme.defaultTheme (psTheme settings) - , dsSyntaxMap = pSyntaxMap + { dsSize = canvasSize + , dsWrap = fromMaybe False $ psWrap settings + , dsMargins = margins settings + , dsTheme = fromMaybe Theme.defaultTheme (psTheme settings) + , dsSyntaxMap = pSyntaxMap } -- Compute title. @@ -84,13 +86,12 @@ displayWithBorders size@(Size rows columns) pres@Presentation {..} f = borders = themed ds themeBorders -- Room left for content + body = f ds topMargin = case mTop $ margins settings of Auto -> let (r, _) = PP.dimensions body in (rows - 4 - r) `div` 2 NotAuto x -> x canvasSize = Size (rows - 2 - topMargin) columns - body = f ds - -- Compute footer. active | fromMaybe True $ psSlideNumber settings = show (sidx + 1) ++ " / " ++ show (length pSlides) @@ -189,33 +190,30 @@ dumpPresentation pres@Presentation {..} = -------------------------------------------------------------------------------- -formatWith :: Size -> PresentationSettings -> PP.Doc -> PP.Doc -formatWith (Size _ columns) ps doc = wrap $ indent doc +prettyFragment :: DisplaySettings -> Fragment -> PP.Doc +prettyFragment ds (Fragment blocks) = + PP.vcat (map (wrapAndMargin . prettyBlock ds) blocks) <> + case prettyReferences ds blocks of + [] -> mempty + refs -> PP.hardline <> PP.vcat (map wrapAndMargin refs) where - Margins {..} = margins ps - (_, dcols) = PP.dimensions doc - wrap = case psWrap ps of - Just True -> + wrapAndMargin doc = wrap $ indent doc + where + (Size _ columns) = dsSize ds + Margins {..} = dsMargins ds + (_, dcols) = PP.dimensions doc + wrap = let right = case mRight of Auto -> 0 NotAuto x -> x in - PP.wrapAt (Just $ columns - right) - _ -> id - spaces = PP.NotTrimmable $ PP.spaces $ case mLeft of - NotAuto x -> x - Auto -> case mRight of - NotAuto _ -> 0 - Auto -> (columns - dcols) `div` 2 - indent = PP.indent spaces spaces - + if dsWrap ds then PP.wrapAt (Just $ columns - right) else id --------------------------------------------------------------------------------- -prettyFragment :: DisplaySettings -> Fragment -> PP.Doc -prettyFragment ds (Fragment blocks) = - prettyBlocks ds blocks <> - case prettyReferences ds blocks of - [] -> mempty - refs -> PP.hardline <> PP.vcat refs + spaces = PP.NotTrimmable $ PP.spaces $ case mLeft of + NotAuto x -> x + Auto -> case mRight of + NotAuto _ -> 0 + Auto -> (columns - dcols) `div` 2 + indent = PP.indent spaces spaces -------------------------------------------------------------------------------- @@ -241,7 +239,7 @@ prettyBlock ds (Pandoc.BulletList bss) = PP.vcat | bs <- bss ] <> PP.hardline where - prefix = " " <> PP.string [marker] <> " " + prefix = PP.string [marker] <> " " marker = case T.unpack <$> themeBulletListMarkers theme of Just (x : _) -> x _ -> '-' diff --git a/lib/Patat/Presentation/Display/CodeBlock.hs b/lib/Patat/Presentation/Display/CodeBlock.hs index 1fca2e7..b817b79 100644 --- a/lib/Patat/Presentation/Display/CodeBlock.hs +++ b/lib/Patat/Presentation/Display/CodeBlock.hs @@ -77,7 +77,7 @@ prettyCodeBlock ds classes rawCodeBlock = blockified line = let len = sourceLineLength line indent = PP.NotTrimmable " " in - PP.indent indent indent $ + -- PP.indent indent indent $ themed ds themeCodeBlock $ " " <> prettySourceLine line <> diff --git a/lib/Patat/Presentation/Display/Internal.hs b/lib/Patat/Presentation/Display/Internal.hs index 984b110..0325aa7 100644 --- a/lib/Patat/Presentation/Display/Internal.hs +++ b/lib/Patat/Presentation/Display/Internal.hs @@ -6,15 +6,18 @@ module Patat.Presentation.Display.Internal -------------------------------------------------------------------------------- -import Patat.Size (Size) -import qualified Patat.PrettyPrint as PP -import qualified Patat.Theme as Theme -import qualified Skylighting as Skylighting +import Patat.Presentation.Internal (Margins) +import qualified Patat.PrettyPrint as PP +import Patat.Size (Size) +import qualified Patat.Theme as Theme +import qualified Skylighting as Skylighting -------------------------------------------------------------------------------- data DisplaySettings = DisplaySettings { dsSize :: !Size + , dsWrap :: !Bool + , dsMargins :: !Margins , dsTheme :: !Theme.Theme , dsSyntaxMap :: !Skylighting.SyntaxMap } From 5ae28b9feb41c254cc6a5a1f43cf2259a63c66f3 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 15:11:01 +0100 Subject: [PATCH 05/20] fix tests --- lib/Patat/Presentation/Display.hs | 2 +- lib/Patat/Presentation/Display/CodeBlock.hs | 2 +- tests/golden/outputs/margins.md.dump | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index 5e3b38a..b95506b 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -239,7 +239,7 @@ prettyBlock ds (Pandoc.BulletList bss) = PP.vcat | bs <- bss ] <> PP.hardline where - prefix = PP.string [marker] <> " " + prefix = " " <> PP.string [marker] <> " " marker = case T.unpack <$> themeBulletListMarkers theme of Just (x : _) -> x _ -> '-' diff --git a/lib/Patat/Presentation/Display/CodeBlock.hs b/lib/Patat/Presentation/Display/CodeBlock.hs index b817b79..1fca2e7 100644 --- a/lib/Patat/Presentation/Display/CodeBlock.hs +++ b/lib/Patat/Presentation/Display/CodeBlock.hs @@ -77,7 +77,7 @@ prettyCodeBlock ds classes rawCodeBlock = blockified line = let len = sourceLineLength line indent = PP.NotTrimmable " " in - -- PP.indent indent indent $ + PP.indent indent indent $ themed ds themeCodeBlock $ " " <> prettySourceLine line <> diff --git a/tests/golden/outputs/margins.md.dump b/tests/golden/outputs/margins.md.dump index 806b3b3..3a1217b 100644 --- a/tests/golden/outputs/margins.md.dump +++ b/tests/golden/outputs/margins.md.dump @@ -1,13 +1,13 @@  margins.md   This text will have 10 spaces on the left. -  +   - So   * will   * these   * bullets -  +  This line will have 10 spaces on the left,  but will also break after "left". From a2f842a3e1a52b35d7a4995b5e2b6212f04766da Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 17:12:18 +0100 Subject: [PATCH 06/20] Refactor Trimmable into Indentation --- lib/Patat/Presentation/Display.hs | 22 ++++----- lib/Patat/Presentation/Display/CodeBlock.hs | 2 +- lib/Patat/Presentation/Display/Table.hs | 4 +- lib/Patat/PrettyPrint.hs | 8 +-- lib/Patat/PrettyPrint/Internal.hs | 55 +++++++++++---------- 5 files changed, 49 insertions(+), 42 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index 69c8df6..b88ce6b 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/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 $ diff --git a/lib/Patat/Presentation/Display/CodeBlock.hs b/lib/Patat/Presentation/Display/CodeBlock.hs index 1fca2e7..01b62a3 100644 --- a/lib/Patat/Presentation/Display/CodeBlock.hs +++ b/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 $ " " <> diff --git a/lib/Patat/Presentation/Display/Table.hs b/lib/Patat/Presentation/Display/Table.hs index e7de609..5aa7de4 100644 --- a/lib/Patat/Presentation/Display/Table.hs +++ b/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 diff --git a/lib/Patat/PrettyPrint.hs b/lib/Patat/PrettyPrint.hs index 295b655..9c7fea3 100644 --- a/lib/Patat/PrettyPrint.hs +++ b/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 } diff --git a/lib/Patat/PrettyPrint/Internal.hs b/lib/Patat/PrettyPrint/Internal.hs index cbc0d1a..7e5833c 100644 --- a/lib/Patat/PrettyPrint/Internal.hs +++ b/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? From a939a1c19a61846dd88729bb298c7491ba550be1 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 17:44:01 +0100 Subject: [PATCH 07/20] deindent --- lib/Patat/Presentation/Display.hs | 7 +++++-- lib/Patat/PrettyPrint.hs | 24 ++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index 25c22c9..a860769 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -197,11 +197,14 @@ prettyFragment ds (Fragment blocks) = [] -> mempty refs -> PP.hardline <> PP.vcat (map wrapAndMargin refs) where - wrapAndMargin doc = wrap $ indent doc + wrapAndMargin doc0 = wrap $ indent doc1 where (Size _ columns) = dsSize ds Margins {..} = dsMargins ds - (_, dcols) = PP.dimensions doc + doc1 = case (mLeft, mRight) of + (Auto, Auto) -> PP.deindent doc0 + _ -> doc0 + (_, dcols) = PP.dimensions doc1 wrap = let right = case mRight of Auto -> 0 diff --git a/lib/Patat/PrettyPrint.hs b/lib/Patat/PrettyPrint.hs index 9c7fea3..652183f 100644 --- a/lib/Patat/PrettyPrint.hs +++ b/lib/Patat/PrettyPrint.hs @@ -26,6 +26,7 @@ module Patat.PrettyPrint , Indentation (..) , indent + , deindent , ansi @@ -99,6 +100,29 @@ indent firstLineDoc otherLinesDoc doc = mkDoc $ Indent } +-------------------------------------------------------------------------------- +-- | Only strips leading spaces +deindent :: Doc -> Doc +deindent = Doc . concatMap go . unDoc + where + go :: DocE Doc -> [DocE Doc] + go doc@(Indent {..}) + | fs0 <= 0 && os0 <= 0 = [doc] + | fs1 == 0 && os1 == 0 && L.null fc && L.null oc = + concatMap go $ unDoc indentDoc + | otherwise = pure $ Indent + { indentFirstLine = Indentation fs1 fc + , indentOtherLines = Indentation os1 oc + , indentDoc = indentDoc + } + where + Indentation fs0 fc = indentFirstLine + Indentation os0 oc = indentOtherLines + fs1 = fs0 - min fs0 os0 + os1 = os0 - min fs0 os0 + go doc = [doc] + + -------------------------------------------------------------------------------- ansi :: [Ansi.SGR] -> Doc -> Doc ansi codes = mkDoc . Ansi (codes ++) From 083dac552431574a8b4dda2216ff3a3b3c702593 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 17:46:21 +0100 Subject: [PATCH 08/20] regenerate golden tests --- tests/golden/outputs/03.md.dump | 12 ++++----- tests/golden/outputs/eval01.md.dump | 8 +++--- tests/golden/outputs/eval02.md.dump | 8 +++--- tests/golden/outputs/eval03.md.dump | 4 +-- tests/golden/outputs/eval04.md.dump | 4 +-- tests/golden/outputs/fragments.md.dump | 34 +++++++++++++------------- tests/golden/outputs/issue-111.md.dump | 6 ++--- tests/golden/outputs/lists.md.dump | 10 ++++---- tests/golden/outputs/margins.md.dump | 8 +++--- tests/golden/outputs/meta.md.dump | 12 ++++----- tests/golden/outputs/tables.md.dump | 4 +-- tests/golden/outputs/themes.md.dump | 8 +++--- tests/golden/outputs/wrapping.md.dump | 6 ++--- 13 files changed, 62 insertions(+), 62 deletions(-) diff --git a/tests/golden/outputs/03.md.dump b/tests/golden/outputs/03.md.dump index b899630..6567af5 100644 --- a/tests/golden/outputs/03.md.dump +++ b/tests/golden/outputs/03.md.dump @@ -2,8 +2,8 @@ Inline markups: - - ~~striked out~~ - - <http://example.com> + - ~~striked out~~ + - <http://example.com>  1 / 5  @@ -14,21 +14,21 @@ > Quote with embedded list: >  ->  - Hello ->  - World +>  - Hello +>  - World  2 / 5  {slide}  03.md  - - List with an embedded quote: + - List with an embedded quote:  > Tu quoque  Wow rad stuff. - - Second item in that list. + - Second item in that list.  3 / 5  diff --git a/tests/golden/outputs/eval01.md.dump b/tests/golden/outputs/eval01.md.dump index ccf81a3..36b4ad3 100644 --- a/tests/golden/outputs/eval01.md.dump +++ b/tests/golden/outputs/eval01.md.dump @@ -2,13 +2,13 @@ # Slide 1 - - This is some code that is not evaluated: + - This is some code that is not evaluated:      echo foo     - - And here is some code that is evaluated: + - And here is some code that is evaluated:      echo foo  @@ -22,13 +22,13 @@ # Slide 1 - - This is some code that is not evaluated: + - This is some code that is not evaluated:      echo foo     - - And here is some code that is evaluated: + - And here is some code that is evaluated:      foo  diff --git a/tests/golden/outputs/eval02.md.dump b/tests/golden/outputs/eval02.md.dump index edf436f..eb383c4 100644 --- a/tests/golden/outputs/eval02.md.dump +++ b/tests/golden/outputs/eval02.md.dump @@ -2,13 +2,13 @@ # Slide 1 - - This is some code that is not evaluated: + - This is some code that is not evaluated:      echo foo     - - And here is some code that is evaluated: + - And here is some code that is evaluated:      echo foo  @@ -22,13 +22,13 @@ # Slide 1 - - This is some code that is not evaluated: + - This is some code that is not evaluated:      echo foo     - - And here is some code that is evaluated: + - And here is some code that is evaluated:      echo foo  diff --git a/tests/golden/outputs/eval03.md.dump b/tests/golden/outputs/eval03.md.dump index a348987..a676595 100644 --- a/tests/golden/outputs/eval03.md.dump +++ b/tests/golden/outputs/eval03.md.dump @@ -2,13 +2,13 @@ # Slide 1 - - This is some code that is not evaluated: + - This is some code that is not evaluated:      echo foo     - - And here is some code that is evaluated: + - And here is some code that is evaluated:      foo  diff --git a/tests/golden/outputs/eval04.md.dump b/tests/golden/outputs/eval04.md.dump index f43f038..73a568e 100644 --- a/tests/golden/outputs/eval04.md.dump +++ b/tests/golden/outputs/eval04.md.dump @@ -2,13 +2,13 @@ # Slide 1 - - This is some code that is not evaluated: + - This is some code that is not evaluated:      echo foo     - - And here is some code that is evaluated: + - And here is some code that is evaluated:      echo foo  diff --git a/tests/golden/outputs/fragments.md.dump b/tests/golden/outputs/fragments.md.dump index b02f34d..1a029c6 100644 --- a/tests/golden/outputs/fragments.md.dump +++ b/tests/golden/outputs/fragments.md.dump @@ -6,7 +6,7 @@ {fragment}  fragments.md  - - This list + - This list  1 / 2  @@ -14,9 +14,9 @@ {fragment}  fragments.md  - - This list + - This list - - is displayed + - is displayed  1 / 2  @@ -24,11 +24,11 @@ {fragment}  fragments.md  - - This list + - This list - - is displayed + - is displayed -  * item + * item  1 / 2  @@ -36,12 +36,12 @@ {fragment}  fragments.md  - - This list + - This list - - is displayed + - is displayed -  * item -  * by item + * item + * by item  1 / 2  @@ -49,17 +49,17 @@ {fragment}  fragments.md  - - This list + - This list - - is displayed + - is displayed -  * item -  * by item + * item + * by item - - Or sometimes + - Or sometimes -  * all at -  * once + * all at + * once  1 / 2  diff --git a/tests/golden/outputs/issue-111.md.dump b/tests/golden/outputs/issue-111.md.dump index 6871b99..21a4510 100644 --- a/tests/golden/outputs/issue-111.md.dump +++ b/tests/golden/outputs/issue-111.md.dump @@ -32,8 +32,8 @@ > This is a block quote with a fairly long paragraph >  ->  - With ->  - a nice ->  - list +>  - With +>  - a nice +>  - list  3 / 3  diff --git a/tests/golden/outputs/lists.md.dump b/tests/golden/outputs/lists.md.dump index 8b6d683..1daada7 100644 --- a/tests/golden/outputs/lists.md.dump +++ b/tests/golden/outputs/lists.md.dump @@ -1,19 +1,19 @@  lists.md  - - This is a nested list. + - This is a nested list. -  * The nested items should have different list markers. + * The nested items should have different list markers. -  * I mean, they can be the same, but it doesn't look nice. + * I mean, they can be the same, but it doesn't look nice.  printf("Nested code block!\n") -  * Cool right? + * Cool right?  Definitely super cool - - One final item + - One final item  1 / 1  diff --git a/tests/golden/outputs/margins.md.dump b/tests/golden/outputs/margins.md.dump index 3a1217b..52921f0 100644 --- a/tests/golden/outputs/margins.md.dump +++ b/tests/golden/outputs/margins.md.dump @@ -2,10 +2,10 @@  This text will have 10 spaces on the left. -  - So -  * will -  * these -  * bullets + - So + * will + * these + * bullets  This line will have 10 spaces on the left, diff --git a/tests/golden/outputs/meta.md.dump b/tests/golden/outputs/meta.md.dump index 7d92347..c6fd627 100644 --- a/tests/golden/outputs/meta.md.dump +++ b/tests/golden/outputs/meta.md.dump @@ -1,11 +1,11 @@  meta.md  - < Hello - < World -  > How -  > Are -  > You -  > Doing + < Hello + < World + > How + > Are + > You + > Doing  1 / 1  diff --git a/tests/golden/outputs/tables.md.dump b/tests/golden/outputs/tables.md.dump index 1205bd0..714503b 100644 --- a/tests/golden/outputs/tables.md.dump +++ b/tests/golden/outputs/tables.md.dump @@ -35,7 +35,7 @@  -------- ------- ------- ------------------------  First row 12.0 Example of a row that   spans multiple lines.  -  +  Second row 5.0 Here's another one. Note  the blank line between   rows.  @@ -53,7 +53,7 @@  ------ --- ---- ------------------------  First row 12.0 Example of a row that   spans multiple lines.  -  +  Second row 5.0 Here's another one. Note  the blank line between   rows.  diff --git a/tests/golden/outputs/themes.md.dump b/tests/golden/outputs/themes.md.dump index a4f7f21..e2ba579 100644 --- a/tests/golden/outputs/themes.md.dump +++ b/tests/golden/outputs/themes.md.dump @@ -1,9 +1,9 @@  themes.md  - - This is a simple list. -  + With nested items. -  + One or two bold. + - This is a simple list. + + With nested items. + + One or two bold. - - The list theming is customized a bit. + - The list theming is customized a bit.  1 / 1  diff --git a/tests/golden/outputs/wrapping.md.dump b/tests/golden/outputs/wrapping.md.dump index cec026b..638f65c 100644 --- a/tests/golden/outputs/wrapping.md.dump +++ b/tests/golden/outputs/wrapping.md.dump @@ -12,11 +12,11 @@  1 2 3 4 5   6 7 8 9 10  - - This is a list - - This list has a really long sentence + - This is a list + - This list has a really long sentence  in it which should also be wrapped  with proper indentation - - Another item + - Another item This line is long, and then ends with  code  From 1e52a61250b3d22fff48dd08a64edddc5be0daee Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 18:00:48 +0100 Subject: [PATCH 09/20] add test --- tests/golden/inputs/margins-auto.md | 46 ++++++++++++++++++ tests/golden/outputs/margins-auto.md.dump | 58 +++++++++++++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 tests/golden/inputs/margins-auto.md create mode 100644 tests/golden/outputs/margins-auto.md.dump diff --git a/tests/golden/inputs/margins-auto.md b/tests/golden/inputs/margins-auto.md new file mode 100644 index 0000000..e8f5f84 --- /dev/null +++ b/tests/golden/inputs/margins-auto.md @@ -0,0 +1,46 @@ +--- +author: 'Jasper' +patat: + margins: + left: auto + right: auto +... + +# A header + +Some text + +## Subheader + +with more info + +1. One +2. Two +3. Three + +# Hello + +- Some really fancy lists +- With another list embedded: + * Yes + * No +- And a codeblock: + + ``` + 1 + 2 + ``` + +And a paragraph + +```haskell +Yeah | Nope +``` + +# Vertical centered slide + + + +Yo diff --git a/tests/golden/outputs/margins-auto.md.dump b/tests/golden/outputs/margins-auto.md.dump new file mode 100644 index 0000000..9c4f680 --- /dev/null +++ b/tests/golden/outputs/margins-auto.md.dump @@ -0,0 +1,58 @@ + margins-auto.md  + + # A header + + Some text + + ## Subheader + + with more info + + 1. One + 2. Two + 3. Three + + Jasper 1 / 3  + +{slide} + margins-auto.md  + + # Hello + + - Some really fancy lists + + - With another list embedded: + + * Yes + * No + + - And a codeblock: + +   +  1 + 2  +   + + + And a paragraph + +   +  Yeah | Nope  +   + + Jasper 2 / 3  + +{slide} + margins-auto.md  + + + + + + + + + # Vertical centered slide + + Yo + + Jasper 3 / 3  From eec9a673b777a47e2b390e06c4492ad90fabbedb Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 18:31:51 +0100 Subject: [PATCH 10/20] bump README.md --- README.md | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index d11b2bc..3bccd18 100644 --- a/README.md +++ b/README.md @@ -18,8 +18,8 @@ feature-rich presentation tool that runs in the terminal. - [Transition effects](#transitions). - Supports [smart slide splitting](#input-format). - [Auto advancing](#auto-advancing) with configurable delay. -- Optionally [re-wrapping](#line-wrapping) text to terminal width with proper - indentation. +- [Centering](#centering) and [re-wrapping](#line-wrapping) text to terminal + width with proper indentation. - [Theming](#theming) support including 24-bit RGB. - Hihgly portable as it only requires an ANSI terminal as opposed to something like `ncurses`. @@ -333,6 +333,25 @@ margin. By default, the `left` and `right` margin are set to 0, and the `top` margin is set to 1. +#### Centering + +To vertically center content, use `top: auto`. horizontally center content, use +To both both `left: auto` and `right: auto`. For example: + +```markdown +--- +title: Centered presentation +author: John Doe +patat: + margins: + left: auto + right: auto + top: auto +... + +Hello world +``` + ### Auto advancing By setting `autoAdvanceDelay` to a number of seconds, `patat` will automatically From a3b213bf3b0b3dfb559f9208153113cb4a5797e0 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 18:37:46 +0100 Subject: [PATCH 11/20] bump README.md --- README.md | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 3bccd18..c4abb9b 100644 --- a/README.md +++ b/README.md @@ -335,14 +335,15 @@ set to 1. #### Centering -To vertically center content, use `top: auto`. horizontally center content, use -To both both `left: auto` and `right: auto`. For example: +To vertically center content, use `top: auto`. To horizontally center content, +use both `left: auto` and `right: auto`. For example: ```markdown --- title: Centered presentation author: John Doe patat: + wrap: true margins: left: auto right: auto @@ -352,6 +353,9 @@ patat: Hello world ``` +Setting `wrap: true` is recommended when vertically centering content if there +are any lines that are too wide for the terminal. + ### Auto advancing By setting `autoAdvanceDelay` to a number of seconds, `patat` will automatically From 162b1741ab294c2eafc74e24d3ab22b1b50cf108 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 18:40:41 +0100 Subject: [PATCH 12/20] add wrap+center test --- tests/golden/inputs/margins-auto-wrap.md | 14 ++++++++++++++ tests/golden/outputs/margins-auto-wrap.md.dump | 15 +++++++++++++++ 2 files changed, 29 insertions(+) create mode 100755 tests/golden/inputs/margins-auto-wrap.md create mode 100644 tests/golden/outputs/margins-auto-wrap.md.dump diff --git a/tests/golden/inputs/margins-auto-wrap.md b/tests/golden/inputs/margins-auto-wrap.md new file mode 100755 index 0000000..0bd7c2e --- /dev/null +++ b/tests/golden/inputs/margins-auto-wrap.md @@ -0,0 +1,14 @@ +--- +title: Centered presentation +author: John Doe +patat: + wrap: true + margins: + left: auto + right: auto + top: auto +... + +Hello world + +Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world diff --git a/tests/golden/outputs/margins-auto-wrap.md.dump b/tests/golden/outputs/margins-auto-wrap.md.dump new file mode 100644 index 0000000..8b5f428 --- /dev/null +++ b/tests/golden/outputs/margins-auto-wrap.md.dump @@ -0,0 +1,15 @@ + Centered presentation  + + + + + + + + + Hello world + +Hello world Hello world Hello world Hello world Hello world Hello world +Hello world Hello world Hello world Hello world Hello world Hello world + + John Doe 1 / 1  From 71941091ab60bdb0cd34c07f2777e48ea4bde971 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Feb 2024 20:22:00 +0100 Subject: [PATCH 13/20] add TODO --- lib/Patat/Presentation/Display.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index a860769..94e5bb1 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -88,8 +88,10 @@ displayWithBorders (Size rows columns) pres@Presentation {..} f = -- Room left for content body = f ds topMargin = case mTop $ margins settings of - Auto -> let (r, _) = PP.dimensions body in (rows - 4 - r) `div` 2 + Auto -> let (r, _) = PP.dimensions body in (rows - 2 - r) `div` 2 NotAuto x -> x + -- NOTE: rows in canvasSize seems incorrect, but maybe it's not used? + -- topMargin here should match offsetRow in 'displayPresentation' canvasSize = Size (rows - 2 - topMargin) columns -- Compute footer. From f6ad82b3d395c40b83e4a17a28406cbad2e9f8a1 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sat, 10 Feb 2024 08:16:06 +0100 Subject: [PATCH 14/20] polish --- lib/Patat/Presentation/Display.hs | 56 +++++++++-------------- tests/golden/outputs/headers.md.dump | 6 ++- tests/golden/outputs/margins-auto.md.dump | 1 + tests/golden/outputs/margins-top.md.dump | 2 +- tests/golden/outputs/slidelevel2.md.dump | 6 ++- tests/golden/outputs/slidelevel3.md.dump | 12 +++-- 6 files changed, 39 insertions(+), 44 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index 94e5bb1..84c301f 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -50,8 +50,7 @@ displayWithBorders (Size rows columns) pres@Presentation {..} f = let titleRemainder = columns - titleWidth - titleOffset wrappedTitle = PP.spaces titleOffset <> PP.string title <> PP.spaces titleRemainder in borders wrappedTitle <> PP.hardline) <> - mconcat (replicate topMargin PP.hardline) <> - body <> PP.hardline <> + f ds <> PP.hardline <> PP.goToLine (rows - 2) <> borders (PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space) <> PP.hardline @@ -86,13 +85,7 @@ displayWithBorders (Size rows columns) pres@Presentation {..} f = borders = themed ds themeBorders -- Room left for content - body = f ds - topMargin = case mTop $ margins settings of - Auto -> let (r, _) = PP.dimensions body in (rows - 2 - r) `div` 2 - NotAuto x -> x - -- NOTE: rows in canvasSize seems incorrect, but maybe it's not used? - -- topMargin here should match offsetRow in 'displayPresentation' - canvasSize = Size (rows - 2 - topMargin) columns + canvasSize = Size (rows - 3) columns -- Compute footer. active @@ -117,22 +110,9 @@ displayPresentation size pres@Presentation {..} = displayWithBorders size pres $ \theme -> prettyFragment theme fragment Just (ActiveTitle block) -> DisplayDoc $ - displayWithBorders size pres $ \theme -> - let canvasSize = dsSize theme - pblock = prettyBlock theme block - (prows, pcols) = PP.dimensions pblock - Margins {..} = margins (activeSettings pres) - offsetRow = (sRows canvasSize `div` 2) - (prows `div` 2) - left = case mLeft of - Auto -> 0 - NotAuto x -> x - right = case mRight of - Auto -> 0 - NotAuto x -> x - offsetCol = ((sCols canvasSize - left - right) `div` 2) - (pcols `div` 2) - spaces = PP.Indentation offsetCol mempty in - mconcat (replicate (offsetRow - 3) PP.hardline) <$$> - PP.indent spaces spaces pblock + displayWithBorders size pres $ \ds -> + let auto = Margins {mTop = Auto, mRight = Auto, mLeft = Auto} in + prettyFragment ds {dsMargins = auto} $ Fragment [block] where -- Check if the fragment consists of "just a single image". Discard @@ -193,13 +173,21 @@ dumpPresentation pres@Presentation {..} = -------------------------------------------------------------------------------- prettyFragment :: DisplaySettings -> Fragment -> PP.Doc -prettyFragment ds (Fragment blocks) = - PP.vcat (map (wrapAndMargin . prettyBlock ds) blocks) <> +prettyFragment ds (Fragment blocks) = vertical $ + PP.vcat (map (horizontal . prettyBlock ds) blocks) <> case prettyReferences ds blocks of [] -> mempty - refs -> PP.hardline <> PP.vcat (map wrapAndMargin refs) + refs -> PP.hardline <> PP.vcat (map horizontal refs) where - wrapAndMargin doc0 = wrap $ indent doc1 + vertical doc0 = + mconcat (replicate top PP.hardline) <> doc0 + where + (Size rows _) = dsSize ds + top = case mTop (dsMargins ds) of + Auto -> let (r, _) = PP.dimensions doc0 in (rows - r) `div` 2 + NotAuto x -> x + + horizontal doc0 = wrap $ indent doc1 where (Size _ columns) = dsSize ds Margins {..} = dsMargins ds @@ -207,12 +195,10 @@ prettyFragment ds (Fragment blocks) = (Auto, Auto) -> PP.deindent doc0 _ -> doc0 (_, dcols) = PP.dimensions doc1 - wrap = - let right = case mRight of - Auto -> 0 - NotAuto x -> x in - if dsWrap ds then PP.wrapAt (Just $ columns - right) else id - + 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 diff --git a/tests/golden/outputs/headers.md.dump b/tests/golden/outputs/headers.md.dump index cad2eda..c062c64 100644 --- a/tests/golden/outputs/headers.md.dump +++ b/tests/golden/outputs/headers.md.dump @@ -8,7 +8,8 @@ - # This could be a title + + # This could be a title  1 / 5  @@ -41,7 +42,8 @@ - # Another topic + + # Another topic  4 / 5  diff --git a/tests/golden/outputs/margins-auto.md.dump b/tests/golden/outputs/margins-auto.md.dump index 9c4f680..c53a7ed 100644 --- a/tests/golden/outputs/margins-auto.md.dump +++ b/tests/golden/outputs/margins-auto.md.dump @@ -51,6 +51,7 @@ +  # Vertical centered slide  Yo diff --git a/tests/golden/outputs/margins-top.md.dump b/tests/golden/outputs/margins-top.md.dump index 71214a4..b023eb1 100644 --- a/tests/golden/outputs/margins-top.md.dump +++ b/tests/golden/outputs/margins-top.md.dump @@ -9,7 +9,7 @@ - # Title slides are not affected + # Title slides are not affected  1 / 2  diff --git a/tests/golden/outputs/slidelevel2.md.dump b/tests/golden/outputs/slidelevel2.md.dump index 4261b7f..d572dda 100644 --- a/tests/golden/outputs/slidelevel2.md.dump +++ b/tests/golden/outputs/slidelevel2.md.dump @@ -8,7 +8,8 @@ - # This is a title + + # This is a title  1 / 5  @@ -41,7 +42,8 @@ - # This is another title + + # This is another title  4 / 5  diff --git a/tests/golden/outputs/slidelevel3.md.dump b/tests/golden/outputs/slidelevel3.md.dump index 2594587..6c2a2ab 100644 --- a/tests/golden/outputs/slidelevel3.md.dump +++ b/tests/golden/outputs/slidelevel3.md.dump @@ -8,7 +8,8 @@ - # This is a title + + # This is a title  1 / 6  @@ -23,7 +24,8 @@ - ## This is a subtitle + + ## This is a subtitle  2 / 6  @@ -47,7 +49,8 @@ - # This is another title + + # This is another title  4 / 6  @@ -62,7 +65,8 @@ - ## This is another subtitle + + ## This is another subtitle  5 / 6  From 5c29c994bbe29621d8bff12fbe36095241c6cc8b Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sat, 10 Feb 2024 17:08:46 +0100 Subject: [PATCH 15/20] bump CHANGELOG --- CHANGELOG.md | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index a9759f2..36861f8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,32 @@ # Changelog +## unreleased + + * Add Support centering content with auto margins #164 + + Configuration is done through the existing `margins` setting. + + To vertically center content, use `top: auto`. To horizontally center + content, use both `left: auto` and `right: auto`. For example: + + ```markdown + --- + title: Centered presentation + author: John Doe + patat: + wrap: true + margins: + left: auto + right: auto + top: auto + ... + + Hello world + ``` + + Setting `wrap: true` is recommended when vertically centering content if + there are any lines that are too wide for the terminal. + ## 0.10.2.0 (2023-11-25) * Add eval.wrap option From 6f1f78fdc239f483a84b8934a084ee7d823a7aeb Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 11 Feb 2024 14:40:51 +0100 Subject: [PATCH 16/20] add broken test case --- tests/golden/inputs/margins-auto-wrap.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/golden/inputs/margins-auto-wrap.md b/tests/golden/inputs/margins-auto-wrap.md index 0bd7c2e..2067d50 100755 --- a/tests/golden/inputs/margins-auto-wrap.md +++ b/tests/golden/inputs/margins-auto-wrap.md @@ -12,3 +12,8 @@ patat: Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world + +--- + +Hello world +This is a test From 2ee555732501dee0d5e21b5ed4a3673592bf5304 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 11 Feb 2024 17:19:30 +0100 Subject: [PATCH 17/20] fix wrapping bug --- README.md | 1 - lib/Patat/Presentation/Display.hs | 28 ++++++++++++------- lib/Patat/PrettyPrint/Internal.hs | 20 ++++++++----- .../golden/outputs/margins-auto-wrap.md.dump | 18 +++++++++++- 4 files changed, 48 insertions(+), 19 deletions(-) diff --git a/README.md b/README.md index c4abb9b..7426744 100644 --- 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 index 84c301f..34febc1 100644 --- 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 index 7e5833c..9c1fe97 100644 --- 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 index 8b5f428..0a5e526 100644 --- a/tests/golden/outputs/margins-auto-wrap.md.dump +++ b/tests/golden/outputs/margins-auto-wrap.md.dump @@ -12,4 +12,20 @@ Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world Hello world - John Doe 1 / 1  + John Doe 1 / 2  + +{slide} + Centered presentation  + + + + + + + + + + + Hello world This is a test + + John Doe 2 / 2  From 9ed911e239faca1d059699b7b9edafba4ca805e3 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 12 Feb 2024 09:50:19 +0100 Subject: [PATCH 18/20] speed up current col computation --- lib/Patat/PrettyPrint/Internal.hs | 42 ++++++++++++++++++++----------- 1 file changed, 27 insertions(+), 15 deletions(-) diff --git a/lib/Patat/PrettyPrint/Internal.hs b/lib/Patat/PrettyPrint/Internal.hs index 9c1fe97..2f4c227 100644 --- a/lib/Patat/PrettyPrint/Internal.hs +++ b/lib/Patat/PrettyPrint/Internal.hs @@ -34,7 +34,7 @@ module Patat.PrettyPrint.Internal -------------------------------------------------------------------------------- import Control.Monad.Reader (asks, local) import Control.Monad.RWS (RWS, runRWS) -import Control.Monad.State (get, gets, modify) +import Control.Monad.State (get, modify) import Control.Monad.Writer (tell) import Data.Char.WCWidth.Extended (wcstrwidth) import qualified Data.List as L @@ -162,8 +162,14 @@ type DocM = RWS DocEnv Chunks LineBuffer -------------------------------------------------------------------------------- --- | Note that these are reversed so we have fast append -data LineBuffer = LineBuffer [Indentation [Chunk]] [Chunk] +-- | Note that the lists here are reversed so we have fast append. +-- We also store the current length to avoid having to recompute it. +data LineBuffer = LineBuffer Int [Indentation [Chunk]] [Chunk] + + +-------------------------------------------------------------------------------- +emptyLineBuffer :: LineBuffer +emptyLineBuffer = LineBuffer 0 [] [] -------------------------------------------------------------------------------- @@ -177,9 +183,15 @@ indentationToChunks (Indentation 0 c) = c indentationToChunks (Indentation n c) = StringChunk [] (replicate n ' ') : c +-------------------------------------------------------------------------------- +indentationWidth :: Indentation [Chunk] -> Int +indentationWidth (Indentation s c) = + s + sum (map (wcstrwidth . chunkToString) c) + + -------------------------------------------------------------------------------- bufferToChunks :: LineBuffer -> Chunks -bufferToChunks (LineBuffer ind chunks) = case chunks of +bufferToChunks (LineBuffer _ ind chunks) = case chunks of [] -> concatMap indentationToChunks $ reverse $ dropWhile emptyIndentation ind _ -> concatMap indentationToChunks (reverse ind) ++ reverse chunks @@ -192,7 +204,7 @@ bufferToChunks (LineBuffer ind chunks) = case chunks of docToChunks :: Doc -> Chunks docToChunks doc0 = let env0 = DocEnv [] [] Nothing - ((), b, cs) = runRWS (go $ unDoc doc0) env0 (LineBuffer [] []) in + ((), b, cs) = runRWS (go $ unDoc doc0) env0 emptyLineBuffer in optimizeChunks (cs <> bufferToChunks b) where go :: [DocE Doc] -> DocM () @@ -220,12 +232,14 @@ docToChunks doc0 = go (Hardline : docs) = do buffer <- get tell $ bufferToChunks buffer <> [NewlineChunk] - indentation <- asks deIndent - modify $ \_ -> LineBuffer (if L.null docs then [] else indentation) [] + ind <- asks deIndent + modify $ \_ -> case docs of + [] -> emptyLineBuffer + _ : _ -> LineBuffer (sum $ map indentationWidth ind) ind [] go docs go (WrapAt {..} : docs) = do - il <- asks $ wcchunkswidth . concatMap indentationToChunks . deIndent + il <- asks $ sum . map indentationWidth . deIndent local (\env -> env {deWrap = fmap (+ il) wrapAtCol}) $ go (unDoc wrapDoc) go docs @@ -236,7 +250,8 @@ docToChunks doc0 = go (Indent {..} : docs) = do local (\e -> e {deIndent = indentOtherLines : deIndent e}) $ do - modify $ \(LineBuffer i c) -> LineBuffer (indentFirstLine : i) c + modify $ \(LineBuffer w i c) -> LineBuffer + (w + indentationWidth indentFirstLine) (indentFirstLine : i) c go (unDoc indentDoc) go docs @@ -251,7 +266,8 @@ docToChunks doc0 = return $ StringChunk codes str appendChunk :: Chunk -> DocM () - appendChunk c = modify $ \(LineBuffer i cs) -> LineBuffer i (c : cs) + appendChunk c = modify $ \(LineBuffer w i cs) -> + LineBuffer (w + wcstrwidth (chunkToString c)) i (c : cs) -- Convert 'Softspace' or 'Softline' to 'Hardspace' or 'Hardline' softConversion :: DocE Doc -> [DocE Doc] -> DocM (DocE Doc) @@ -260,9 +276,7 @@ docToChunks doc0 = case mbWrapCol of Nothing -> return hard Just maxCol -> do - -- Slow. - currentLine <- gets bufferToChunks - let currentCol = wcchunkswidth currentLine + LineBuffer currentCol _ _ <- get case nextWordLength docs of Nothing -> return hard Just l @@ -288,8 +302,6 @@ docToChunks doc0 = nextWordLength (Indent {..} : xs) = nextWordLength (unDoc indentDoc ++ xs) nextWordLength (Control _ : _) = Nothing - wcchunkswidth = wcstrwidth . concatMap chunkToString - -------------------------------------------------------------------------------- toString :: Doc -> String From f6c00f978b88e8a89793c0629e6b3c555228599a Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 12 Feb 2024 10:11:13 +0100 Subject: [PATCH 19/20] Bump CHANGELOG.md --- CHANGELOG.md | 1 - 1 file changed, 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 36861f8..4178935 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,7 +14,6 @@ title: Centered presentation author: John Doe patat: - wrap: true margins: left: auto right: auto From fc3c3d655a31d37240406eae30d601531480f42e Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 12 Feb 2024 16:37:01 +0100 Subject: [PATCH 20/20] Bump CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4178935..8fc2115 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,7 @@ ## unreleased - * Add Support centering content with auto margins #164 + * Support centering content with auto margins (#164) Configuration is done through the existing `margins` setting.