{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
Module:      TextShow.Text.PrettyPrint
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

Provides 'TextShow' instances for data types in the @pretty@ library.

/Since: 2/
-}
module TextShow.Text.PrettyPrint (
      renderB
    , renderStyleB
    , renderAnnotB
    , renderStyleAnnotB
    ) where

import           Prelude ()
import           Prelude.Compat

import           Text.PrettyPrint.HughesPJ (Doc, Mode, Style(..), TextDetails(..),
                                            fullRender, style)
import           Text.PrettyPrint.HughesPJClass (PrettyLevel)
import qualified Text.PrettyPrint.Annotated.HughesPJ as Annot (Doc, fullRender, style)
import           Text.PrettyPrint.Annotated.HughesPJ (AnnotDetails, Span)
import qualified Text.PrettyPrint.Annotated.HughesPJClass as Annot (PrettyLevel)

import           TextShow (TextShow(..), TextShow1(..), Builder, fromString, singleton)
import           TextShow.TH (deriveTextShow, deriveTextShow1)

-- | Renders a 'Doc' to a 'Builder' using the default 'style'.
--
-- /Since: 2/
renderB :: Doc -> Builder
renderB :: Doc -> Builder
renderB = Style -> Doc -> Builder
renderStyleB Style
style
{-# INLINE renderB #-}

-- | Renders a 'Doc' to a 'Builder' using the given 'Style'.
--
-- /Since: 2/
renderStyleB :: Style -> Doc -> Builder
renderStyleB :: Style -> Doc -> Builder
renderStyleB Style
sty Doc
doc = forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender (Style -> Mode
mode Style
sty)
                                  (Style -> Int
lineLength Style
sty)
                                  (Style -> Float
ribbonsPerLine Style
sty)
                                  TextDetails -> Builder -> Builder
txtPrinter
                                  forall a. Monoid a => a
mempty
                                  Doc
doc
{-# INLINE renderStyleB #-}

txtPrinter :: TextDetails -> Builder -> Builder
txtPrinter :: TextDetails -> Builder -> Builder
txtPrinter (Chr Char
c)   Builder
b = Char -> Builder
singleton Char
c forall a. Semigroup a => a -> a -> a
<> Builder
b
txtPrinter (Str String
s')  Builder
b = String -> Builder
fromString String
s' forall a. Semigroup a => a -> a -> a
<> Builder
b
txtPrinter (PStr String
s') Builder
b = String -> Builder
fromString String
s' forall a. Semigroup a => a -> a -> a
<> Builder
b
{-# INLINE txtPrinter #-}

-- | Renders an annotated 'Doc' to a 'Builder' using the default 'Annot.style'.
--
-- /Since: 3/
renderAnnotB :: Annot.Doc a -> Builder
renderAnnotB :: forall a. Doc a -> Builder
renderAnnotB = forall a. Style -> Doc a -> Builder
renderStyleAnnotB Style
Annot.style
{-# INLINE renderAnnotB #-}

-- | Renders an annotated 'Doc' to a 'Builder' using the given 'Style'.
--
-- /Since: 3/
renderStyleAnnotB :: Style -> Annot.Doc a -> Builder
renderStyleAnnotB :: forall a. Style -> Doc a -> Builder
renderStyleAnnotB Style
sty Doc a
doc =
    forall a b.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc b -> a
Annot.fullRender (Style -> Mode
mode Style
sty)
                     (Style -> Int
lineLength Style
sty)
                     (Style -> Float
ribbonsPerLine Style
sty)
                     TextDetails -> Builder -> Builder
txtPrinter
                     forall a. Monoid a => a
mempty
                     Doc a
doc

-- | /Since: 2/
instance TextShow Doc where
    showb :: Doc -> Builder
showb = Doc -> Builder
renderB
    {-# INLINE showb #-}

-- | /Since: 2/
$(deriveTextShow ''Mode)
-- | /Since: 2/
$(deriveTextShow ''Style)
-- | /Since: 2/
$(deriveTextShow ''TextDetails)
-- | /Since: 2/
$(deriveTextShow ''PrettyLevel)

-- | /Since: 3/
$(deriveTextShow  ''AnnotDetails)
-- | /Since: 3/
$(deriveTextShow1 ''AnnotDetails)

-- | /Since: 3/
instance TextShow (Annot.Doc a) where
    showb :: Doc a -> Builder
showb = forall a. Doc a -> Builder
renderAnnotB
    {-# INLINE showb #-}
-- | /Since: 3/
instance TextShow1 Annot.Doc where
    liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> Doc a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
_ = forall a. TextShow a => Int -> a -> Builder
showbPrec
    {-# INLINE liftShowbPrec #-}

-- | /Since: 3/
$(deriveTextShow ''Annot.PrettyLevel)

-- | /Since: 3/
$(deriveTextShow  ''Span)
-- | /Since: 3/
$(deriveTextShow1 ''Span)