-- |
-- Module      :  Data.SExpresso.Print.Lazy
-- Copyright   :  © 2019 Vincent Archambault
-- License     :  0BSD
--
-- Maintainer  :  Vincent Archambault <archambault.v@gmail.com>
-- Stability   :  experimental
--
-- Printing 'SExpr' as 'Data.Text.Lazy'. To print as strict text
-- ("Data.Text") see "Data.Sexpresso.Print"

{-# 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

-- | The 'SExprPrinter' defines how to print an 'SExpr'.
data SExprPrinter b a = SExprPrinter {
  -- | The opening and closing tags based on the content of the 'SList'
  SExprPrinter b a -> b -> [SExpr b a] -> (Text, Text)
printTags :: b -> [SExpr b a] -> (T.Text, T.Text),
  -- | How to print an atom
  SExprPrinter b a -> a -> Text
printAtom :: a -> T.Text
  }

-- | An 'SExprPrinter' with the opening tag defined as '(' and the
-- closing tag defined as ')'
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

-- | Prints an 'SExpr' on a single line. Returns a 'B.Builder' instead of a lazy text 'L.Text'
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

-- | Prints an 'SExpr' on a single line
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