{-# LANGUAGE OverloadedStrings #-}
module Data.SExpresso.Print.Lazy (
SExprPrinter(..),
mkPrinter,
flatPrint,
flatPrintBuilder
) where
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B
import Data.SExpresso.SExpr
data SExprPrinter b a = SExprPrinter {
SExprPrinter b a -> b -> [SExpr b a] -> (Text, Text)
printTags :: b -> [SExpr b a] -> (T.Text, T.Text),
SExprPrinter b a -> a -> Text
printAtom :: a -> T.Text
}
mkPrinter :: (a -> T.Text) -> SExprPrinter b a
mkPrinter :: (a -> Text) -> SExprPrinter b a
mkPrinter a -> Text
p = (b -> [SExpr b a] -> (Text, Text))
-> (a -> Text) -> SExprPrinter b a
forall b a.
(b -> [SExpr b a] -> (Text, Text))
-> (a -> Text) -> SExprPrinter b a
SExprPrinter (\b
_ [SExpr b a]
_ -> (Text
"(", Text
")")) a -> Text
p
flatPrintBuilder :: SExprPrinter b a -> SExpr b a -> B.Builder
flatPrintBuilder :: SExprPrinter b a -> SExpr b a -> Builder
flatPrintBuilder SExprPrinter b a
p (SAtom a
a) = Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ SExprPrinter b a -> a -> Text
forall b a. SExprPrinter b a -> a -> Text
printAtom SExprPrinter b a
p a
a
flatPrintBuilder SExprPrinter b a
p (SList b
b [SExpr b a]
xs) =
let (Text
sTag, Text
eTag) = SExprPrinter b a -> b -> [SExpr b a] -> (Text, Text)
forall b a. SExprPrinter b a -> b -> [SExpr b a] -> (Text, Text)
printTags SExprPrinter b a
p b
b [SExpr b a]
xs
in Text -> Builder
B.fromText Text
sTag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SExpr b a] -> Builder
flatPrintList [SExpr b a]
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
eTag
where flatPrintList :: [SExpr b a] -> Builder
flatPrintList [] = Text -> Builder
B.fromText Text
""
flatPrintList [SExpr b a
x] = SExprPrinter b a -> SExpr b a -> Builder
forall b a. SExprPrinter b a -> SExpr b a -> Builder
flatPrintBuilder SExprPrinter b a
p SExpr b a
x
flatPrintList (SExpr b a
y : [SExpr b a]
ys) = SExprPrinter b a -> SExpr b a -> Builder
forall b a. SExprPrinter b a -> SExpr b a -> Builder
flatPrintBuilder SExprPrinter b a
p SExpr b a
y Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SExpr b a] -> Builder
flatPrintList [SExpr b a]
ys
flatPrint :: SExprPrinter b a -> SExpr b a -> L.Text
flatPrint :: SExprPrinter b a -> SExpr b a -> Text
flatPrint SExprPrinter b a
p SExpr b a
s = Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ SExprPrinter b a -> SExpr b a -> Builder
forall b a. SExprPrinter b a -> SExpr b a -> Builder
flatPrintBuilder SExprPrinter b a
p SExpr b a
s