prettyprinter 1.2 → 1.2.0.1
raw patch · 3 files changed
+46/−12 lines, 3 files
Files
- prettyprinter.cabal +1/−1
- src/Data/Text/Prettyprint/Doc/Internal.hs +35/−11
- test/Testsuite/Main.hs +10/−0
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