From 0e0e861c8ec4c489e5c513992e0bc71648b1aea3 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Fri, 24 Jan 2020 23:05:56 +0100 Subject: [PATCH 01/10] Use (Data.Text.singleton ' ') to produce indentations etc Much smaller Core! --- .../src/Data/Text/Prettyprint/Doc/Render/Terminal/Internal.hs | 4 ++-- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 4 ++-- prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs | 2 +- .../Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs | 2 +- .../Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs | 2 +- .../Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs | 4 ++-- .../src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs | 4 ++-- 7 files changed, 11 insertions(+), 11 deletions(-) diff --git a/prettyprinter-ansi-terminal/src/Data/Text/Prettyprint/Doc/Render/Terminal/Internal.hs b/prettyprinter-ansi-terminal/src/Data/Text/Prettyprint/Doc/Render/Terminal/Internal.hs index 2093328b..3819a295 100644 --- a/prettyprinter-ansi-terminal/src/Data/Text/Prettyprint/Doc/Render/Terminal/Internal.hs +++ b/prettyprinter-ansi-terminal/src/Data/Text/Prettyprint/Doc/Render/Terminal/Internal.hs @@ -142,7 +142,7 @@ renderLazy sdoc = runST (do writeOutput (TLB.fromText t) go rest SLine i rest -> do - writeOutput (TLB.singleton '\n' <> TLB.fromText (T.replicate i " ")) + writeOutput (TLB.singleton '\n' <> TLB.fromText (T.replicate i (T.singleton ' '))) go rest SAnnPush style rest -> do currentStyle <- unsafePeek @@ -204,7 +204,7 @@ renderIO h sdoc = do go rest SLine i rest -> do hPutChar h '\n' - T.hPutStr h (T.replicate i " ") + T.hPutStr h (T.replicate i (T.singleton ' ')) go rest SAnnPush style rest -> do currentStyle <- unsafePeek diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 74914b39..c84ab3c9 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -1136,7 +1136,7 @@ fillBreak f x = width x (\w -> -- | Insert a number of spaces. Negative values count as 0. spaces :: Int -> Doc ann -spaces n = unsafeTextWithoutNewlines (T.replicate n " ") +spaces n = unsafeTextWithoutNewlines (T.replicate n (T.singleton ' ')) -- constructing, then destructing a Text is stupid! -- $ -- prop> \(NonNegative n) -> length (show (spaces n)) == n @@ -1488,7 +1488,7 @@ removeTrailingWhitespace = go (RecordedWhitespace [] 0) commitSpaces 0 = id commitSpaces 1 = SChar ' ' - commitSpaces n = SText n (T.replicate n " ") + commitSpaces n = SText n (T.replicate n (T.singleton ' ')) go :: WhitespaceStrippingState -> SimpleDocStream ann -> SimpleDocStream ann -- We do not strip whitespace inside annotated documents, since it might diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs index f6513154..3055a4d5 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs @@ -86,7 +86,7 @@ renderIO h = go SText _ t rest -> do T.hPutStr h t go rest SLine n rest -> do hPutChar h '\n' - T.hPutStr h (T.replicate n " ") + T.hPutStr h (T.replicate n (T.singleton ' ')) go rest SAnnPush _ann rest -> go rest SAnnPop rest -> go rest diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs index 9c5a61cc..2c56528a 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs @@ -92,7 +92,7 @@ renderStackMachine = \sds -> case sds of renderStackMachine x SLine i x -> do writeOutput (TLB.singleton '\n') - writeOutput (TLB.fromText (T.replicate i " ")) + writeOutput (TLB.fromText (T.replicate i (T.singleton ' '))) renderStackMachine x SAnnPush s x -> do pushStyle s diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs index 8ce77b7c..b3a8f091 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs @@ -87,7 +87,7 @@ renderTree sds = case sds of STEmpty -> mempty STChar c -> TLB.singleton c STText _ t -> TLB.fromText t - STLine i -> "\n" <> TLB.fromText (T.replicate i " ") + STLine i -> "\n" <> TLB.fromText (T.replicate i (T.singleton ' ')) STAnn ann content -> encloseInTagFor ann (renderTree content) STConcat contents -> foldMap renderTree contents diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs index db310e4a..cf6151f3 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs @@ -75,7 +75,7 @@ renderSimplyDecorated text renderAnn = go STEmpty -> mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n' <> T.replicate i " ") + STLine i -> text (T.singleton '\n' <> T.replicate i (T.singleton ' ')) -- don't cat texts! STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> foldMap go xs {-# INLINE renderSimplyDecorated #-} @@ -93,7 +93,7 @@ renderSimplyDecoratedA text renderAnn = go STEmpty -> pure mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n' <> T.replicate i " ") + STLine i -> text (T.singleton '\n' <> T.replicate i (T.singleton ' ')) -- don't cat texts! STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> fmap mconcat (traverse go xs) {-# INLINE renderSimplyDecoratedA #-} diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs index 054ef059..85521760 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs @@ -78,7 +78,7 @@ renderSimplyDecorated text push pop = go [] go (_:_) SEmpty = panicInputNotFullyConsumed go stack (SChar c rest) = text (T.singleton c) <> go stack rest go stack (SText _l t rest) = text t <> go stack rest - go stack (SLine i rest) = text (T.singleton '\n') <> text (T.replicate i " ") <> go stack rest + go stack (SLine i rest) = text (T.singleton '\n') <> text (T.replicate i (T.singleton ' ')) <> go stack rest go stack (SAnnPush ann rest) = push ann <> go (ann : stack) rest go (ann:stack) (SAnnPop rest) = pop ann <> go stack rest go [] SAnnPop{} = panicUnpairedPop @@ -99,7 +99,7 @@ renderSimplyDecoratedA text push pop = go [] go (_:_) SEmpty = panicInputNotFullyConsumed go stack (SChar c rest) = text (T.singleton c) <++> go stack rest go stack (SText _l t rest) = text t <++> go stack rest - go stack (SLine i rest) = text (T.singleton '\n') <++> text (T.replicate i " ") <++> go stack rest + go stack (SLine i rest) = text (T.singleton '\n') <++> text (T.replicate i (T.singleton ' ')) <++> go stack rest go stack (SAnnPush ann rest) = push ann <++> go (ann : stack) rest go (ann:stack) (SAnnPop rest) = pop ann <++> go stack rest go [] SAnnPop{} = panicUnpairedPop From 460e0123c9735bc995d42fd4156e2195a98c84be Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 01:28:33 +0100 Subject: [PATCH 02/10] Remove redundant pragma --- .../src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs index 85521760..5c2be355 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs @@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} #include "version-compatibility-macros.h" From 2b499d458e7533ac09dbd4154543169b692809fb Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 01:42:41 +0100 Subject: [PATCH 03/10] Improve `spaces` --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index c84ab3c9..2c99178e 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -1136,7 +1136,10 @@ fillBreak f x = width x (\w -> -- | Insert a number of spaces. Negative values count as 0. spaces :: Int -> Doc ann -spaces n = unsafeTextWithoutNewlines (T.replicate n (T.singleton ' ')) -- constructing, then destructing a Text is stupid! +spaces n + | n <= 0 = Empty + | n == 1 = Char ' ' + | otherwise = Text n (T.replicate n (T.singleton ' ')) -- $ -- prop> \(NonNegative n) -> length (show (spaces n)) == n From c014d65018ee6b1d950a8b4f286436cc2c9a5ba5 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 01:49:11 +0100 Subject: [PATCH 04/10] Improve SimpleDocTree.renderSimplyDecorated[A] --- .../Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs index cf6151f3..2ee4aac3 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs @@ -75,7 +75,7 @@ renderSimplyDecorated text renderAnn = go STEmpty -> mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n' <> T.replicate i (T.singleton ' ')) -- don't cat texts! + STLine i -> text (T.singleton '\n') <> text (T.replicate i (T.singleton ' ')) STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> foldMap go xs {-# INLINE renderSimplyDecorated #-} @@ -93,7 +93,7 @@ renderSimplyDecoratedA text renderAnn = go STEmpty -> pure mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n' <> T.replicate i (T.singleton ' ')) -- don't cat texts! + STLine i -> text (T.cons '\n' (T.replicate i (T.singleton ' '))) STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> fmap mconcat (traverse go xs) {-# INLINE renderSimplyDecoratedA #-} From 862d6e08cdbaa8a722fe7b1941290439175a8727 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 02:13:05 +0100 Subject: [PATCH 05/10] Add a dedicated `textSpaces` helper --- .../src/Data/Text/Prettyprint/Doc/Internal.hs | 18 ++++++++++++++++-- .../Data/Text/Prettyprint/Doc/Render/Text.hs | 5 ++--- .../Render/Tutorials/StackMachineTutorial.hs | 5 ++--- .../Render/Tutorials/TreeRenderingTutorial.hs | 5 ++--- .../Doc/Render/Util/SimpleDocTree.hs | 6 +++--- .../Doc/Render/Util/StackMachine.hs | 6 +++--- 6 files changed, 28 insertions(+), 17 deletions(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 2c99178e..e1740f5b 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -1139,7 +1139,7 @@ spaces :: Int -> Doc ann spaces n | n <= 0 = Empty | n == 1 = Char ' ' - | otherwise = Text n (T.replicate n (T.singleton ' ')) + | otherwise = Text n (textSpaces n) -- $ -- prop> \(NonNegative n) -> length (show (spaces n)) == n @@ -1491,7 +1491,7 @@ removeTrailingWhitespace = go (RecordedWhitespace [] 0) commitSpaces 0 = id commitSpaces 1 = SChar ' ' - commitSpaces n = SText n (T.replicate n (T.singleton ' ')) + commitSpaces n = SText n (textSpaces n) go :: WhitespaceStrippingState -> SimpleDocStream ann -> SimpleDocStream ann -- We do not strip whitespace inside annotated documents, since it might @@ -1925,6 +1925,20 @@ renderShowS = \sds -> case sds of SAnnPop x -> renderShowS x +-- | A utility for producing indentation etc. +-- +-- >>> textSpaces 3 +-- " " +-- +-- This produces much better Core than the equivalent +-- +-- > T.replicate n " " +-- +-- (See .) +textSpaces :: Int -> Text +textSpaces n = T.replicate n (T.singleton ' ') + + -- $setup -- -- (Definitions for the doctests) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs index 3055a4d5..ff8065ad 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs @@ -18,13 +18,12 @@ module Data.Text.Prettyprint.Doc.Render.Text ( import Data.Text (Text) -import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import System.IO -import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic import Data.Text.Prettyprint.Doc.Render.Util.StackMachine @@ -86,7 +85,7 @@ renderIO h = go SText _ t rest -> do T.hPutStr h t go rest SLine n rest -> do hPutChar h '\n' - T.hPutStr h (T.replicate n (T.singleton ' ')) + T.hPutStr h (textSpaces n) go rest SAnnPush _ann rest -> go rest SAnnPop rest -> go rest diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs index 2c56528a..56dc5d14 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs @@ -20,11 +20,10 @@ module Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial {-# DEPRECATED "Writing your own stack machine is probably more efficient and customizable; also consider using »renderSimplyDecorated(A)« instead" #-} where -import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB -import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic import Data.Text.Prettyprint.Doc.Render.Util.StackMachine @@ -92,7 +91,7 @@ renderStackMachine = \sds -> case sds of renderStackMachine x SLine i x -> do writeOutput (TLB.singleton '\n') - writeOutput (TLB.fromText (T.replicate i (T.singleton ' '))) + writeOutput (TLB.fromText (textSpaces i)) renderStackMachine x SAnnPush s x -> do pushStyle s diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs index b3a8f091..2d644b2d 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs @@ -15,11 +15,10 @@ -- source form. module Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial where -import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB -import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree #if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE) @@ -87,7 +86,7 @@ renderTree sds = case sds of STEmpty -> mempty STChar c -> TLB.singleton c STText _ t -> TLB.fromText t - STLine i -> "\n" <> TLB.fromText (T.replicate i (T.singleton ' ')) + STLine i -> "\n" <> TLB.fromText (textSpaces i) STAnn ann content -> encloseInTagFor ann (renderTree content) STConcat contents -> foldMap renderTree contents diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs index 2ee4aac3..10ad9b93 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs @@ -31,7 +31,7 @@ import qualified Data.Text as T import Data.Typeable (Typeable) import GHC.Generics -import Data.Text.Prettyprint.Doc +import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic import qualified Control.Monad.Fail as Fail @@ -75,7 +75,7 @@ renderSimplyDecorated text renderAnn = go STEmpty -> mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n') <> text (T.replicate i (T.singleton ' ')) + STLine i -> text (T.singleton '\n') <> text (textSpaces i) STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> foldMap go xs {-# INLINE renderSimplyDecorated #-} @@ -93,7 +93,7 @@ renderSimplyDecoratedA text renderAnn = go STEmpty -> pure mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.cons '\n' (T.replicate i (T.singleton ' '))) + STLine i -> text (T.cons '\n' (textSpaces i)) STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> fmap mconcat (traverse go xs) {-# INLINE renderSimplyDecoratedA #-} diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs index 5c2be355..e26ee2c2 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs @@ -35,7 +35,7 @@ import Control.Applicative import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Prettyprint.Doc (SimpleDocStream (..)) +import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic #if !(SEMIGROUP_MONOID_SUPERCLASS) @@ -77,7 +77,7 @@ renderSimplyDecorated text push pop = go [] go (_:_) SEmpty = panicInputNotFullyConsumed go stack (SChar c rest) = text (T.singleton c) <> go stack rest go stack (SText _l t rest) = text t <> go stack rest - go stack (SLine i rest) = text (T.singleton '\n') <> text (T.replicate i (T.singleton ' ')) <> go stack rest + go stack (SLine i rest) = text (T.singleton '\n') <> text (textSpaces i) <> go stack rest go stack (SAnnPush ann rest) = push ann <> go (ann : stack) rest go (ann:stack) (SAnnPop rest) = pop ann <> go stack rest go [] SAnnPop{} = panicUnpairedPop @@ -98,7 +98,7 @@ renderSimplyDecoratedA text push pop = go [] go (_:_) SEmpty = panicInputNotFullyConsumed go stack (SChar c rest) = text (T.singleton c) <++> go stack rest go stack (SText _l t rest) = text t <++> go stack rest - go stack (SLine i rest) = text (T.singleton '\n') <++> text (T.replicate i (T.singleton ' ')) <++> go stack rest + go stack (SLine i rest) = text (T.singleton '\n') <++> text (textSpaces i) <++> go stack rest go stack (SAnnPush ann rest) = push ann <++> go (ann : stack) rest go (ann:stack) (SAnnPop rest) = pop ann <++> go stack rest go [] SAnnPop{} = panicUnpairedPop From a29d09d1d1833209da1b3fbc6e7728c4119c1336 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 02:16:34 +0100 Subject: [PATCH 06/10] Fix URL --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index e1740f5b..738bf37b 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -1934,7 +1934,7 @@ renderShowS = \sds -> case sds of -- -- > T.replicate n " " -- --- (See .) +-- (See .) textSpaces :: Int -> Text textSpaces n = T.replicate n (T.singleton ' ') From af0864df7c97a5b894df132c721b141bb07ab551 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 02:26:03 +0100 Subject: [PATCH 07/10] Try to fix warnings --- prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs | 4 ---- .../Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs | 1 + .../Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs | 3 ++- 3 files changed, 3 insertions(+), 5 deletions(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 738bf37b..1bde279d 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -46,10 +46,6 @@ import Data.Traversable (Traversable (..)) import Prelude hiding (foldr, foldr1) #endif -#if !(MONOID_IN_PRELUDE) -import Data.Monoid hiding ((<>)) -#endif - #if FUNCTOR_IDENTITY_IN_BASE import Data.Functor.Identity #endif diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs index 56dc5d14..4be55dac 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs @@ -23,6 +23,7 @@ module Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB +import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic import Data.Text.Prettyprint.Doc.Render.Util.StackMachine diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs index 10ad9b93..bcf4e71c 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs @@ -31,6 +31,7 @@ import qualified Data.Text as T import Data.Typeable (Typeable) import GHC.Generics +import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic @@ -75,7 +76,7 @@ renderSimplyDecorated text renderAnn = go STEmpty -> mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n') <> text (textSpaces i) + STLine i -> text (T.singleton '\n') `mappend` text (textSpaces i) STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> foldMap go xs {-# INLINE renderSimplyDecorated #-} From 253be0ad8eb9fbdca43071ff5c855e0f80236995 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 04:06:30 +0100 Subject: [PATCH 08/10] Fix doctests --- prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs | 1 + .../Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs index ff8065ad..c0d78b4d 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs @@ -23,6 +23,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import System.IO +import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic import Data.Text.Prettyprint.Doc.Render.Util.StackMachine diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs index 2d644b2d..d3f5cbef 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs @@ -18,6 +18,7 @@ module Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial where import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB +import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree From 7101de96f13623584bfd694dd833b49f1bf90133 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 04:08:13 +0100 Subject: [PATCH 09/10] Undo mappend --- .../src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs index bcf4e71c..e78781b9 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs @@ -76,7 +76,7 @@ renderSimplyDecorated text renderAnn = go STEmpty -> mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n') `mappend` text (textSpaces i) + STLine i -> text (T.singleton '\n') <> text (textSpaces i) STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> foldMap go xs {-# INLINE renderSimplyDecorated #-} From 275dec526c4504ec2375627e15a65fa884a7017b Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Sat, 25 Jan 2020 04:20:00 +0100 Subject: [PATCH 10/10] Revert "Undo mappend" This reverts commit 7101de96f13623584bfd694dd833b49f1bf90133. --- .../src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs index e78781b9..bcf4e71c 100644 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs @@ -76,7 +76,7 @@ renderSimplyDecorated text renderAnn = go STEmpty -> mempty STChar c -> text (T.singleton c) STText _ t -> text t - STLine i -> text (T.singleton '\n') <> text (textSpaces i) + STLine i -> text (T.singleton '\n') `mappend` text (textSpaces i) STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> foldMap go xs {-# INLINE renderSimplyDecorated #-}