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
data T control content =
Primitive content
| Serial [T control content]
| Parallel [T control content]
| Control control (T control content)
deriving (Show, Eq, Ord )
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
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
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)
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)