{-# LANGUAGE OverloadedStrings    #-}

-- | Wrapper around `Data.Text.Builder` that exports some useful combinators

module Language.Fixpoint.Utils.Builder
  ( Builder
  , fromLazyText
  , fromString
  , fromText
  , toLazyText
  , parens
  , (<+>)
  , parenSeqs
  , seqs
  , key
  , key2
  , key3
  , bShow
  , bFloat
  , bb
  , lbb
  , blt
  ) where

import           Data.String
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy         as LT
import qualified Data.Text              as T
import qualified Data.List              as L
import qualified Numeric

-- | Offers efficient concatenation, no matter the associativity
data Builder
  = Node Builder Builder
  | Leaf B.Builder

instance Eq Builder where
  Builder
b0 == :: Builder -> Builder -> Bool
== Builder
b1 = Builder -> Text
toLazyText Builder
b0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Builder -> Text
toLazyText Builder
b1

instance IsString Builder where
  fromString :: String -> Builder
fromString = Builder -> Builder
Leaf (Builder -> Builder) -> (String -> Builder) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
forall a. IsString a => String -> a
fromString

instance Semigroup Builder where
  <> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
Node

instance Monoid Builder where
  mempty :: Builder
mempty = Builder -> Builder
Leaf Builder
forall a. Monoid a => a
mempty

toLazyText :: Builder -> LT.Text
toLazyText :: Builder -> Text
toLazyText = Builder -> Text
B.toLazyText (Builder -> Text) -> (Builder -> Builder) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder -> Builder
go Builder
forall a. Monoid a => a
mempty
  where
    go :: Builder -> Builder -> Builder
go Builder
tl (Leaf Builder
b) = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
tl
    go Builder
tl (Node Builder
t0 Builder
t1) = Builder -> Builder -> Builder
go (Builder -> Builder -> Builder
go Builder
tl Builder
t1) Builder
t0

fromLazyText :: LT.Text -> Builder
fromLazyText :: Text -> Builder
fromLazyText = Builder -> Builder
Leaf (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
B.fromLazyText

fromText :: T.Text -> Builder
fromText :: Text -> Builder
fromText = Builder -> Builder
Leaf (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
B.fromText

parens :: Builder -> Builder
parens :: Builder -> Builder
parens Builder
b = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>  Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

(<+>) :: Builder -> Builder -> Builder
Builder
x <+> :: Builder -> Builder -> Builder
<+> Builder
y = Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y

parenSeqs :: [Builder] -> Builder
parenSeqs :: [Builder] -> Builder
parenSeqs = Builder -> Builder
parens (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
seqs

key :: Builder -> Builder -> Builder
key :: Builder -> Builder -> Builder
key Builder
k Builder
b = [Builder] -> Builder
parenSeqs [Builder
k, Builder
b]

key2 :: Builder -> Builder -> Builder -> Builder
key2 :: Builder -> Builder -> Builder -> Builder
key2 Builder
k Builder
b1 Builder
b2 = [Builder] -> Builder
parenSeqs [Builder
k, Builder
b1, Builder
b2]

key3 :: Builder -> Builder -> Builder -> Builder ->  Builder
key3 :: Builder -> Builder -> Builder -> Builder -> Builder
key3 Builder
k Builder
b1 Builder
b2 Builder
b3 = [Builder] -> Builder
parenSeqs [Builder
k, Builder
b1, Builder
b2, Builder
b3]

seqs :: [Builder] -> Builder
seqs :: [Builder] -> Builder
seqs = (Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) Builder
forall a. Monoid a => a
mempty ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
L.intersperse Builder
" "

bShow :: Show a => a -> Builder
bShow :: a -> Builder
bShow = String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> (a -> String) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

bFloat :: RealFloat a => a -> Builder
bFloat :: a -> Builder
bFloat a
d = String -> Builder
forall a. IsString a => String -> a
fromString (Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloat Maybe Int
forall a. Maybe a
Nothing a
d String
"")

bb :: LT.Text -> Builder
bb :: Text -> Builder
bb = Text -> Builder
fromLazyText

lbb :: T.Text -> Builder
lbb :: Text -> Builder
lbb = Text -> Builder
bb (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict

blt :: Builder -> LT.Text
blt :: Builder -> Text
blt = Builder -> Text
toLazyText