module Prednote.Prebuilt where
import qualified Prednote.Core as C
import Prednote.Format
import qualified Data.Tree as E
import qualified Data.Text as X
import Data.Text (Text)
import Data.Monoid
import Prelude hiding (and, or, not, filter, compare, any, all)
import qualified Prelude
predicate
:: Text
-> (a -> Text)
-> (a -> Bool)
-> C.Pred a
predicate r s f = rename r . speak s $ C.Pred (E.Node (const []) []) ev
where
ev a = E.Node (C.Output (f a) C.shown Nothing (const [])) []
true :: C.Pred a
true = predicate l (const l) (const True)
where
l = "always True"
false :: C.Pred a
false = predicate l (const l) (const False)
where
l = "always False"
same :: C.Pred Bool
same = predicate l (const l) id
where
l = "same as subject"
visibility
:: (Bool -> C.Visible)
-> C.Pred a
-> C.Pred a
visibility f (C.Pred s e) = C.Pred s e'
where
e' a = g (e a)
g (E.Node n cs) = E.Node n { C.visible = f (C.result n) } cs
reveal :: C.Pred a -> C.Pred a
reveal = visibility (const C.shown)
hide :: C.Pred a -> C.Pred a
hide = visibility (const C.hidden)
showTrue :: C.Pred a -> C.Pred a
showTrue = visibility (\b -> if b then C.shown else C.hidden)
showFalse :: C.Pred a -> C.Pred a
showFalse = visibility (\b -> if Prelude.not b then C.shown else C.hidden)
all :: [C.Pred a] -> C.Pred a
all = speakShort . rename l . speak (const l) . C.all
where
l = "all"
(&&&) :: C.Pred a -> C.Pred a -> C.Pred a
l &&& r = all [l, r]
infixr 3 &&&
any :: [C.Pred a] -> C.Pred a
any = speakShort . rename l . speak (const l) . C.any
where
l = "any"
(|||) :: C.Pred a -> C.Pred a -> C.Pred a
l ||| r = any [l, r]
infixr 2 |||
not :: C.Pred a -> C.Pred a
not = rename l . speak (const l) . C.not
where
l = "not"
fanAll :: (a -> [b]) -> C.Pred b -> C.Pred a
fanAll f = speakShort . rename l . speak (const l) . C.fanAll f
where
l = "fanout all"
fanAny :: (a -> [b]) -> C.Pred b -> C.Pred a
fanAny f = speakShort . rename l . speak (const l) . C.fanAny f
where
l = "fanout any"
fanAtLeast :: Int -> (a -> [b]) -> C.Pred b -> C.Pred a
fanAtLeast i f = speakShort . rename l . speak (const l)
. C.fanAtLeast i f
where
l = "fanout - at least " <> X.pack (show i) <>
" fanned-out subject(s) must be True"