module Data.BoolExpr.Printer
  (-- * Printers
    boolExprPrinter
  , signedPrinter
  , disjPrinter
  , conjPrinter
  , cnfPrinter
  , dnfPrinter
  )
where

import Data.BoolExpr

-- | Printer
boolExprPrinter :: (a -> ShowS) -> BoolExpr a -> ShowS
boolExprPrinter :: forall a. (a -> ShowS) -> BoolExpr a -> ShowS
boolExprPrinter a -> ShowS
f = BoolExpr a -> ShowS
go
  where
    go :: BoolExpr a -> ShowS
go (BAnd BoolExpr a
a BoolExpr a
b) = ShowS -> ShowS
paren forall a b. (a -> b) -> a -> b
$ BoolExpr a -> ShowS
go BoolExpr a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
text String
" AND " forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExpr a -> ShowS
go BoolExpr a
b
    go (BOr  BoolExpr a
a BoolExpr a
b) = ShowS -> ShowS
paren forall a b. (a -> b) -> a -> b
$ BoolExpr a -> ShowS
go BoolExpr a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
text String
" OR "  forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExpr a -> ShowS
go BoolExpr a
b
    go (BNot BoolExpr a
a)   = String -> ShowS
text String
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS
paren (BoolExpr a -> ShowS
go BoolExpr a
a)
    go  BoolExpr a
BTrue     = String -> ShowS
text String
"TRUE" -- not in the parser
    go  BoolExpr a
BFalse    = String -> ShowS
text String
"FALSE" -- not in the parser
    go (BConst Signed a
c) = forall a. (a -> ShowS) -> Signed a -> ShowS
signedPrinter a -> ShowS
f Signed a
c

sep :: String -> String -> (a -> ShowS) -> [a] -> ShowS
sep :: forall a. String -> String -> (a -> ShowS) -> [a] -> ShowS
sep String
empty String
_ a -> ShowS
_ [] = String -> ShowS
text String
empty
sep String
_     String
s a -> ShowS
f [a]
xs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\ShowS
x ShowS
y -> ShowS
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
text String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
y) (a -> ShowS
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs)

signedPrinter :: (a -> ShowS) -> Signed a -> ShowS
signedPrinter :: forall a. (a -> ShowS) -> Signed a -> ShowS
signedPrinter a -> ShowS
f (Positive a
c) = a -> ShowS
f a
c
signedPrinter a -> ShowS
f (Negative a
c) = String -> ShowS
text String
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f a
c

disjPrinter :: (a -> ShowS) -> Disj a -> ShowS
disjPrinter :: forall a. (a -> ShowS) -> Disj a -> ShowS
disjPrinter a -> ShowS
f = forall a. String -> String -> (a -> ShowS) -> [a] -> ShowS
sep String
"FALSE" String
" OR " (ShowS -> ShowS
paren forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Disj a -> [a]
unDisj

conjPrinter :: (a -> ShowS) -> Conj a -> ShowS
conjPrinter :: forall a. (a -> ShowS) -> Conj a -> ShowS
conjPrinter a -> ShowS
f = forall a. String -> String -> (a -> ShowS) -> [a] -> ShowS
sep String
"TRUE" String
" AND " (ShowS -> ShowS
paren forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Conj a -> [a]
unConj

cnfPrinter :: (a -> ShowS) -> CNF a -> ShowS
cnfPrinter :: forall a. (a -> ShowS) -> CNF a -> ShowS
cnfPrinter a -> ShowS
f = forall a. (a -> ShowS) -> Conj a -> ShowS
conjPrinter (forall a. (a -> ShowS) -> Disj a -> ShowS
disjPrinter (forall a. (a -> ShowS) -> Signed a -> ShowS
signedPrinter a -> ShowS
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CNF a -> Conj (Disj (Signed a))
unCNF

dnfPrinter :: (a -> ShowS) -> DNF a -> ShowS
dnfPrinter :: forall a. (a -> ShowS) -> DNF a -> ShowS
dnfPrinter a -> ShowS
f = forall a. (a -> ShowS) -> Disj a -> ShowS
disjPrinter (forall a. (a -> ShowS) -> Conj a -> ShowS
conjPrinter (forall a. (a -> ShowS) -> Signed a -> ShowS
signedPrinter a -> ShowS
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DNF a -> Disj (Conj (Signed a))
unDNF

paren :: ShowS -> ShowS
paren :: ShowS -> ShowS
paren = Bool -> ShowS -> ShowS
showParen Bool
True

text :: String -> ShowS
text :: String -> ShowS
text  = String -> ShowS
showString