    module Medium.LabeledControlled.List where

    import qualified Medium.Controlled.List as CtrlMediumList
    import qualified Medium.Controlled as CtrlMedium
    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 label
    (e.g. the duration of the represented music),
    a controller constructor
    and direct support for rests.
    -}
    data T label control content =
       Cons {label :: label,
             structure :: Structure label control content}
       deriving (Show, Eq, Ord {- for use in FiniteMap -})

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

    class Label label where
       emptyLabel :: label
       -- error "We can not automatically assign a label to primitives created by the generic Medium.primitive method"
       foldLabelSerial   :: [label] -> label
       foldLabelParallel :: [label] -> label

    serialLabel, parallelLabel :: Label label =>
       [T label control content] -> T label control content
    serialLabel   xs = Cons (foldLabelSerial   (map label xs)) (Serial   xs)
    parallelLabel xs = Cons (foldLabelParallel (map label xs)) (Parallel xs)

    instance (Label label) => Medium.Construct (T label control) where
       prim = Cons emptyLabel . Primitive

       {- If the operands are also Serials or Parallels
          the lists are joined,
          since most times the operators are used to construct lists.
          This definition works also infinite application of (+:+). -}
       (+:+) x y = serialLabel   (serialToList   x ++ serialToList   y)
       (=:=) x y = parallelLabel (parallelToList x ++ parallelToList y)

       serial1   = serialLabel
       parallel1 = parallelLabel

       serial   = serialLabel
       parallel = parallelLabel

    switchList ::
       (label -> b -> c) ->
       (a -> b) ->
       ([T label control a] -> b) ->
       ([T label control a] -> b) ->
       (control -> T label control a -> b) ->
       (T label control a -> c)
    switchList lab f g h k (Cons l s) =
       lab l $
       case s of
          Primitive x  -> f x
          Serial   m   -> g m
          Parallel m   -> h m
          Control  c m -> k c m

    foldList ::
       (label -> b -> c) ->
       (a -> b) ->
       ([c] -> b) ->
       ([c] -> b) ->
       (control -> c -> b) ->
       (T label control a -> c)
    foldList lab f g h k =
       let recourse = foldList lab f g h k
       in  switchList lab f
              (g . map recourse) (h . map recourse) (\c -> k c . recourse)

    fromControlledMediumList :: Label label =>
       (a -> (label, b)) -> (control -> T label control b -> label) ->
       CtrlMediumList.T control a -> T label control b
    fromControlledMediumList f k =
       CtrlMedium.foldList
          ((\(lab,x) -> Cons lab (Primitive x)) . f)
          serialLabel
          parallelLabel
          (\c x -> Cons (k c x) (Control c x))

    mapLabel :: (i -> j) -> (T i control a -> T j control a)
    mapLabel f =
       foldList (Cons . f) Primitive Serial Parallel Control

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

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

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

    {-
    instance (Temporal.C a) => Temporal.C (T a) where
       dur  = Medium.foldList Temporal.dur sum maximum0
       none = Medium.prim . 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 label control a -> [T label control a]

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

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