temporal-media 0.1.1 → 0.2.0

raw patch · 3 files changed

+653/−804 lines, 3 filesdep +dlistdep +mtldep −containersPVP ok

version bump matches the API change (PVP)

Dependencies added: dlist, mtl

Dependencies removed: containers

API changes (from Hackage documentation)

Files

• src/Temporal/Media.hs +646/−650
• src/Temporal/Media/Double.hs +0/−149
• temporal-media.cabal +7/−5

@@ -1,650 +1,646 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-module Temporal.Media (-	-- * Time classes-	Dur(..), Temporal(..), Stretchable(..), -	ToMaybe(..), TemporalFunctor(..), -    Sustainable(..), sustain,-    TemporalStretchable(..),-    -- * Transformers-	Reversible(..), Sliceable(..), cut, -	-- * Structure -	Construct(..), Arrangeable(..),	Controlable(..),-	sequent, parallel, loop, delay, temp,-	-- * Media-	Media(..), fold, fromMedia,-	-- * Simple interperetation-	-- ** Event list-	Event, EventList(..), -	mapEvent, toEvent, toEventList,-	-- ** Unit Temporal Media-	MediaUnit(..), unMediaUnit, foldU, fromMediaUnit,-	Unit(..),-    -- ** Misc-     tmapRel, dmapRel, tdmapRel,  tstretchRel, linseg-)-where--import Control.Applicative-import Control.Monad--import Data.Function-import Data.Ratio-import Data.Tree--import Prelude hiding (reverse, take, drop)-import qualified Prelude as P (reverse)--import Debug.Trace--debug msg x = trace (msg ++ " : " ++ show x) x------------------------------------------------------ Classes-------------------------------------------------------- Time classes---- | time class-class (Num t, Ord t, Fractional t) => Dur t--instance Dur Double-instance Integral a => Dur (Ratio a)---- | Temporal structures-class Dur t => Temporal t a where-	none    :: t -> a        -- ^ absence of value-	dur     :: a -> t        -- ^ duration of value            ---- | Stretching values by given time-factor-class Temporal t a => Stretchable t a where-	stretch :: t -> a -> a       ---- | Values covertible to 'Maybe'	------  auxiliary class for conversion to 'EventList'-class ToMaybe m where-	toMaybe :: m a -> Maybe a---- | temporal map------ minimal complete defenition : @tdmap@-class Dur t => TemporalFunctor t f where-    -- | map with time-    tmap :: (t -> a -> b) -> f a -> f b   -    -- | map with duration-    dmap :: (t -> a -> b) -> f a -> f b --    -- | map with time and duration-    tdmap  :: (t -> t -> a -> b) -> f a -> f b--    tmap f = tdmap (flip $ const f)-    dmap f = tdmap (const f)--class Dur t => Sustainable t f where    -    -- | map with time and duration and transform duration time-    sustainBy :: (t -> t -> a -> (b, t)) -> f a -> f b---- | adds constant amount of duration to all notes-sustain :: (Dur t, Sustainable t f) => t -> f a -> f a-sustain dt' = sustainBy $ \t dt x -> (x, dt + dt')---class Stretchable t a => TemporalStretchable t a where-    tstretch :: (t -> t) -> a -> a---------------------------------------------------------- transformers-----class Reversible a where-	reverse :: a -> a---- | extracting parts, minimal complete definition:  'slice'.-class Temporal t a => Sliceable t a where-	slice :: t -> t -> a -> a   -- ^ @slice t0 t1 v@ extracts part of @v@ inside @[t0, t1]@-	take  :: t -> a -> a        -	drop  :: t -> a -> a--	take t   = slice 0 t-	drop t x = slice t (dur x) x--sliceErrorMessage = error "should be t0 <= t1, for slice t0 t1" ---- | mixing slice and reverse. ------ @cut t0 t1 v@ - if @t1 < t0@ reverses result of 'slice'-cut :: (Reversible a, Sliceable t a) => t -> t -> a -> a-cut t0 t1 m-	| t0 <= t1  = slice t0 t1 m-	| otherwise = slice (tm - t0) (tm - t1) $ reverse m-	where tm = dur m--------------------------------------------------------- Structure------- | constructor for generic structures-class Construct m where-	prim :: a -> m a---- | composing structures in sequent and parallel ways -class Arrangeable a where-	(+:+) :: a -> a -> a-	(=:=) :: a -> a -> a---- | modifer-class Controlable c a where-	control :: c -> a -> a-	--sequent, parallel :: Arrangeable a => [a] -> a--sequent  = foldl1 (+:+)-parallel = foldl1 (=:=)--loop :: Arrangeable a => Int -> a -> a-loop n = sequent . replicate n --delay :: (Temporal t a, Arrangeable a) => t -> a -> a-delay t x = none t +:+ x----- | constructs generic temporal structure @m a@ form time @t@ and initial value @a@-temp :: (Construct m, Temporal t (m a), Stretchable t (m a))-	=> t -> a -> m a-temp t = stretch t . prim---------------------------------------------------------- Media---- | Data type to represent temporal media-data Media c a = Prim a                        -- ^ single value-	       | Media c a :+: Media c a       -- ^ sequential composition-	       | Media c a :=: Media c a       -- ^ parallel composition-	       | Control c (Media c a)         -- ^ specific environment modifier-		deriving (Show, Eq)----- | Folding Media------ > fold prim seq par mod x------ * prim - responds to 'Prim'------ * seq  - responds to ':+:'------ * par  - responds to ':=:'------ * mod  - responds to 'Control'-fold :: (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> (c -> b -> b) -	-> Media c a -> b-fold prim seq par mod m = -	case m of-		Prim a      -> prim a-		a :+: b     -> (seq `on` f) a b-		a :=: b     -> (par `on` f) a b-		Control c a -> mod c $ f a -	where f = fold prim seq par mod-	---instance Functor (Media c) where-	fmap f x = case x of-			Prim a      -> Prim $ f a-			a :+: b     -> fmap f a :+: fmap f b-			a :=: b     -> fmap f a :=: fmap f b-			Control c a -> Control c $ fmap f a--instance Monad (Media c) where-	return   = Prim-	ma >>= f = case ma of-			Prim a      -> f a-			a :+: b     -> (a >>= f) :+: (b >>= f)-			a :=: b     -> (a >>= f) :=: (b >>= f)-			Control c a -> Control c $ a >>= f--instance Applicative (Media c) where-	pure  = return-	(<*>) = ap----- time--instance Temporal t a => Temporal t (Media c a) where-	none      = Prim . none-	dur       = fold dur (+) max (const id)--instance Stretchable t a => Stretchable t (Media c a) where-	stretch d = fmap $ stretch d--instance Stretchable t a => TemporalStretchable t (Media c a) where-    tstretch f m = tdmapM (\t _ -> stretch $ f t) m-    --- transformers--instance Reversible a => Reversible (Media c a) where-	reverse x = case x of-			Prim a      -> Prim $ reverse a-			a :+: b     -> ((:+:) `on` reverse) b a-			a :=: b     -> ((:=:) `on` reverse) a b-			Control c a -> Control c $ reverse a---instance Sliceable t a => Sliceable t (Media c a) where-	slice t0 t1 m -	    | t1 < t0   = sliceErrorMessage-	    | t1 <= 0   = none $ (t1 - t0)-	    | t0 >= tm  = none $ (t1 - t0)-	    | t0 < 0    = none (abs t0) :+: slice 0 t1 m-	    | t1 > tm   = slice t0 tm m :+: none (t1 - tm)-	    | otherwise = case m of-                        Prim a      -> Prim $ slice t0 t1 a-                        a :+: b     -> sliceSeq t0 t1 a b -                        a :=: b     -> ((:=:) `on` slice t0 t1) a b-                        Control c a -> Control c $ slice t0 t1 a-		where tm = dur m--sliceSeq :: Sliceable t a => t -> t -> Media c a -> Media c a -> Media c a-sliceSeq t0 t1 a b-	| t1 <= ta  = slice t0 t1 a-	| t0 >= ta  = slice (t0 - ta) (t1 - ta) b-	| otherwise = slice t0 ta a :+: slice 0 (t1 - ta) b-	where ta = dur a--	--- Structure--instance Construct (Media c) where-	prim = Prim--instance Arrangeable (Media c a) where-	(+:+) = (:+:)-	(=:=) = (:=:)--instance Controlable c (Media c a) where-	control = Control--------------------------------------------------------- Meaning---- | Media interpretation------ given two functions (to convert elementary value @(a -> b)@, --- and to convert modifiers @(c -> b -> b)@) `fromMedia` interprets 'Media' structure-fromMedia :: Arrangeable b => (a -> b) -> (c -> b -> b) -> Media c a -> b-fromMedia prim mod = fold prim (+:+) (=:=) mod-	---------------------------------------------------------------------------------------	--- | Event type------ @(t, dt, a)@ - value @a@ starts at @t@ and lasts for @dt@-type Event t a = (t, t, a)---- | list of events with given total time-data EventList t a = EventList t [Event t a]-	deriving (Show, Eq)---toEvent :: (Temporal t (m a), ToMaybe m) => m a -> EventList t a-toEvent a = EventList (dur a) $ maybe [] (return . singleEvent) $ toMaybe a-	where singleEvent x = (0, dur a, x)--mapEvent :: Dur t => (a -> b) -> Event t a -> Event t b-mapEvent f (t, dt, a) = (t, dt, f a)--instance Dur t => Functor (EventList t) where-	fmap f (EventList t es) = EventList t $ fmap (mapEvent f) es---- time--instance Dur t => Temporal t (EventList t a) where-	none t = EventList t []-	dur (EventList t _) = t--instance (Dur t, Stretchable t a) => Stretchable t (EventList t a) where-	stretch d (EventList t es) = EventList (d * t) $ map (stretchEvent d) es-		where stretchEvent d (t, dt, a) = (d * t, d * dt, stretch d a)--instance Dur t => TemporalFunctor t (EventList t) where-	tdmap f (EventList t es) = EventList t $ map (tmapEvent f) es-		where tmapEvent f (t, dt, a) = (t, dt, a') where a' = f t dt a--instance Dur t => Sustainable t (EventList t) where-	sustainBy f (EventList t es) = EventList t $ map (tmapEvent f) es-		where tmapEvent f (t, dt, a) = (t, dt', a') where (a', dt') = f t dt a------ structure--instance Dur t => Construct (EventList t) where-	prim a = EventList 1 [(0, 1, a)]--instance Dur t => Arrangeable (EventList t a) where-	(EventList t es) +:+ (EventList t' es') = -		EventList (t + t') (es ++ map (delayEvent t) es')-		where delayEvent d (t, dt, a) = (t + d, dt, a)-	(EventList t es) =:= (EventList t' es') =-		EventList (max t t') $ merge es es'-		where merge []  x = x-		      merge x  [] = x-                      merge (a@(ta, _, _):as) (b@(tb, _, _):bs) -			| ta < tb   = a : merge as     (b:bs)-			| otherwise = b : merge (a:as) bs--instance Dur t => Controlable () (EventList t a) where-	control = const id---- meaning---- | converting to 'EventList'------ 'toEventList' mapps generic temporal value @(m a)@ that can be --- represented with @(t, Maybe a)@ to 'EventList' -toEventList :: (Temporal t (m a), ToMaybe m) -	=> (c -> EventList t a -> EventList t a) -	-> Media c (m a) -> EventList t a-toEventList = fromMedia toEvent-------------------------------------------------------------------------------------------------------------------------------------------------- Special case : Media with explicit time. Value is unit ------- | Media with explicit time------ Value is unit (undividable, invariant to reverse and time stretching) --- O(1) 'dur'-data Dur t => MediaUnit t c a = MediaUnit t (Media c (Unit t a))--unMediaUnit :: Dur t => MediaUnit t c a -> Media c (Unit t a)-unMediaUnit (MediaUnit _ m) = m---instance Dur t => Functor (MediaUnit t c) where-	fmap f (MediaUnit t m) = MediaUnit t $ fmap (fmap f) m---instance Dur t => Monad (MediaUnit t c) where-	return = MediaUnit 1 . return . return-	(MediaUnit t ma) >>= f = MediaUnit (dur ma') ma'-		where ma' = ft =<< ma-                      ft ta = case unMediaUnit . f <$> ta of-				(Unit t (Just a)) -> stretch t a-				(Unit t Nothing)  -> none t --instance Dur t => Applicative (MediaUnit t c) where-	pure  = return-	(<*>) = ap----- time --instance Dur t => Temporal t (MediaUnit t c a) where-	none t              = MediaUnit t $ none t     -	dur (MediaUnit t _) = t--instance Dur t => Stretchable t (MediaUnit t c a) where-	stretch d (MediaUnit t m) = MediaUnit (t * d) $ stretch d m---instance Dur t => TemporalFunctor t (MediaUnit t c) where-    dmap f (MediaUnit t m) = MediaUnit t $ fmap (tmap f) m-    tdmap f (MediaUnit t m) = MediaUnit t $ tdmapM (\t dt -> fmap (f t dt)) m--instance Dur t => TemporalStretchable t (MediaUnit t c a) where-    tstretch f (MediaUnit _ m) = liftA2 MediaUnit dur id $ tstretch f m--instance Dur t => Sustainable t (MediaUnit t c) where-    sustainBy f (MediaUnit t m) = uncurry MediaUnit $ sustainByM f' m-        where f' t dt = liftA2 (,) (fu t dt) (ft t dt)-              ft t dt (Unit d a) = maybe dt (snd . f t dt) a  -              fu t dt = fmap (fst . f t dt) ---tdmapM :: Temporal t a => (t -> t -> a -> b) -> Media c a -> Media c b-tdmapM f m = fmap (\(t, dt, a) -> f t dt a) $ setEvents m--sustainByM :: (Stretchable t a, Stretchable t b) -    => (t -> t -> a -> (b, t)) -> Media c a -> (t, Media c b)-sustainByM f m = (newDur t', rearrangeSustain t' m')-    where t' = setSustainDurs m'  -          m' = tdmapM (\t dt a -> (dt, f t dt a)) m----------------------------------------------------------------- time dependent mapping tools--setEvents :: Temporal t a => Media c a -> Media c (Event t a)-setEvents m = setTimes 0 (setDurs m) m--setDurs :: Temporal t a => Media c a -> Tree t-setDurs = fold prim seq par contr-    where prim  a   = Node (dur a) []-          seq   a b = Node (on (+) rootLabel a b) [a, b]-          par   a b = Node (on max rootLabel a b) [a, b]-          contr c a = Node (rootLabel a) [a]-         --setTimes :: Dur t => t -> Tree t -> Media c a -> Media c (Event t a)-setTimes t0 durTree m = -    case m of-        Prim a  -> Prim (t0, rootLabel durTree, a)-        a :+: b -> setTimes t0 ta a :+: setTimes (t0 + rootLabel ta) tb b-        a :=: b -> on (:=:) (uncurry $ setTimes t0) (ta, a) (tb, b)-        Control c a -> Control c $ setTimes t0 ta a-    where sf = subForest durTree-          ta = sf !! 0-          tb = sf !! 1-    --rearrangeSustain :: Stretchable t a => Tree (t, t) -> Media c (t, (a, t)) -> Media c a-rearrangeSustain tr m = -    case m of-        Prim a  -> Prim $ stretch (newDur tr / oldDur tr) $ fst $ snd a-        a :+: b -> (rearrangeSustainSeq dta dta' dtb dtb') (ra a) (rb b)-        a :=: b -> (rearrangeSustainPar dta dta' dtb dtb') (ra a) (rb b)-        Control c a -> Control c $ ra a-    where sf   = subForest tr-          dta  = oldDur $ sf !! 0-          dtb  = oldDur $ sf !! 1-          dta' = newDur $ sf !! 0-          dtb' = newDur $ sf !! 1-          ra   = rearrangeSustain $ sf !! 0-          rb   = rearrangeSustain $ sf !! 1--rearrangeSustainSeq :: Stretchable t a =>-    t -> t -> t -> t ->-    Media c a -> Media c a -> Media c a-rearrangeSustainSeq dta dta' dtb dtb' a b-    | dta' < dta = sequent [a, none (dta - dta'), b]-    | dta' > dta && dtab  > 0 = parallel [sequent [a, none dtab], delay dta b]-    | dta' > dta && dtab <= 0 = parallel [a, sequent [delay dta b, none (abs $ dtab)]]-    | otherwise  = sequent[a, b]-    where dtab = dta + dtb' - dta' ---rearrangeSustainPar :: Stretchable t a =>-    t -> t -> t -> t ->-    Media c a -> Media c a -> Media c a-rearrangeSustainPar dta dta' dtb dtb' a b  -    | dtab < 0  = parallel [sequent [a, none (abs dtab)], b]-    | otherwise = parallel [a, sequent [b, none (abs dtab)]]-    where dtab = dta' - dtb'----setSustainDurs :: Dur t => Media c (t, (a, t)) -> Tree (t, t)-setSustainDurs = fold prim seq par contr-    where prim  a   = Node (fst a, snd $ snd a) []-          seq   a b = Node (on (+) oldDur a b, oldDur a + newDur b) [a, b]-          par   a b = Node (on max oldDur a b, on max newDur a b)   [a, b]-          contr c a = Node (oldDur a, newDur a) [a]-         --oldDur = fst . rootLabel-newDur = snd . rootLabel--    --- transformers---- | 'fold' replica for MediaUnit-foldU :: Dur t => (t -> a -> b) -> (b -> b -> b) -> (b -> b -> b) -> (c -> b -> b)-	       -> MediaUnit t c a -> Maybe b-foldU prim seq par mod = fold prim' (liftA2 seq) (liftA2 par) mod' . unMediaUnit-	where prim' (Unit t a) = prim t <$> a-	      mod' c = fmap (mod c)-	     	--instance Dur t => Reversible (MediaUnit t c a) where-    reverse (MediaUnit t m) = MediaUnit t $ snd $ fold prim seq par contr m-            where prim u@(Unit dt a) = (dt, Prim u)-                  seq (da, a) (db, b) = (da + db, b :+: a)-                  par (da, a) (db, b) = (\x -> (max da db, x)) $ -                        (if (da < db) -                         then delay (db - da) a =:= b-                         else a =:= delay (da - db) b)-                  contr c (da, a) = (da, Control c a)-                    --instance Dur t => Sliceable t (MediaUnit t c a) where-	slice t0 t1 (MediaUnit t a) = MediaUnit (t1 - t0) $ slice t0 t1 a---- Structure--instance Dur t => Construct (MediaUnit t c) where-	prim = MediaUnit 1 . prim . prim--instance Dur t => Arrangeable (MediaUnit t c a) where-	a +:+ b = MediaUnit (on (+) dur a b) $ on (+:+) unMediaUnit a b-	a =:= b = MediaUnit (on max dur a b) $ on (=:=) unMediaUnit a b-	--instance Dur t => Controlable c (MediaUnit t c a) where-	control c (MediaUnit t a) = MediaUnit t $ control c a---- meaning---- | Interpretation of 'MediaUnit'------ it relies on properties of 'Unit' (it's temporal and covertible to 'Maybe')-fromMediaUnit :: Dur t => (c -> EventList t a -> EventList t a) -	-> MediaUnit t c a -> EventList t a-fromMediaUnit f = toEventList f . unMediaUnit----------------------------------------------------------------- Unit---- | unit values that can happen and lasts for some time-data Dur t => Unit t a = Unit t (Maybe a)-	deriving (Show, Eq)--instance Dur t => Functor (Unit t) where-	fmap f (Unit t a) = Unit t $ fmap f a--instance Dur t => Monad (Unit t) where-	return   = prim -	(Unit t a) >>= f = case fmap f a of-				Nothing         -> none t-				Just (Unit t' b) -> Unit (t * t') b--instance Dur t => Applicative (Unit t) where-	pure  = return-	(<*>) = ap---- time --instance Dur t => Temporal t (Unit t a) where-	none t = Unit t Nothing-	dur (Unit t _) = t--instance Dur t => Stretchable t (Unit t a) where-	stretch d (Unit t a) = Unit (d * t) a--instance Dur t => ToMaybe (Unit t) where-	toMaybe (Unit _ a) = a--instance Dur t => TemporalFunctor t (Unit t) where-    dmap f (Unit t a) = Unit t $ fmap (f t) a-    -    tdmap f (Unit dt a) = -          case a of-            Just x  -> phi dt x-            Nothing -> Unit dt Nothing-         where phi t x = Unit t $ Just $ f 0 t x---- Unit transformers--instance Dur t => Reversible (Unit t a) where-	reverse = id--instance Dur t => Sliceable t (Unit t a) where-	slice t0 t1 u@(Unit t a) -		| t1 < t0          = sliceErrorMessage-		| t1 < (t - eps) || t0 > eps = none $ t1 - t0 -		| otherwise        = u-		where eps = 1e-6 ---- structure--instance Dur t => Construct (Unit t) where-	prim a = Unit 1 $ Just a---------------------------------------------------------------------------------------------------------------------------- Misc------- | relative tmap------ time values are normalized by argument duration.------ @Dur t => t inside [0, 1]@ where 1 is total duration of second argument-tmapRel :: (TemporalFunctor t f, Temporal t (f a)) => (t -> a -> b) -> f a -> f b-tmapRel f x = tmap (f . ( / dur x)) x---- | relative dmap------ time values are normalized by argument duration.------ @Dur t => t inside [0, 1]@ where 1 is total duration of second argument-dmapRel :: (TemporalFunctor t f, Temporal t (f a)) => (t -> a -> b) -> f a -> f b-dmapRel f x = dmap (f . ( / dur x)) x---- | relative tdmap------ time values are normalized by argument duration.------ @Dur t => t inside [0, 1]@ where 1 is total duration of second argument-tdmapRel :: (TemporalFunctor t f, Temporal t (f a)) => (t -> t -> a -> b) -> f a -> f b-tdmapRel f x = tdmap (on f ( / dur x)) x---- | relative tstretch-tstretchRel :: (Temporal t a, TemporalStretchable t a) => (t -> t) -> a -> a-tstretchRel f x = tstretch (f . (/ dur x)) x---- linear interpolation--linseg1 :: (Num t, Ord t, Fractional t) => (t, t, t) -> (t -> t)-linseg1 (a, dur, b) x = a + (b - a) * x / dur---- | linear interpolation------ linseg [a, da, b, db, c, ... ]------ @a, b, c ...@ - values------ @da, db, ...@ - duration of segments-linseg :: (Ord t, Fractional t) => [t] -> t -> t-linseg xs t = -    case xs of-        (a:dur:b:[])      -> seg a dur b t-        (a:dur:b:(x:xs')) -> if t < dur -                             then seg a dur b t-                             else linseg (b:x:xs') (t - dur)-    where seg a dur b t -                | t < 0     = a-                | t >= dur  = b-                | otherwise = a + (b - a)*(t/dur)+{-# LANGUAGE GADTs, FlexibleInstances #-}++-- | An embedded domain-specific language (EDSL) for +-- creating lists of constant time events related in time.+-- Combinators are optimized in fusion style.++module Temporal.Media(+    -- * Introduction++    -- | "Temporal.Media" is an embedded domain-specific +    -- language (EDSL) for creating lists of constant time +    -- events related in time. Constant time event is value+    -- that starts at some fixed time and lasts for some +    -- fixed time. Library provides functions to build lists+    -- of such events with time-relations like sequent,  +    -- parallel or delayed. +    --+    -- Core type of library is 'Media'. It provides interface+    -- to compose list of events. There is optimization that +    -- goes on behind the scene. +    --+    -- * Fusion +    --+    -- >fmap f . fmap g +    --+    -- is trasformed to+    --+    -- >fmap (f . g) +    --+    -- same holds for more general 'eventMap'.+    --+    -- * Loops+    --+    -- Transformations on 'loop' 's are  executed only for +    -- one cycle.+    --+    -- * Structure functions+    --+    -- Structure functions ('sequent', 'parallel', +    -- 'stretch', 'reverseM') are rendered as linear +    -- transformations of time and duration of an event.+    --+    -- Example of usage can be found in package 'temporal-music-notation' [1].+    -- Score module is based on this library.+    --+    -- \[1\] <http://hackage.haskell.org/package/temporal-music-notation>+    +    -- * Types+    +    Dur(..), Media, Event(..), EventList(..),++    -- * Constructors+        +    none, temp,++    -- * Composition++    (+:+), (=:=), (=:/),+    sequent, parallel, parallelT,+    delay, loop,++    -- * Transformations+    +    stretch, +    reverseM,+    slice, takeM, dropM,++    -- * Mappings++    eventMap,+    tmap, dmap, tdmap,+    tmapRel, dmapRel, tdmapRel,++    -- * Rendering+    dur, renderMedia,++    -- * Miscellaneous++    linseg+    )+where    ++++import Data.List(foldl')+import Data.Maybe(catMaybes)+import Data.Ratio(Ratio)+import Data.Function(on)++import Control.Arrow(first, second, (***))++import Control.Monad.State(State, state, runState)+import Control.Monad (foldM, liftM2)++import Data.DList(DList, empty, singleton, append, fromList, toList)++--import Debug.Trace++--debug :: Show a => String -> a -> a+--debug str x = trace (str ++ " : " ++ show x) x++-- | class of 'time' values+class (Ord a, Num a, Fractional a) => Dur a++instance Dur Double+instance Dur Float+instance Integral a => Dur (Ratio a)++-- | 'Media' is core data type. Essentially 'Media' provides +-- functional interface to 'EventList' construction.+data Media t a = Media t (M t a) ++-- | Media operations+data M t a where+-- constructors+    None :: t -> M t a+    Prim :: t -> a -> M t a++-- composition+    Seq  :: [(t, M t a)] -> M t a+    Par  :: [(t, M t a)] -> M t a++    Loop :: Int -> (t, M t a) -> M t a++-- transformation+    Stretch :: t -> (t, M t a) -> M t a++    Slice :: Interval t -> (t, M t a) -> M t a+    Reverse :: M t a -> M t a++-- mappings+    Fmap :: (a' -> a) -> M t a' -> M t a+    Emap :: (Event t a' -> Event t a) -> M t a' -> M t a++-- | Constant time events. Value @a@ starts at some time +-- and lasts for some time.+data Event t a = Event+    { eventStart    :: t+    , eventDur      :: t+    , eventContent  :: a+    } deriving (Show, Eq)+++instance Functor (Event t) where+    fmap f (Event t d a) = Event t d $ f a++-- | List of 'Event' s. First argument stands for total duration+-- of 'EventList'.+data EventList t a = EventList t [Event t a]+    deriving (Show, Eq)++instance Functor (EventList t) where+    fmap f (EventList t es) = EventList t $ map (fmap f) es+++------------------------------------------------------------+------------------------------------------------------------++-- constructors+++-- | 'none' constructs an empty event. +-- Nothing is going on for a given time.+none :: Dur t => t -> Media t a +none d +    | d >= 0    = Media d $ None d+    | otherwise = msgDurErr++-- | 'temp' constructs just an event. Value of type a+-- lasts for some time.+temp :: Dur t => t -> a -> Media t a+temp d a  +    | d >= 0    = Media d $ Prim d a+    | otherwise = msgDurErr++msgDurErr = error "duration must be non-negative"++-- duration querry++-- | Duration querry.+dur :: Media t a -> t+dur (Media t _) = t++unM :: Media t a -> M t a+unM (Media _ x) = x++-- composition++-- | Binary sequent composition. +-- In @(a+:+b)@ @a@ happens first and then @b@ goes.+(+:+) :: Dur t => Media t a -> Media t a -> Media t a+Media t a +:+ Media t' a' = Media (t + t') $ +    case (a, a') of+        (None d, None d') -> None $ d + d'+        _                 -> Seq [(t, a), (t', a')]++-- | Binary parallel composition. +-- In @(a=:=b)@ @a@ and @b@ happen simultaneously.+(=:=) :: Dur t => Media t a -> Media t a -> Media t a+Media t a =:= Media t' a' = Media (max t t') $+    case (a, a') of+        (None d, None d') -> None $ max d d'+        _                 -> Par [(t, a), (t', a')] ++-- | Truncating binary composition. +-- In @(a=:/b)@, @a@ and @b@ happen simultaneously but+-- whole result lasts only for @min ('dur' a) ('dur' b)@ time. +(=:/) :: Dur t => Media t a -> Media t a -> Media t a+a =:/ b = parallelT [a, b]++-- | 'delay' appends block of nothing of given duration +-- to the begging of value (if duration is positive)+-- or to the end of value (if duration is negative).+delay :: Dur t => t -> Media t a -> Media t a+delay d a +    | d > 0     = none d +:+ a+    | d < 0     = a +:+ (none $ abs d)+    | otherwise = a++-- | Sequent composition on lists.+sequent :: Dur t => [Media t a] -> Media t a+sequent xs = Media (sum $ map fst ds) $ Seq ds+    where ds = map (\x -> (dur x, unM x)) xs++-- | Parallel composition on lists.+parallel :: Dur t => [Media t a] -> Media t a+parallel xs = Media (maximum $ map fst ds) $ Par ds+    where ds = map (\x -> (dur x, unM x)) xs++-- | Truncating parallel composition on lists.+parallelT :: Dur t => [Media t a] -> Media t a+parallelT xs = slice 0 d $ parallel xs+    where d = minimum $ map dur xs++-- | 'loop' repeats sequentially given value.+loop :: Dur t => Int -> Media t a -> Media t a+loop n (Media t a)+    | n <= 0    = none 0+    | otherwise = Media (t * fromIntegral n) $+            case a of+                Loop n' a' -> Loop (n * n') a'+                _          -> Loop n (t, a)++--loop n = sequent . replicate n++-- transformation++-- | Stretching values by factor.+stretch :: Dur t => t -> Media t a -> Media t a+stretch k m@(Media t a)  +    | k < 0     = reverseM $ stretch (abs k) m +    | otherwise = Media (k * t) $ +            case a of+                Stretch k' x -> Stretch (k * k') x+                _            -> Stretch k (t, a)+++-- | 'slice' cuts piece of value within given time interval.+-- for @('slice' t0 t1 m)@, if @t1 < t0@ result is reversed.+-- If @t0@ is negative or @t1@ goes beyond @'dur' m@ blocks of+-- nothing inserted so that duration of result equals to +-- @'abs' (t0 - t1)@.+slice :: Dur t => t -> t -> Media t a -> Media t a+slice t0 t1 m@(Media t a)     +    | t0 == t1  = none 0+    | t0 <  t1  = Media (t1 - t0) $ Slice (t0, t1) (t, a)+    | otherwise = slice (t - t0) (t - t1) $ reverseM m++-- | @('takeM' t)@ is equivalent to @('slice' 0 t)@.+takeM :: Dur t => t -> Media t a -> Media t a+takeM t = slice 0 t +++-- | @('dropM' t m)@ is equivalent to @('slice' t (dur m) m)@.+dropM :: Dur t => t -> Media t a -> Media t a+dropM t x = slice t (dur x) x+++-- | Reverses input.+reverseM :: Media t a -> Media t a+reverseM (Media t a) = Media t $+    case a of+        Reverse x -> x+        _         -> Reverse a++-- mappings ++instance Functor (Media t) where+    fmap f (Media t a) = Media t $ +            case a of+                Fmap f' a' -> Fmap (f . f') a'+                _          -> Fmap f a ++-- | General mapping. In the end all values of type 'Media' +-- are to be converted to 'EventList' wich is list of 'Event' s +-- and function 'eventMap' allows mapping on 'Media' subvalues as if +-- they are events already.+--+-- Warning : It is possible to change start time position with +-- 'eventMap' but it can lead to unexpected outcome when used +-- with 'slice' function. 'slice' operates on structure of +-- type 'Media' (how value was built with 'sequent', 'parallel'+-- or 'stretch' and other functions), but 'eventMap' operates +-- on 'Media' subvalues as if they are converted to 'Event' s +-- and some shifted events can slip through 'slice' 's fingers.+eventMap ::    +       (Event t a -> Event t a') +    -> (Media t a -> Media t a')+eventMap f (Media t a) = Media t $ +    case a of+        Emap f' a' -> Emap (f . f') a'+        _          -> Emap f a++-- | map with time+tmap :: (t -> a -> b) -> Media t a -> Media t b+tmap f = tdmap (flip $ const f)++-- | map with duration+dmap :: (t -> a -> b) -> Media t a -> Media t b+dmap f = tdmap (const f)++-- | map with time and duration +tdmap :: (t -> t -> a -> b) -> Media t a -> Media t b+tdmap f = eventMap $ \(Event t d a) -> Event t d $ f t d a++-- | Relative 'tmap'. Time values are normalized by argument's duration.   +tmapRel :: Dur t => (t -> a -> b) -> Media t a -> Media t b+tmapRel f x = tmap (f . ( / dur x)) x++-- | Relative 'dmap'.+dmapRel :: Dur t => (t -> a -> b) -> Media t a -> Media t b+dmapRel f x = dmap (f . ( / dur x)) x++-- | Relative 'tdmap'. +tdmapRel :: Dur t => (t -> t -> a -> b) -> Media t a -> Media t b+tdmapRel f x = tdmap (on f ( / dur x)) x++---------------------------------------------------------------+-- Misc++-- | Linear interpolation. Can be useful with 'eventMap' for +-- envelope changes.+--+-- linseg [a, da, b, db, c, ... ]+--+-- @a, b, c ...@ - values+--+-- @da, db, ...@ - duration of segments+linseg :: (Ord t, Fractional t) => [t] -> t -> t+linseg xs t = +    case xs of+        (a:dur:b:[])      -> seg a dur b t+        (a:dur:b:(x:xs')) -> if t < dur +                             then seg a dur b t+                             else linseg (b:x:xs') (t - dur)+    where seg a dur b t +                | t < 0     = a+                | t >= dur  = b+                | otherwise = a + (b - a)*(t/dur)++----------------------------------------------------------------+----------------------------------------------------------------+-- interpretation++-- | 'renderMedia' converts values of type 'Media' to+-- values of type 'EventList'. If some values have negative+-- time (it is possible through 'eventMap') all events are +-- shifted so that first event has zero start time. Events+-- are unsorted by start time.+renderMedia :: Dur t => Media t a -> EventList t a+renderMedia (Media totalDur m) = formEventList dt es+    where (es, dt) = runState (renderM totalDur initCtx m) dt0+          dt0 = (0, totalDur)  ++++formEventList :: Dur t +    => Interval t -> DList (Event t a) -> EventList t a+formEventList (t0, t1) es = +    EventList (t1 - t0) $ shiftEs $ toList es+    where shiftEs+            | t0 < 0    = map shiftEvent+            | otherwise = id+          shiftEvent e = e{eventStart = eventStart e - t0}   +                +++type MList t a = State (Interval t) (DList (Event t a))++renderM :: Dur t => t -> Ctx t a b -> M t a -> MList t b+renderM totalDur ctx m = +    case m of+     -- constructors+        None d   -> return empty+        Prim d x -> if isSlicePrim (ctxSlice ctx) (0, totalDur)+                        then return empty+                        else renderPrim (ctxTfm ctx) d x++        _        -> if isSliceComp (ctxSlice ctx) (0, totalDur)+                        then return empty+                        else +            case m of+           -- composition+                Seq xs   -> renderSeq ctx xs+                Par xs   -> renderPar ctx xs++                Loop n x -> renderLoop totalDur ctx n x++        -- transformation +                Stretch d x -> renderStretch ctx d x++                Slice dt x  -> renderSlice dt ctx x+                Reverse x   -> renderReverse totalDur ctx x++        -- mappings+                Fmap f m' -> renderFmap totalDur ctx f m'+                Emap f m' -> renderEmap totalDur ctx f m' ++   +renderPrim :: Dur t => Tfm t a b -> t -> a -> MList t b+renderPrim tfm d x = state $ +    \(t0, t1) -> let t0' = min t0 $ eventStart e+                     t1' = max t1 $ eventStart e + eventDur e+                 in  (singleton e, (t0', t1')) +    where e = appTfm tfm $ Event 0 d x+++renderSeq :: Dur t => Ctx t a b -> [(t, M t a)] -> MList t b+renderSeq ctx = fmap fst . foldM phi (empty, 0)+    where phi (res, d') (d, x) = fmap (\x -> (append res x, d' + d)) $ +                    renderM d (shiftCtx d' ctx) x++renderPar :: Dur t => Ctx t a b -> [(t, M t a)] -> MList t b+renderPar ctx = fmap (foldl' append empty) . mapM phi+    where phi (d, x) = renderM d ctx x+++renderLoop :: Dur t+    => t -> Ctx t a b -> Int -> (t, M t a) -> MList t b+renderLoop totalDur ctx n (d, x) = +    fmap (foldl' append empty) $ mapM phi ids +    where e   = renderM d initCtx x+          ids = loopIds (ctxSlice ctx) n d +          phi (segType, ds) =                +                case segType of+                    Part  -> renderM d ctx' x+                    Whole -> fmap (fmap (appTfm $ ctxTfm ctx')) e+                where ctx' = shiftCtx ds ctx++data LoopSeg = Part | Whole++-- ineffective / consider better solution++loopIds :: Dur t => [SliceSeg t] -> Int -> t -> [(LoopSeg, t)] +loopIds f n d = catMaybes $ map phi [0 .. n-1]+    where phi i+            | not $ isSlicePrim f dt = Just (Whole, fst dt)+            | not $ isSliceComp f dt = Just (Part,  fst dt)+            | otherwise              = Nothing+            where dt = (d * fromIntegral i, d)+                    ++++renderStretch :: Dur t+    => Ctx t a b -> t -> (t, M t a) -> MList t b+renderStretch ctx k (d, x) = +    renderM d (stretchCtx k ctx) x++renderSlice :: Dur t+    => Interval t -> Ctx t a b -> (t, M t a) -> MList t b+renderSlice (t0, t1) ctx (d, m) = +    renderM d (sliceCtx (t0, t1) ctx) m++renderReverse :: Dur t+    => t -> Ctx t a b ->  M t a -> MList t b+renderReverse totalDur ctx x = +    renderM totalDur (reverseCtx totalDur ctx) x++renderFmap :: Dur t+    => t -> Ctx t a b -> (a' -> a) -> M t a' -> MList t b+renderFmap totalDur ctx f m = +    renderM totalDur (appendFmapCtx f ctx) m++renderEmap :: Dur t+    => t -> Ctx t a b +    -> (Event t a' -> Event t a) -> M t a' -> MList t b+renderEmap totalDur ctx f m = +    renderM totalDur (appendEmapCtx f ctx) m+++------------------------------------------------------+-- utils++-- Types++data LinTfm t = LinTfm+    { linTfmStart :: (t, t, t)+    , linTfmDur   :: (t, t, t)+    }++type Tfm t a b = (LinTfm t, Event t a -> Event t b)++type Interval t = (t, t)++type SliceSeg t = (t, LinTfm t)++data Ctx t a b = Ctx+    { ctxSlice :: [SliceSeg t]+    , ctxTfm   :: (Tfm t a b)+    }++-----------------------------------------------------------+-- funs on++-- LinTfm++appLinTfm :: Num t => LinTfm t -> (t, t) -> (t, t)+appLinTfm lt (t, d) = (x11*t + x12*d + b1, x21*t + x22*d + b2)+    where (x11, x12, b1) = linTfmStart lt+          (x21, x22, b2) = linTfmDur   lt++idLinTfm :: Num t => LinTfm t+idLinTfm = LinTfm (1, 0, 0) (0, 1, 0)++shiftLinTfm :: Num t => t -> LinTfm t -> LinTfm t+shiftLinTfm k (LinTfm (x11, x12, b1) (x21, x22, b2)) =+    LinTfm (x11, x12, b1')+           (x21, x22, b2') +    where !b1' = k*x11 + b1+          !b2' = k*x21 + b2  ++stretchLinTfm :: Num t => t -> LinTfm t -> LinTfm t+stretchLinTfm k (LinTfm (x11, x12, b1) (x21, x22, b2)) = +    LinTfm (k*x11, k*x12, b1)+           (k*x21, k*x22, b2) ++reverseLinTfm :: Num t => t -> LinTfm t -> LinTfm t +reverseLinTfm totalDur (LinTfm (x11, x12, b1) (x21, x22, b2)) =+    LinTfm (-x11, x12 - x11, totalDur * x11 + b1)+           (-x21, x22 - x21, totalDur * x21 + b2) +            +-- Tfm++idTfm :: Num t => Tfm t a a+idTfm = (idLinTfm, id)++appTfm :: Dur t => Tfm t a b -> Event t a -> Event t b+appTfm (linTfm, f) = f . liftEv linTfm++liftEv :: Dur t => LinTfm t -> Event t a -> Event t a+liftEv lt (Event t d a) = Event t' d' a+    where (t', d') = appLinTfm lt (t, d)+ +appendFmap :: (a' -> a) -> Tfm t a b -> Tfm t a' b+appendFmap f = second ( . fmap f)++appendEmap :: Dur t => +       (Event t a' -> Event t a) +    -> (Tfm t a b  -> Tfm t a' b)+appendEmap f (linTfm, g) = (linTfm', resTfm)+    where linTfm' = idLinTfm+          resTfm  = g . liftEv linTfm . f  ++-- Interval++within :: Dur t => Interval t -> Interval t -> Bool+within (a', b') (a, b) =+       a' >= aEps && a' <= bEps +    && b' >= aEps && b' <= bEps+    where (aEps, bEps) = epsInterval (a, b)++outside :: Dur t => Interval t -> Interval t -> Bool+outside (a', b') (a, b) = b' < aEps || a' > bEps+    where (aEps, bEps) = epsInterval (a, b)        ++epsInterval :: Dur t => Interval t -> Interval t+epsInterval (a, b) = (a - eps, b + eps)+    where eps  = 1e-9++toInterval :: Dur t => (t, t) -> Interval t+toInterval (t, d) = (t, t + d)++-- SliceSeg++isSlicePrim, isSliceComp :: Dur t +    => [SliceSeg t] -> (t, t) -> Bool++isSlicePrim = isSlice (\a b -> not $ within a b)+isSliceComp = isSlice outside++isSlice :: Dur t +    => (Interval t -> Interval t -> Bool)+    -> [SliceSeg t] -> (t, t) -> Bool+isSlice pred xs dt = +    case xs of+        []           -> False+        (d, lt) : ts -> +            let dt' = appLinTfm lt dt+            in  if toInterval dt' `pred` (0, d)+                    then True+                    else isSlice pred ts dt'++-- Ctx++initCtx :: Dur t => Ctx t a a+initCtx = Ctx [] idTfm++shiftCtx :: Dur t => t -> Ctx t a b -> Ctx t a b+shiftCtx t = appendLinTfmCtx $ shiftLinTfm t++stretchCtx :: Dur t => t -> Ctx t a b -> Ctx t a b+stretchCtx t = appendLinTfmCtx $ stretchLinTfm t++sliceCtx :: Dur t => Interval t -> Ctx t a b -> Ctx t a b+sliceCtx (t0, t1) x = shiftCtx (-t0) $ x{+    ctxSlice = (totalDur, idLinTfm) : ctxSlice x}+    where totalDur = t1 - t0++reverseCtx :: Dur t => t -> Ctx t a b -> Ctx t a b+reverseCtx t = appendLinTfmCtx $ reverseLinTfm t++appendLinTfmCtx :: Dur t +    => (LinTfm t -> LinTfm t) +    -> Ctx t a b -> Ctx t a b+appendLinTfmCtx m x = appendSlice m $ x{ +    ctxTfm = first m $ ctxTfm x }+    where appendSlice m x+            | null $ ctxSlice x = x+            | otherwise         = x{ +                ctxSlice = onSeg m $ ctxSlice x}+          onSeg f (x:xs) = second f x : xs++appendFmapCtx :: Dur t => (a' -> a) -> Ctx t a b -> Ctx t a' b+appendFmapCtx = appendMapCtx . appendFmap++appendEmapCtx :: Dur t +    => (Event t a' -> Event t a) +    -> Ctx t a b -> Ctx t a' b+appendEmapCtx = appendMapCtx . appendEmap++appendMapCtx :: Dur t+    => (Tfm t a b -> Tfm t a' b)+    -> (Ctx t a b -> Ctx t a' b)+appendMapCtx f x = x{ ctxTfm = f $ ctxTfm x }+

@@ -1,149 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}--- | Special case of "Temporal.Media". Time is @Double@-module Temporal.Media.Double (-	-- * Time classes-	Dur, none, dur, stretch, ToMaybe(..), -    tmap, dmap, tdmap, -    sustain, sustainBy,-    tstretch, -    -- * Transformers-	Reversible(..), slice, take, drop, cut, -	-- * Structure -	Construct(..), Arrangeable(..), Controlable(..),-	sequent, parallel, loop, delay, temp,-	-- * Media-	Media(..), fold, fromMedia,-	-- * Simple interperetation-	-- ** Event list-	Event, EventList(..), -	mapEvent, toEvent, toEventList,-	-- ** Unit Media-	MediaUnit(..), unMediaUnit, foldU, fromMediaUnit,-	Unit(..),-    -- * Misc-    tmapRel, dmapRel, tdmapRel, tstretchRel, linseg-) -where--import Prelude hiding (take, drop, reverse)-import Control.Applicative--import qualified Temporal.Media as M-import Temporal.Media (-	ToMaybe(..),-	Reversible(..), -	Construct(..), Arrangeable(..), Controlable(..), -	sequent, parallel, loop,-	Media(..), fold, fromMedia, linseg)--------------------------------------------- Time -----type Time = Double-type Dur  = Double--none :: M.Temporal Dur a => Dur -> a-none = M.none--dur :: M.Temporal Dur a => a -> Dur-dur = M.dur--stretch :: M.Stretchable Dur a => Dur -> a -> a-stretch = M.stretch---- | temporal stretch-tstretch :: M.TemporalStretchable Dur a => (Time -> Dur) -> a -> a-tstretch = M.tstretch--tstretchRel :: M.TemporalStretchable Dur a => (Time -> Dur) -> a -> a-tstretchRel = M.tstretchRel--tmap :: M.TemporalFunctor Dur f => (Time -> a -> b) -> (f a -> f b)-tmap = M.tmap--dmap :: M.TemporalFunctor Dur f => (Dur -> a -> b) -> (f a -> f b)-dmap = M.dmap--tdmap :: M.TemporalFunctor Dur f => (Time -> Dur -> a -> b) -> (f a -> f b)-tdmap = M.tdmap---tmapRel :: (M.Temporal Dur (f a), M.TemporalFunctor Dur f) => (Time -> a -> b) -> (f a -> f b)-tmapRel = M.tmapRel--dmapRel :: (M.Temporal Dur (f a), M.TemporalFunctor Dur f) => (Dur -> a -> b) -> (f a -> f b)-dmapRel = M.dmapRel--tdmapRel :: (M.Temporal Dur (f a), M.TemporalFunctor Dur f) => (Time -> Dur -> a -> b) -> (f a -> f b)-tdmapRel = M.tdmapRel--sustain :: M.Sustainable Dur f => Dur -> f a -> f a-sustain = M.sustain--sustainBy :: M.Sustainable Dur f => (Dur -> Dur -> a -> (b, Dur)) -> f a -> f b-sustainBy = M.sustainBy------------------------------------------------- transformers--slice :: M.Sliceable Dur a => Dur -> Dur -> a -> a-slice = M.slice--take :: M.Sliceable Dur a => Dur -> a -> a-take = M.take--drop :: M.Sliceable Dur a => Dur -> a -> a-drop = M.drop--cut :: (Reversible a, M.Sliceable Dur a) => Dur -> Dur -> a -> a-cut = M.cut------------------------------------------------- Structure--delay :: (M.Temporal Dur a, Arrangeable a) => Dur -> a -> a-delay = M.delay--temp :: (Construct m, M.Temporal Dur (m a), M.Stretchable Dur (m a)) -	=> Dur -> a -> m a-temp = M.temp-	---------------------------------------------- --- EventList--type Event a     = M.Event Dur a-type EventList a = M.EventList Dur a--mapEvent :: (a -> b) -> Event a -> Event b-mapEvent = M.mapEvent--toEvent :: (M.Temporal Dur (m a), ToMaybe m) => m a -> EventList a-toEvent = M.toEvent--toEventList :: (M.Temporal Dur (m a), ToMaybe m) -	=> (c -> EventList a -> EventList a) -	-> Media c (m a) -> EventList a-toEventList = M.toEventList------------------------------------------------- MediaUnit--type MediaUnit c a = M.MediaUnit Dur c a--unMediaUnit :: MediaUnit c a -> Media c (Unit a)-unMediaUnit = M.unMediaUnit--foldU :: (Dur -> a -> b) -> (b -> b -> b) -> (b -> b -> b) -> (c -> b -> b)-	-> MediaUnit c a -> Maybe b-foldU = M.foldU--fromMediaUnit :: (c -> EventList a -> EventList a) -> MediaUnit c a -> EventList a-fromMediaUnit = M.fromMediaUnit------------------------------------------------- Temp--type Unit a = M.Unit Dur a-

@@ -1,12 +1,16 @@ Name:          temporal-media-Version:       0.1.1+Version:       0.2.0 License-file:  LICENSE Cabal-Version: >= 1.2 License:       BSD3 Author:	       Anton Kholomiov Maintainer:    <anton.kholomiov@gmail.com> Synopsis:      data types for temporal media-Description:   +Description:  +      An embedded domain-specific language (EDSL) for +      creating lists of constant time events related in time.+      Combinators are optimized in fusion style.+       Ispired by the paper /An Algebraic Theory of Polymorphic Temporal Media/,        Paul Hudak        <http://haskell.cs.yale.edu/yale/papers/polymedia/hudak-RR-1259.pdf>, @@ -20,9 +24,7 @@  Library   Build-Depends:-        base >= 4, base < 5, containers >= 0.3+        base >= 4, base < 5, mtl >= 2, dlist >= 0.5   Hs-Source-Dirs:      src/   Exposed-Modules:         Temporal.Media-        Temporal.Media.Double-