temporal-media (empty) → 0.0

raw patch · 5 files changed

+623/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

LICENSE +30/−0
Setup.hs +2/−0
src/Temporal/Media.hs +449/−0
src/Temporal/Media/Double.hs +114/−0
temporal-media.cabal +28/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Anton Kholomiov 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Anton Kholomiov nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ src/Temporal/Media.hs view

@@ -0,0 +1,449 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+module Temporal.Media (+	-- * Time classes+	Dur(..), Temporal(..), Stretchable(..), +	ToMaybe(..), TemporalFunctor(..),+	-- * 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(..)+)+where++import Control.Applicative+import Control.Monad++import Data.Function+import Data.Ratio++import Prelude hiding (reverse, take, drop)+import qualified Prelude as P (reverse)++-------------------------------------------------+-- 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 Dur t => 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+class Dur t => TemporalFunctor t f where+	tmap :: (t -> a -> b) -> f a -> f b++---------------------------------------------------+-- 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+++-- 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+	    | 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 imterpretation+--+-- 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+	tmap f (EventList t es) = EventList t $ map (tmapEvent f) es+		where tmapEvent f (t, dt, a) = (t, dt, f 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+	tmap f (MediaUnit t m) = MediaUnit t $ fmap (tmap f) m ++-- 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 $ reverse $ m++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 (dur a + dur b) $ (unMediaUnit a) +:+ (unMediaUnit b)+	a =:= b +	     | ta < tb   = f tb (a' +:+ none (tb - ta)) b'+	     | ta > tb   = f ta (b' +:+ none (ta - tb)) a'+	     | otherwise = f ta a' b'+		where ta = dur a+		      tb = dur b+		      a' = unMediaUnit a+		      b' = unMediaUnit b+		      f t a b = MediaUnit t $ 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+	tmap f (Unit t a) = Unit t $ fmap (f t) a++-- 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+

+ src/Temporal/Media/Double.hs view

@@ -0,0 +1,114 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+-- | Special case of "Temporal.Media". Time is @Double@+module Temporal.Media.Double (+	-- * Time classes+	Dur, none, dur, stretch, ToMaybe(..), tmap,+	-- * 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(..)+) +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)++----------------------------------------+-- Time +--++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++tmap :: M.TemporalFunctor Dur f => (Dur -> a -> b) -> (f a -> f b)+tmap = M.tmap++--------------------------------------------+-- 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+

+ temporal-media.cabal view

@@ -0,0 +1,28 @@+Name:          temporal-media+Version:       0.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:   +      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>, +      Haskore and Hommage++Category:      Media, Music+Stability:     Experimental+Tested-With:   GHC==6.13.1+Build-Type:    Simple+++Library+  Build-Depends:+        base >= 4, base < 5+  Hs-Source-Dirs:      src/+  Exposed-Modules:+        Temporal.Media+        Temporal.Media.Double+