{-# LANGUAGE CPP               #-}

#include "version-compatibility-macros.h"

-- | Render an unannotated 'SimpleDocStream' as plain 'Text'.
module Prettyprinter.Render.Text (
#ifdef MIN_VERSION_text
    -- * Conversion to plain 'Text'
    renderLazy, renderStrict,
#endif

    -- * Render to a 'Handle'
    renderIO,

    -- ** Convenience functions
    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 Prettyprinter
import Prettyprinter.Internal
import Prettyprinter.Render.Util.Panic

#if !(SEMIGROUP_IN_BASE)
import Data.Semigroup
#endif

#if !(APPLICATIVE_MONAD)
import Control.Applicative
#endif

-- $setup
--
-- (Definitions for the doctests)
--
-- >>> :set -XOverloadedStrings
-- >>> import qualified Data.Text.IO as T
-- >>> import qualified Data.Text.Lazy.IO as TL



-- | @('renderLazy' sdoc)@ takes the output @sdoc@ from a rendering function
-- and transforms it to lazy text.
--
-- >>> let render = TL.putStrLn . renderLazy . layoutPretty defaultLayoutOptions
-- >>> let doc = "lorem" <+> align (vsep ["ipsum dolor", parens "foo bar", "sit amet"])
-- >>> render doc
-- lorem ipsum dolor
--       (foo bar)
--       sit amet
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 SimpleDocStream ann
x = case SimpleDocStream ann
x of
        SimpleDocStream ann
SFail              -> Builder
forall void. void
panicUncaughtFail
        SimpleDocStream ann
SEmpty             -> Builder
forall a. Monoid a => a
mempty
        SChar Char
c 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 Int
_l Text
t 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 Int
i SimpleDocStream ann
rest       -> Char -> Builder
TLB.singleton Char
'\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 SimpleDocStream ann
rest -> SimpleDocStream ann -> Builder
go SimpleDocStream ann
rest
        SAnnPop SimpleDocStream ann
rest       -> SimpleDocStream ann -> Builder
go SimpleDocStream ann
rest

-- | @('renderStrict' sdoc)@ takes the output @sdoc@ from a rendering function
-- and transforms it to strict text.
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' h sdoc)@ writes @sdoc@ to the file @h@.
--
-- >>> renderIO System.IO.stdout (layoutPretty defaultLayoutOptions "hello\nworld")
-- hello
-- world
--
-- This function is more efficient than @'T.hPutStr' h ('renderStrict' sdoc)@,
-- since it writes to the handle directly, skipping the intermediate 'Text'
-- representation.
renderIO :: Handle -> SimpleDocStream ann -> IO ()
renderIO :: Handle -> SimpleDocStream ann -> IO ()
renderIO Handle
h = SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go
  where
    go :: SimpleDocStream ann -> IO ()
    go :: SimpleDocStream ann -> IO ()
go = \SimpleDocStream ann
sds -> case SimpleDocStream ann
sds of
        SimpleDocStream ann
SFail              -> IO ()
forall void. void
panicUncaughtFail
        SimpleDocStream ann
SEmpty             -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        SChar Char
c 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 Int
_ Text
t 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 Int
n SimpleDocStream ann
rest       -> do Handle -> Char -> IO ()
hPutChar Handle
h Char
'\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 SimpleDocStream ann
rest -> SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDocStream ann
rest
        SAnnPop SimpleDocStream ann
rest       -> SimpleDocStream ann -> IO ()
forall ann. SimpleDocStream ann -> IO ()
go SimpleDocStream ann
rest

-- | @('putDoc' doc)@ prettyprints document @doc@ to standard output. Uses the
-- 'defaultLayoutOptions'.
--
-- >>> putDoc ("hello" <+> "world")
-- hello world
--
-- @
-- 'putDoc' = 'hPutDoc' 'stdout'
-- @
putDoc :: Doc ann -> IO ()
putDoc :: Doc ann -> IO ()
putDoc = Handle -> Doc ann -> IO ()
forall ann. Handle -> Doc ann -> IO ()
hPutDoc Handle
stdout

-- | Like 'putDoc', but instead of using 'stdout', print to a user-provided
-- handle, e.g. a file or a socket. Uses the 'defaultLayoutOptions'.
--
-- @
-- main = 'withFile' filename (\h -> 'hPutDoc' h doc)
--   where
--     doc = 'vcat' ["vertical", "text"]
--     filename = "someFile.txt"
-- @
--
-- @
-- 'hPutDoc' h doc = 'renderIO' h ('layoutPretty' 'defaultLayoutOptions' doc)
-- @
hPutDoc :: Handle -> Doc ann -> IO ()
hPutDoc :: Handle -> Doc ann -> IO ()
hPutDoc Handle
h 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)