{-# 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.Foldable (fold)
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 forall a. Eq a => a -> a -> Bool
== Builder -> Text
toLazyText Builder
b1

instance IsString Builder where
  fromString :: String -> Builder
fromString = Builder -> Builder
Leaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Monoid a => a
mempty

toLazyText :: Builder -> LT.Text
toLazyText :: Builder -> Text
toLazyText = Builder -> Text
B.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder -> Builder
go forall a. Monoid a => a
mempty
  where
    go :: Builder -> Builder -> Builder
go Builder
tl (Leaf Builder
b) = Builder
b 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
B.fromText

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

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

parenSeqs :: [Builder] -> Builder
parenSeqs :: [Builder] -> Builder
parenSeqs = Builder -> Builder
parens 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 = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
L.intersperse Builder
" "

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

bFloat :: RealFloat a => a -> Builder
bFloat :: forall a. RealFloat a => a -> Builder
bFloat a
d = forall a. IsString a => String -> a
fromString (forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloat 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 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