{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
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)
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 = 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 #-}
renderAnnotB :: Annot.Doc a -> Builder
renderAnnotB :: forall a. Doc a -> Builder
renderAnnotB = forall a. Style -> Doc a -> Builder
renderStyleAnnotB Style
Annot.style
{-# INLINE renderAnnotB #-}
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
instance TextShow Doc where
showb :: Doc -> Builder
showb = Doc -> Builder
renderB
{-# INLINE showb #-}
$(deriveTextShow ''Mode)
$(deriveTextShow ''Style)
$(deriveTextShow ''TextDetails)
$(deriveTextShow ''PrettyLevel)
$(deriveTextShow ''AnnotDetails)
$(deriveTextShow1 ''AnnotDetails)
instance TextShow (Annot.Doc a) where
showb :: Doc a -> Builder
showb = forall a. Doc a -> Builder
renderAnnotB
{-# INLINE showb #-}
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 #-}
$(deriveTextShow ''Annot.PrettyLevel)
$(deriveTextShow ''Span)
$(deriveTextShow1 ''Span)