{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module TextShow.Text.PrettyPrint (
renderB
, renderStyleB
#if MIN_VERSION_pretty(1,1,3)
, renderAnnotB
, renderStyleAnnotB
#endif
) where
import Prelude ()
import Prelude.Compat
import Text.PrettyPrint.HughesPJ (Doc, Mode, Style(..), TextDetails(..),
fullRender, style)
#if MIN_VERSION_pretty(1,1,2)
import Text.PrettyPrint.HughesPJClass (PrettyLevel)
#endif
#if MIN_VERSION_pretty(1,1,3)
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 (TextShow1(..))
import TextShow.TH (deriveTextShow1)
#endif
import TextShow (TextShow(..), Builder, fromString, singleton)
import TextShow.TH (deriveTextShow)
renderB :: Doc -> Builder
renderB :: Doc -> Builder
renderB = Style -> Doc -> Builder
renderStyleB Style
style
{-# INLINE renderB #-}
renderStyleB :: Style -> Doc -> Builder
renderStyleB :: Style -> Doc -> Builder
renderStyleB Style
sty Doc
doc = Mode
-> Int
-> Float
-> (TextDetails -> Builder -> Builder)
-> Builder
-> Doc
-> Builder
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
Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
txtPrinter (Str String
s') Builder
b = String -> Builder
fromString String
s' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
txtPrinter (PStr String
s') Builder
b = String -> Builder
fromString String
s' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
{-# INLINE txtPrinter #-}
#if MIN_VERSION_pretty(1,1,3)
renderAnnotB :: Annot.Doc a -> Builder
renderAnnotB :: Doc a -> Builder
renderAnnotB = Style -> Doc a -> Builder
forall a. Style -> Doc a -> Builder
renderStyleAnnotB Style
Annot.style
{-# INLINE renderAnnotB #-}
renderStyleAnnotB :: Style -> Annot.Doc a -> Builder
renderStyleAnnotB :: Style -> Doc a -> Builder
renderStyleAnnotB Style
sty Doc a
doc =
Mode
-> Int
-> Float
-> (TextDetails -> Builder -> Builder)
-> Builder
-> Doc a
-> Builder
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
Builder
forall a. Monoid a => a
mempty
Doc a
doc
#endif
instance TextShow Doc where
showb :: Doc -> Builder
showb = Doc -> Builder
renderB
{-# INLINE showb #-}
$(deriveTextShow ''Mode)
$(deriveTextShow ''Style)
$(deriveTextShow ''TextDetails)
#if MIN_VERSION_pretty(1,1,2)
$(deriveTextShow ''PrettyLevel)
#endif
#if MIN_VERSION_pretty(1,1,3)
$(deriveTextShow ''AnnotDetails)
$(deriveTextShow1 ''AnnotDetails)
instance TextShow (Annot.Doc a) where
showb :: Doc a -> Builder
showb = Doc a -> Builder
forall a. Doc a -> Builder
renderAnnotB
{-# INLINE showb #-}
instance TextShow1 Annot.Doc where
liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> Doc a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
_ = Int -> Doc a -> Builder
forall a. TextShow a => Int -> a -> Builder
showbPrec
{-# INLINE liftShowbPrec #-}
$(deriveTextShow ''Annot.PrettyLevel)
$(deriveTextShow ''Span)
$(deriveTextShow1 ''Span)
#endif