module Medium.Plain.Binary where
import Medium ((+:+), (=:=))
import qualified Medium
import qualified Medium.Temporal as Temporal
import Control.Applicative (liftA, liftA2, )
import Data.Foldable (Foldable(foldMap))
import Data.Traversable (Traversable(sequenceA))
import qualified Data.Traversable as Traversable
infixr 7 :+:
infixr 6 :=:
data T a = Primitive a
| T a :+: T a
| T a :=: T a
deriving (Show, Eq, Ord )
instance Medium.Construct T where
prim = Primitive
(+:+) = (:+:)
(=:=) = (:=:)
serial [] = Primitive (Temporal.none 0)
serial m = foldr1 (+:+) m
parallel [] = Primitive (Temporal.none 0)
parallel m = foldr1 (=:=) m
serial1 = foldr1 (+:+)
parallel1 = foldr1 (=:=)
instance Medium.C T where
switchBinary f _ _ _ (Primitive x) = f x
switchBinary _ g _ _ (m0:+:m1) = g m0 m1
switchBinary _ _ h _ (m0:=:m1) = h m0 m1
switchList f _ _ (Primitive x) = f x
switchList _ g _ m@(_ :+: _) = g (serialS m [])
switchList _ _ h m@(_ :=: _) = h (parallelS m [])
errorNone :: a
errorNone = error "Program bug: This data structure does not contain empty things."
instance Functor T where
fmap f = Medium.foldBin (Primitive . f) (:+:) (:=:) errorNone
instance Foldable T where
foldMap = Traversable.foldMapDefault
instance Traversable T where
sequenceA =
Medium.foldBin
(liftA Primitive)
(liftA2 (:+:))
(liftA2 (:=:))
errorNone
instance Temporal.C a => Temporal.C (T a) where
dur = Medium.foldBin Temporal.dur (+) max errorNone
none = Medium.prim . Temporal.none
serialS, parallelS :: T a -> [T a] -> [T a]
serialS (m0 :+: m1) = serialS m0 . serialS m1
serialS m0 = (m0 :)
parallelS (m0 :=: m1) = parallelS m0 . parallelS m1
parallelS m0 = (m0 :)