packages feed

prettyprinter 1.2 → 1.2.0.1

raw patch · 3 files changed

+46/−12 lines, 3 files

Files

prettyprinter.cabal view
@@ -1,5 +1,5 @@ name:                prettyprinter-version:             1.2+version:             1.2.0.1 cabal-version:       >= 1.10 category:            User Interfaces, Text synopsis:            A modern, easy to use, well-documented, extensible prettyprinter.
src/Data/Text/Prettyprint/Doc/Internal.hs view
@@ -1240,12 +1240,32 @@  -- | Remove all annotations. 'unAnnotate' for 'SimpleDocStream'. unAnnotateS :: SimpleDocStream ann -> SimpleDocStream xxx-unAnnotateS = alterAnnotationsS (const Nothing)+unAnnotateS = go+  where+    go = \case+        SFail              -> SFail+        SEmpty             -> SEmpty+        SChar c rest       -> SChar c (go rest)+        SText l t rest     -> SText l t (go rest)+        SLine l rest       -> SLine l (go rest)+        SAnnPop rest       -> go rest+        SAnnPush _ann rest -> go rest  -- | Change the annotation of a document. 'reAnnotate' for 'SimpleDocStream'. reAnnotateS :: (ann -> ann') -> SimpleDocStream ann -> SimpleDocStream ann'-reAnnotateS re = alterAnnotationsS (Just . re)+reAnnotateS re = go+  where+    go = \case+        SFail             -> SFail+        SEmpty            -> SEmpty+        SChar c rest      -> SChar c (go rest)+        SText l t rest    -> SText l t (go rest)+        SLine l rest      -> SLine l (go rest)+        SAnnPop rest      -> SAnnPop (go rest)+        SAnnPush ann rest -> SAnnPush (re ann) (go rest) +data AnnotationRemoval = Remove | DontRemove+ -- | Change the annotation of a document to a different annotation, or none at -- all. 'alterAnnotations' for 'SimpleDocStream'. --@@ -1254,19 +1274,23 @@ -- ('Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree' restores -- this flexibility again.) alterAnnotationsS :: (ann -> Maybe ann') -> SimpleDocStream ann -> SimpleDocStream ann'-alterAnnotationsS re = go+alterAnnotationsS re = go []   where-    go = \case+    -- We keep a stack of whether to remove a pop so that we can remove exactly+    -- the pops corresponding to annotations that mapped to Nothing.+    go stack = \case         SFail             -> SFail         SEmpty            -> SEmpty-        SChar c rest      -> SChar c (go rest)-        SText l t rest    -> SText l t (go rest)-        SLine l rest      -> SLine l (go rest)-        SAnnPop rest      -> SAnnPop (go rest)+        SChar c rest      -> SChar c (go stack rest)+        SText l t rest    -> SText l t (go stack rest)+        SLine l rest      -> SLine l (go stack rest)         SAnnPush ann rest -> case re ann of-            Nothing   -> go rest-            Just ann' -> SAnnPush ann' (go rest)-+            Nothing   -> go (Remove:stack) rest+            Just ann' -> SAnnPush ann' (go (DontRemove:stack) rest)+        SAnnPop rest      -> case stack of+            []                -> panicPeekedEmpty+            DontRemove:stack' -> SAnnPop (go stack' rest)+            Remove:stack'     -> go stack' rest  -- | Fusion depth parameter, used by 'fuse'. data FusionDepth =
test/Testsuite/Main.hs view
@@ -51,6 +51,8 @@     , testGroup "Regression tests"         [ testCase "layoutSmart: softline behaves like a newline (#49)"                    regressionLayoutSmartSoftline+        , testCase "alterAnnotationsS causes panic when removing annotations (#50)"+                   regressionAlterAnnotationsS         ]     ] @@ -192,3 +194,11 @@     in assertEqual "softline should be rendered as space page width is unbounded"                    (SChar 'a' (SChar ' ' (SChar 'b' SEmpty)))                    layouted++-- Removing annotations with alterAnnotationsS used to remove pushes, but not+-- pops, leading to imbalanced SimpleDocStreams.+regressionAlterAnnotationsS :: Assertion+regressionAlterAnnotationsS+  = let sdoc :: SimpleDocStream ()+        sdoc = alterAnnotationsS (const Nothing) (layoutSmart defaultLayoutOptions (annotate () "a"))+    in assertEqual "" (SChar 'a' SEmpty) sdoc