module Prednote.Format where
import Rainbow
import Data.Text (Text)
import qualified Data.Text as X
import qualified Prednote.Core as C
import qualified Data.Tree as E
import Data.Monoid
lblTrue :: [Chunk]
lblTrue = ["[", fore green <> "TRUE", "]"]
lblFalse :: [Chunk]
lblFalse = ["[", fore red <> "FALSE", "]"]
indentAmt :: Int
indentAmt = 2
lblLine :: Bool -> Text -> [Chunk]
lblLine b t = lbl ++ [" ", fromText t]
where
lbl | b = lblTrue
| otherwise = lblFalse
indent :: [Chunk] -> Int -> [Chunk]
indent cs i = spaces : cs ++ [fromText "\n"]
where
spaces = fromText . X.replicate (indentAmt * i)
. X.singleton $ ' '
shortCir :: Int -> [Chunk]
shortCir = indent ["[", fore yellow <> "short circuit", "]"]
indentTxt :: Text -> Int -> [Chunk]
indentTxt = indent . (:[]) . fromText
(<+>) :: Text -> Text -> Text
l <+> r
| full l && full r = l <> " " <> r
| otherwise = l <> r
where
full = Prelude.not . X.null
rename :: Text -> C.Pred a -> C.Pred a
rename x p = p { C.static = (C.static p)
{ E.rootLabel = indentTxt x } }
changeOutput
:: (a -> C.Output -> C.Output)
-> C.Pred a
-> C.Pred a
changeOutput f p = p { C.evaluate = e' }
where
e' a = t'
where
t = C.evaluate p a
t' = t { E.rootLabel = f a (E.rootLabel t) }
speak
:: (a -> Text)
-> C.Pred a
-> C.Pred a
speak f = changeOutput g
where
g a o = o { C.dynamic = dyn }
where
dyn = indent $ lblLine (C.result o) (f a)
speakShort :: C.Pred a -> C.Pred a
speakShort p = p { C.evaluate = e' }
where
e' a = t { E.rootLabel = (E.rootLabel t)
{ C.short = fmap (const shortCir) shrt } }
where
t = C.evaluate p a
shrt = C.short . E.rootLabel $ t