    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 :+:  {- like multiplication -}
    infixr 6 :=:  {- like addition -}

    data T a = Primitive a
             | T a :+: T a  -- sequential composition
             | T a :=: T a  -- parallel composition
       deriving (Show, Eq, Ord {- for use in FiniteMap -})

    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
    --   fmap = Traversable.fmapDefault

    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 :)