{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
#include "version-compatibility-macros.h"
module Data.Text.Prettyprint.Doc.Render.Text (
renderLazy, renderStrict,
renderIO,
putDoc, hPutDoc
) where
import Data.Text (Text)
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
#if !(SEMIGROUP_IN_BASE)
import Data.Semigroup
#endif
#if !(APPLICATIVE_MONAD)
import Control.Applicative
#endif
renderLazy :: SimpleDocStream ann -> TL.Text
renderLazy :: SimpleDocStream ann -> Text
renderLazy = Builder -> Text
TLB.toLazyText (Builder -> Text)
-> (SimpleDocStream ann -> Builder) -> SimpleDocStream ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> Builder
forall ann. SimpleDocStream ann -> Builder
go
where
go :: SimpleDocStream ann -> Builder
go = \case
SFail -> Builder
forall void. void
panicUncaughtFail
SEmpty -> Builder
forall a. Monoid a => a
mempty
SChar c :: Char
c rest :: SimpleDocStream ann
rest -> Char -> Builder
TLB.singleton Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SimpleDocStream ann -> Builder
go SimpleDocStream ann
rest
SText _l :: Int
_l t :: Text
t rest :: SimpleDocStream ann
rest -> Text -> Builder
TLB.fromText Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SimpleDocStream ann -> Builder
go SimpleDocStream ann
rest
SLine i :: Int
i rest :: SimpleDocStream ann
rest -> Char -> Builder
TLB.singleton '\n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
TLB.fromText (Int -> Text
textSpaces Int
i) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SimpleDocStream ann -> Builder
go SimpleDocStream ann
rest)
SAnnPush _ann :: ann
_ann rest :: SimpleDocStream ann
rest -> SimpleDocStream ann -> Builder
go SimpleDocStream ann
rest
SAnnPop rest :: SimpleDocStream ann
rest -> SimpleDocStream ann -> Builder
go SimpleDocStream ann
rest
renderStrict :: SimpleDocStream ann -> Text
renderStrict :: SimpleDocStream ann -> Text
renderStrict = Text -> Text
TL.toStrict (Text -> Text)
-> (SimpleDocStream ann -> Text) -> SimpleDocStream ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy
renderIO :: Handle -> SimpleDocStream ann -> IO ()
renderIO :: Handle -> SimpleDocStream ann -> IO ()
renderIO h :: Handle
h = SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go
where
go :: SimpleDocStream ann -> IO ()
go :: SimpleDocStream ann -> IO ()
go = \sds :: SimpleDocStream ann
sds -> case SimpleDocStream ann
sds of
SFail -> IO ()
forall void. void
panicUncaughtFail
SEmpty -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
SChar c :: Char
c rest :: SimpleDocStream ann
rest -> do Handle -> Char -> IO ()
hPutChar Handle
h Char
c
SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDocStream ann
rest
SText _ t :: Text
t rest :: SimpleDocStream ann
rest -> do Handle -> Text -> IO ()
T.hPutStr Handle
h Text
t
SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDocStream ann
rest
SLine n :: Int
n rest :: SimpleDocStream ann
rest -> do Handle -> Char -> IO ()
hPutChar Handle
h '\n'
Handle -> Text -> IO ()
T.hPutStr Handle
h (Int -> Text
textSpaces Int
n)
SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDocStream ann
rest
SAnnPush _ann :: ann
_ann rest :: SimpleDocStream ann
rest -> SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDocStream ann
rest
SAnnPop rest :: SimpleDocStream ann
rest -> SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDocStream ann
rest
putDoc :: Doc ann -> IO ()
putDoc :: Doc ann -> IO ()
putDoc = Handle -> Doc ann -> IO ()
forall ann. Handle -> Doc ann -> IO ()
hPutDoc Handle
stdout
hPutDoc :: Handle -> Doc ann -> IO ()
hPutDoc :: Handle -> Doc ann -> IO ()
hPutDoc h :: Handle
h doc :: Doc ann
doc = Handle -> SimpleDocStream ann -> IO ()
forall ann. Handle -> SimpleDocStream ann -> IO ()
renderIO Handle
h (LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Doc ann
doc)