Use (Data.Text.singleton ' ') to produce indentations etc

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

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
@@ -1136,7 +1132,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 " ")
+spaces n
+  | n <= 0    = Empty
+  | n == 1    = Char ' '
+  | otherwise = Text n (textSpaces n)
 
 -- $
 -- prop> \(NonNegative n) -> length (show (spaces n)) == n
@@ -1488,7 +1487,7 @@ removeTrailingWhitespace = go (RecordedWhitespace [] 0)
 
         commitSpaces 0 = id
         commitSpaces 1 = SChar ' '
-        commitSpaces n = SText n (T.replicate n " ")
+        commitSpaces n = SText n (textSpaces n)
 
     go :: WhitespaceStrippingState -> SimpleDocStream ann -> SimpleDocStream ann
     -- We do not strip whitespace inside annotated documents, since it might
@@ -1922,6 +1921,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 <https://github.com/quchen/prettyprinter/issues/131>.)
+textSpaces :: Int -> Text
+textSpaces n = T.replicate n (T.singleton ' ')
+
+
 -- $setup
 --
 -- (Definitions for the doctests)

prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs

@@ -18,13 +18,13 @@ 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 +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 (textSpaces n)
                                  go rest
         SAnnPush _ann rest -> go rest
         SAnnPop rest       -> go rest

prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs

@@ -20,11 +20,11 @@ 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 +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 (textSpaces i))
         renderStackMachine x
     SAnnPush s x -> do
         pushStyle s

prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs

@@ -15,11 +15,11 @@
 -- 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 +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 (textSpaces i)
     STAnn ann content -> encloseInTagFor ann (renderTree content)
     STConcat contents -> foldMap renderTree contents
 

prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs

@@ -32,6 +32,7 @@ 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 +76,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') `mappend` text (textSpaces i)
         STAnn ann rest -> renderAnn ann (go rest)
         STConcat xs    -> foldMap go xs
 {-# INLINE renderSimplyDecorated #-}
@@ -93,7 +94,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.cons '\n' (textSpaces i))
         STAnn ann rest -> renderAnn ann (go rest)
         STConcat xs    -> fmap mconcat (traverse go xs)
 {-# INLINE renderSimplyDecoratedA #-}

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"
 
@@ -36,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)
@@ -78,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 " ") <> 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
@@ -99,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 " ") <++> 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