-- | replica of "Data.Boolean" module. Booleans for csound signals
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 ((<*))


--------------------------------------------
-- Boolean instances

toCs :: X a => a -> La.CsTree
toCs = to

-----------------------------------------
-- BoolRate

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

ifB :: X a => BoolRate -> a -> a -> a
ifB (BoolRate c) a b = from $ B.ifB c (toCs a) (toCs b)

-- EqB

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./=*)

-- OrdB

infix  4  <*, <=*, >=*, >*

(<*), (>*), (>=*), (<=*) :: (K a, K b) => a -> b -> BoolRate

(<*) = biOp (B.<*)
(>*) = biOp (B.>*)

(>=*) = biOp (B.>=*)
(<=*) = biOp (B.<=*)

-- aux

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