    module Medium.Controlled.List where

    import qualified Medium.Controlled as CtrlMedium
    import qualified Medium.Plain.List as ListMedium
    import qualified Medium
    import qualified Medium.Temporal as Temporal
    import Haskore.General.Utility(maximum0)

    import Control.Applicative (liftA, )
    import Data.Foldable (Foldable(foldMap))
    import Data.Traversable (Traversable(sequenceA))
    import qualified Data.Traversable as Traversable

    {- |
    Medium type with a controller constructor.
    -}
    data T control content =
          Primitive content                    -- ^ primitive content
        | Serial   [T control content]         -- ^ sequential composition
        | Parallel [T control content]         -- ^ parallel composition
        | Control  control (T control content) -- ^ controller
       deriving (Show, Eq, Ord {- for use in FiniteMap -})

    instance Medium.Construct (T control) where
       prim = Primitive

       (+:+) x y = serial   (serialToList   x ++ serialToList   y)
       (=:=) x y = parallel (parallelToList x ++ parallelToList y)

       serial   = serial
       parallel = parallel

       serial1   = serial
       parallel1 = parallel

    instance CtrlMedium.C T where
       control = Control

       switchBinary f _ _ _ _ (Primitive x)     = f x
       switchBinary _ g _ _ _ (Serial   (m:ms)) = g m (Serial   ms)
       switchBinary _ _ h _ _ (Parallel (m:ms)) = h m (Parallel ms)
       switchBinary _ _ _ k _ (Control  c m)    = k c m
       switchBinary _ _ _ _ z _ = z

       switchList f _ _ _ (Primitive x)  = f x
       switchList _ g _ _ (Serial   m)   = g m
       switchList _ _ h _ (Parallel m)   = h m
       switchList _ _ _ k (Control  c m) = k c m

    instance Functor (T control) where
       fmap f = CtrlMedium.foldList (Primitive . f) Serial Parallel Control
    --   fmap = Traversable.fmapDefault

    instance Foldable (T control) where
       foldMap = Traversable.foldMapDefault

    instance Traversable (T control) where
       sequenceA =
          CtrlMedium.foldList
             (liftA Primitive)
             (liftA Serial . sequenceA)
             (liftA Parallel . sequenceA)
             (liftA . Control)

    instance (Temporal.C a, Temporal.Control control) =>
          Temporal.C (T control a) where
       dur  = CtrlMedium.foldList Temporal.dur sum maximum0 Temporal.controlDur
       none = Primitive . Temporal.none

    {-
    This behaves identical to Medium.Binary,
    if the top most constructor is no serial composition
    it returns a single element list.
    -}
    serialToList, parallelToList :: T control a -> [T control a]

    serialToList (Serial ns) = ns
    serialToList n           = [n]

    parallelToList (Parallel ns) = ns
    parallelToList n             = [n]

    prim :: a -> T control a
    prim = Primitive

    serial, parallel :: [T control a] -> T control a
    serial   = Serial
    parallel = Parallel

    fromMedium :: (Medium.C src) => src a -> T control a
    fromMedium  =  Medium.foldList Primitive Serial Parallel

    toMediumList :: T control a -> ListMedium.T a
    toMediumList  =
       CtrlMedium.foldList ListMedium.Primitive
          ListMedium.Serial ListMedium.Parallel (flip const)

    {- A variant of fmap that does not only allow manipulation of primitives
       but also of the compositions.
       Though the structure must be preserved. -}
    mapList ::
       (a -> b) ->
       ([T control b] -> [T control b]) ->
       ([T control b] -> [T control b]) ->
       (control -> T control b -> T control b) ->
       T control a -> T control b
    mapList f g h k =
       CtrlMedium.foldList (Primitive . f) (Serial . g) (Parallel . h) (\c -> Control c . k c)

    mapListFlat ::
       (a -> b) ->
       ([T control a] -> [T control b]) ->
       ([T control a] -> [T control b]) ->
       (control -> T control a -> T control b) ->
       T control a -> T control b
    mapListFlat f g h k =
       CtrlMedium.switchList (Primitive . f) (Serial . g) (Parallel . h) (\c -> Control c . k c)

    mapControl ::
       (c0 -> c1) -> T c0 a -> T c1 a
    mapControl f =
       CtrlMedium.foldList
          Primitive Serial Parallel (Control . f)