module CsoundExpr.Base.Boolean (
BoolRate,
true, false, notB, (&&*), (||*),
(==*), (/=*), (<*), (>*), (<=*), (>=*),
ifB, minB, maxB, cond, crop
)
where
import CsoundExpr.Translator.Types
import CsoundExpr.Translator.Cs.IM
import qualified CsoundExpr.Translator.Cs.CsTree as La
import CsoundExpr.Translator.Cs.CsBoolean
import qualified Data.Boolean as B
import Data.Monoid
import Control.Applicative hiding ((<*))
toCs :: X a => a -> La.CsTree
toCs = to
infixr 3 &&*
infixr 2 ||*
true = BoolRate B.true
false = BoolRate B.false
notB (BoolRate a) = BoolRate $ B.notB a
BoolRate a &&* BoolRate b = BoolRate $ a B.&&* b
BoolRate a ||* BoolRate b = BoolRate $ a B.||* b
ifB :: X a => BoolRate -> a -> a -> a
ifB (BoolRate c) a b = from $ B.ifB c (toCs a) (toCs b)
infix 4 ==*, /=*
biOp :: (K a, K b) =>
(La.CsTree -> La.CsTree -> CsBool)
-> a -> b -> BoolRate
biOp op a b = BoolRate $ toCs a `op` toCs b
(==*), (/=*) :: (K a, K b) => a -> b -> BoolRate
(==*) = biOp (B.==*)
(/=*) = biOp (B./=*)
infix 4 <*, <=*, >=*, >*
(<*), (>*), (>=*), (<=*) :: (K a, K b) => a -> b -> BoolRate
(<*) = biOp (B.<*)
(>*) = biOp (B.>*)
(>=*) = biOp (B.>=*)
(<=*) = biOp (B.<=*)
cond :: (Applicative f, K a) => f BoolRate -> f a -> f a -> f a
cond f a b = fmap from $ B.cond (fmap (\(BoolRate a) -> a) f) (fmap toCs a) (fmap toCs b)
crop :: (Applicative f, Monoid (f a), K a) => f BoolRate -> f a -> f a
crop f a = cond f a mempty
minB, maxB :: K a => a -> a -> a
minB a b = ifB (a <=* b) a b
maxB a b = ifB (a >=* b) a b