-- | A @pretty@ implementation of a pretty-printer for 'Shower'.
module Shower.Printer (ShowerDoc(SD), showerRender) where

import Data.Coerce
import qualified Text.PrettyPrint as PP

import Shower.Class

-- | A @pretty@ document, with a 'Shower' instance.
newtype ShowerDoc = SD PP.Doc

instance Shower ShowerDoc where
  showerRecord :: [ShowerComma (ShowerDoc, ShowerFieldSep, ShowerDoc)] -> ShowerDoc
showerRecord = coerce :: forall a b. Coercible a b => a -> b
coerce [ShowerComma (Doc, ShowerFieldSep, Doc)] -> Doc
showerRecord'
  showerList :: [ShowerComma ShowerDoc] -> ShowerDoc
showerList = coerce :: forall a b. Coercible a b => a -> b
coerce [ShowerComma Doc] -> Doc
showerList'
  showerTuple :: [ShowerComma ShowerDoc] -> ShowerDoc
showerTuple = coerce :: forall a b. Coercible a b => a -> b
coerce [ShowerComma Doc] -> Doc
showerTuple'
  showerStringLit :: String -> ShowerDoc
showerStringLit = coerce :: forall a b. Coercible a b => a -> b
coerce String -> Doc
showerStringLit'
  showerCharLit :: String -> ShowerDoc
showerCharLit = coerce :: forall a b. Coercible a b => a -> b
coerce String -> Doc
showerCharLit'
  showerSpace :: [ShowerDoc] -> ShowerDoc
showerSpace = coerce :: forall a b. Coercible a b => a -> b
coerce [Doc] -> Doc
showerSpace'
  showerAtom :: String -> ShowerDoc
showerAtom = coerce :: forall a b. Coercible a b => a -> b
coerce String -> Doc
showerAtom'

showerPunctuate :: (a -> PP.Doc) -> [ShowerComma a] -> [PP.Doc]
showerPunctuate :: forall a. (a -> Doc) -> [ShowerComma a] -> [Doc]
showerPunctuate a -> Doc
showerElem = [ShowerComma a] -> [Doc]
go
  where
    go :: [ShowerComma a] -> [Doc]
go [] = []
    go (ShowerCommaElement a
x : ShowerComma a
ShowerCommaSep : [ShowerComma a]
xs) =
      (a -> Doc
showerElem a
x Doc -> Doc -> Doc
PP.<> Char -> Doc
PP.char Char
',') forall a. a -> [a] -> [a]
: [ShowerComma a] -> [Doc]
go [ShowerComma a]
xs
    go (ShowerCommaElement a
x : [ShowerComma a]
xs) = a -> Doc
showerElem a
x forall a. a -> [a] -> [a]
: [ShowerComma a] -> [Doc]
go [ShowerComma a]
xs
    go (ShowerComma a
ShowerCommaSep : [ShowerComma a]
xs) = Char -> Doc
PP.char Char
',' forall a. a -> [a] -> [a]
: [ShowerComma a] -> [Doc]
go [ShowerComma a]
xs

showerRecord' :: [ShowerComma (PP.Doc, ShowerFieldSep, PP.Doc)] -> PP.Doc
showerRecord' :: [ShowerComma (Doc, ShowerFieldSep, Doc)] -> Doc
showerRecord' [ShowerComma (Doc, ShowerFieldSep, Doc)]
fields =
  Doc -> Doc
PP.braces (Int -> Doc -> Doc
PP.nest Int
2 ([ShowerComma (Doc, ShowerFieldSep, Doc)] -> Doc
showerFields [ShowerComma (Doc, ShowerFieldSep, Doc)]
fields))
  where
    showerFields :: [ShowerComma (Doc, ShowerFieldSep, Doc)] -> Doc
showerFields = [Doc] -> Doc
PP.sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Doc) -> [ShowerComma a] -> [Doc]
showerPunctuate (Doc, ShowerFieldSep, Doc) -> Doc
showerField
    showerField :: (Doc, ShowerFieldSep, Doc) -> Doc
showerField (Doc
name, ShowerFieldSep
sep, Doc
x) = Doc -> Int -> Doc -> Doc
PP.hang (Doc -> ShowerFieldSep -> Doc
ppSep Doc
name ShowerFieldSep
sep) Int
2 Doc
x
    ppSep :: Doc -> ShowerFieldSep -> Doc
ppSep Doc
name ShowerFieldSep
ShowerFieldSepEquals = Doc
name Doc -> Doc -> Doc
PP.<+> Char -> Doc
PP.char Char
'='
    ppSep Doc
name ShowerFieldSep
ShowerFieldSepColon  = Doc
name Doc -> Doc -> Doc
PP.<>  Char -> Doc
PP.char Char
':'

showerList' :: [ShowerComma PP.Doc] -> PP.Doc
showerList' :: [ShowerComma Doc] -> Doc
showerList' [ShowerComma Doc]
elements =
  Doc -> Doc
PP.brackets (Int -> Doc -> Doc
PP.nest Int
2 ([ShowerComma Doc] -> Doc
showerElements [ShowerComma Doc]
elements))
  where
    showerElements :: [ShowerComma Doc] -> Doc
showerElements = [Doc] -> Doc
PP.sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Doc) -> [ShowerComma a] -> [Doc]
showerPunctuate forall a. a -> a
id

showerTuple' :: [ShowerComma PP.Doc] -> PP.Doc
showerTuple' :: [ShowerComma Doc] -> Doc
showerTuple' [ShowerComma Doc]
elements =
  Doc -> Doc
PP.parens (Int -> Doc -> Doc
PP.nest Int
2 ([ShowerComma Doc] -> Doc
showerElements [ShowerComma Doc]
elements))
  where
    showerElements :: [ShowerComma Doc] -> Doc
showerElements = [Doc] -> Doc
PP.sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Doc) -> [ShowerComma a] -> [Doc]
showerPunctuate forall a. a -> a
id

showerSpace' :: [PP.Doc] -> PP.Doc
showerSpace' :: [Doc] -> Doc
showerSpace' (Doc
x:[Doc]
xs) = Doc -> Int -> Doc -> Doc
PP.hang Doc
x Int
2 ([Doc] -> Doc
PP.sep [Doc]
xs)
showerSpace' [Doc]
xs = [Doc] -> Doc
PP.sep [Doc]
xs

showerAtom' :: String -> PP.Doc
showerAtom' :: String -> Doc
showerAtom' = String -> Doc
PP.text

showerStringLit' :: String -> PP.Doc
showerStringLit' :: String -> Doc
showerStringLit' = Doc -> Doc
PP.doubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
PP.text

showerCharLit' :: String -> PP.Doc
showerCharLit' :: String -> Doc
showerCharLit' = Doc -> Doc
PP.quotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
PP.text

-- | Render a @ShowerDoc@ with the default style.
showerRender :: ShowerDoc -> String
showerRender :: ShowerDoc -> String
showerRender (SD Doc
showerDoc) =
  Style -> Doc -> String
PP.renderStyle Style
PP.style{ lineLength :: Int
PP.lineLength = Int
80 } Doc
showerDoc forall a. [a] -> [a] -> [a]
++ String
"\n"