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)