varying 0.3.0.1 → 0.4.0.0
raw patch · 12 files changed
+550/−364 lines, 12 filesdep +QuickCheckdep +hspecdep +varyingdep ~basedep ~transformers
Dependencies added: QuickCheck, hspec, varying
Dependency ranges changed: base, transformers
Files
- README.md +15/−10
- app/Main.hs +66/−0
- changelog.md +6/−0
- src/Control/Varying.hs +1/−1
- src/Control/Varying/Core.hs +120/−97
- src/Control/Varying/Event.hs +58/−42
- src/Control/Varying/Spline.hs +128/−126
- src/Control/Varying/Time.hs +10/−9
- src/Control/Varying/Tween.hs +12/−12
- src/Example.hs +0/−62
- test/Main.hs +107/−0
- varying.cabal +27/−5
README.md view
@@ -18,6 +18,7 @@ import Control.Varying import Control.Applicative import Text.Printf+import Data.Functor.Identity -- | A simple 2d point type. data Point = Point { px :: Float@@ -28,7 +29,7 @@ -- loops forever. This spline takes float values of delta time as input, -- outputs the current x value at every step and would result in () if it -- terminated.-tweenx :: (Applicative m, Monad m) => Spline Float Float m ()+tweenx :: (Applicative m, Monad m) => SplineT Float Float m () tweenx = do -- Tween from 0 to 100 over 1 second x <- tween easeOutExpo 0 100 1@@ -39,24 +40,24 @@ -- A quadratic tween back and forth from 0 to 100 over 2 seconds that never -- ends.-tweeny :: (Applicative m, Monad m) => Spline Float Float m ()+tweeny :: (Applicative m, Monad m) => SplineT Float Float m () tweeny = do y <- tween easeOutQuad 0 100 1 _ <- tween easeOutQuad y 0 1 tweeny -- Our time signal that provides delta time samples.-time :: Var IO a Float+time :: VarT IO a Float time = deltaUTC -- | Our Point value that varies over time continuously in x and y.-backAndForth :: Var IO a Point+backAndForth :: VarT IO a Point backAndForth =- -- Turn our splines back into continuous value streams. We must provide+ -- Turn our splines into continuous output streams. We must provide -- a starting value since splines are not guaranteed to be defined at -- their edges.- let x = execSpline 0 tweenx- y = execSpline 0 tweeny+ let x = outputStream 0 tweenx+ y = outputStream 0 tweeny in -- Construct a varying Point that takes time as an input. (Point <$> x <*> y)@@ -68,10 +69,14 @@ main :: IO () main = do- putStrLn "Varying Example"+ putStrLn "An example of value streams using the varying library."+ putStrLn "Enter a newline to continue, quit with ctrl+c"+ _ <- getLine+ loop backAndForth- where loop :: Var IO () Point -> IO ()- loop v = do (point, vNext) <- runVar v ()+ where loop :: VarT IO () Point -> IO ()+ loop v = do (point, vNext) <- runVarT v () printf "\nPoint %03.1f %03.1f" (px point) (py point) loop vNext+ ```
+ app/Main.hs view
@@ -0,0 +1,66 @@+module Main where++import Control.Varying+import Control.Applicative+import Text.Printf+import Data.Functor.Identity++-- | A simple 2d point type.+data Point = Point { px :: Float+ , py :: Float+ } deriving (Show, Eq)++-- An exponential tween back and forth from 0 to 100 over 2 seconds that+-- loops forever. This spline takes float values of delta time as input,+-- outputs the current x value at every step and would result in () if it+-- terminated.+tweenx :: (Applicative m, Monad m) => SplineT Float Float m ()+tweenx = do+ -- Tween from 0 to 100 over 1 second+ x <- tween easeOutExpo 0 100 1+ -- Chain another tween back to the starting position+ _ <- tween easeOutExpo x 0 1+ -- Loop forever+ tweenx++-- A quadratic tween back and forth from 0 to 100 over 2 seconds that never+-- ends.+tweeny :: (Applicative m, Monad m) => SplineT Float Float m ()+tweeny = do+ y <- tween easeOutQuad 0 100 1+ _ <- tween easeOutQuad y 0 1+ tweeny++-- Our time signal that provides delta time samples.+time :: VarT IO a Float+time = deltaUTC++-- | Our Point value that varies over time continuously in x and y.+backAndForth :: VarT IO a Point+backAndForth =+ -- Turn our splines into continuous output streams. We must provide+ -- a starting value since splines are not guaranteed to be defined at+ -- their edges.+ let x = outputStream 0 tweenx+ y = outputStream 0 tweeny+ in+ -- Construct a varying Point that takes time as an input.+ (Point <$> x <*> y)+ -- Stream in a time signal using the 'plug left' combinator.+ -- We could similarly use the 'plug right' (~>) function+ -- and put the time signal before the construction above. This is needed+ -- because the tween streams take time as an input.+ <~ time++main :: IO ()+main = do+ putStrLn "An example of value streams using the varying library."+ putStrLn "Enter a newline to continue, quit with ctrl+c"+ _ <- getLine++ loop backAndForth+ where loop :: VarT IO () Point -> IO ()+ loop v = do (point, vNext) <- runVarT v ()+ printf "\nPoint %03.1f %03.1f" (px point) (py point)+ loop vNext+
changelog.md view
@@ -2,7 +2,13 @@ ========== 0.1.5.0 - added Control.Varying.Spline+ 0.2.0.0 - reordered spline type variables for MonadTrans+ 0.3.0.0 - updated the type of mapOutput to a more friendly, usable signature bug fixes +0.3.1.0 - added stepMany, eitherE++0.4.0.0 - Var and Spline are now parameterized with Identity, removed mix, changed+ the behavior of race, added untilEvent variants, added tests.
src/Control/Varying.hs view
@@ -6,7 +6,7 @@ -- -- [@Core@] -- Get started writing value streams using the pure constructor 'var', the--- monadic constructor 'varM' or the raw constructor 'Var'+-- monadic constructor 'varM' or the raw constructor 'VarT' -- -- [@Event@] -- Write event streams using the many event emitters and combinators.
src/Control/Varying/Core.hs view
@@ -7,12 +7,13 @@ -- Value streams represent values that change over a given domain. -- -- A stream takes some input (the domain e.g. time, place, etc) and when--- sampled using 'runVar' - produces a value and a new value stream. This+-- sampled using 'runVarT' - produces a value and a new value stream. This -- pattern is known as an automaton. `varying` uses this pattern as its base -- type with the additon of a monadic computation to create locally stateful -- signals that change over some domain. module Control.Varying.Core (- Var(..),+ Var,+ VarT(..), -- * Creating value streams -- $creation var,@@ -33,6 +34,8 @@ loopVar_, whileVar, whileVar_,+ scanVar,+ stepMany, -- * Testing value streams testVar, testVar_,@@ -45,9 +48,10 @@ import Prelude hiding (id, (.)) import Control.Arrow import Control.Category-import Control.Monad (when)+import Control.Monad import Control.Applicative import Data.Monoid+import Data.Functor.Identity import Debug.Trace -------------------------------------------------------------------------------- -- $creation@@ -55,7 +59,7 @@ -- with 'var': -- -- @--- addsOne :: Monad m => Var m Int Int+-- addsOne :: Monad m => VarT m Int Int -- addsOne = var (+1) -- @ --@@ -65,7 +69,7 @@ -- @(a -> m b)@ using 'varM': -- -- @--- getsFile :: Var IO FilePath String+-- getsFile :: VarT IO FilePath String -- getsFile = varM readFile -- @ --@@ -74,120 +78,134 @@ -- over how value streams are stepped and sampled: -- -- @--- delay :: Monad m => b -> Var m a b -> Var m a b--- delay b v = Var $ \a -> return (b, go a v)--- where go a v' = Var $ \a' -> do (b', v'') <- runVar v' a+-- delay :: Monad m => b -> VarT m a b -> VarT m a b+-- delay b v = VarT $ \a -> return (b, go a v)+-- where go a v' = VarT $ \a' -> do (b', v'') <- runVarT v' a -- return (b', go a' v'') -- @ -- ----------------------------------------------------------------------------------- | Lift a pure computation into a 'Var'.-var :: Applicative a => (b -> c) -> Var a b c-var f = Var $ \a -> pure (f a, var f)+-- | Lift a pure computation into a stream.+var :: Applicative m => (a -> b) -> VarT m a b+var f = VarT $ \a -> pure (f a, var f) --- | Lift a monadic computation into a 'Var'.-varM :: Monad m => (a -> m b) -> Var m a b-varM f = Var $ \a -> do+-- | Lift a monadic computation into a stream.+varM :: Monad m => (a -> m b) -> VarT m a b+varM f = VarT $ \a -> do b <- f a return (b, varM f) --- | Create a 'Var' from a state transformer.+-- | Create a stream from a state transformer. mkState :: Monad m => (a -> s -> (b, s)) -- ^ state transformer -> s -- ^ intial state- -> Var m a b-mkState f s = Var $ \a -> do+ -> VarT m a b+mkState f s = VarT $ \a -> do let (b', s') = f a s return (b', mkState f s') -------------------------------------------------------------------------------- -- $running -- The easiest way to sample a stream is to run it in the desired monad with--- 'runVar'. This will produce a sample value and a new stream.+-- 'runVarT'. This will produce a sample value and a new stream. ----- > do (sample, v') <- runVar v inputValue+-- > do (sample, v') <- runVarT v inputValue -- -- Much like Control.Monad.State there are other entry points for running -- value streams like 'evalVar', 'execVar'. There are also extra control -- structures such as 'loopVar' and 'whileVar'. ----------------------------------------------------------------------------------- | Iterate a 'Var' once and return the sample value.-evalVar :: Functor m => Var m a b -> a -> m b-evalVar v a = fst <$> runVar v a+-- | Iterate a stream once and return the sample value.+evalVar :: Functor m => VarT m a b -> a -> m b+evalVar v a = fst <$> runVarT v a --- | Iterate a 'Var' once and return the next 'Var'.-execVar :: Functor m => Var m a b -> a -> m (Var m a b)-execVar v a = snd <$> runVar v a+-- | Iterate a stream once and return the next stream.+execVar :: Functor m => VarT m a b -> a -> m (VarT m a b)+execVar v a = snd <$> runVarT v a --- | Loop over a 'Var' that takes no input value.-loopVar_ :: (Functor m, Monad m) => Var m () a -> m ()+-- | Loop over a stream that takes no input value.+loopVar_ :: (Functor m, Monad m) => VarT m () a -> m () loopVar_ v = execVar v () >>= loopVar_ --- | Loop over a 'Var' that produces its own next input value.-loopVar :: Monad m => a -> Var m a a -> m a-loopVar a v = runVar v a >>= uncurry loopVar+-- | Loop over a stream that produces its own next input value.+loopVar :: Monad m => a -> VarT m a a -> m a+loopVar a v = runVarT v a >>= uncurry loopVar --- | Iterate a 'Var' that requires no input until the given predicate fails.-whileVar_ :: Monad m => (a -> Bool) -> Var m () a -> m a+-- | Iterate a stream that requires no input until the given predicate fails.+whileVar_ :: Monad m => (a -> Bool) -> VarT m () a -> m a whileVar_ f v = do- (a, v') <- runVar v ()+ (a, v') <- runVarT v () if f a then whileVar_ f v' else return a --- | Iterate a 'Var' that produces its own next input value until the given+-- | Iterate a stream that produces its own next input value until the given -- predicate fails. whileVar :: Monad m => (a -> Bool) -- ^ The predicate to evaluate samples. -> a -- ^ The initial input/sample value.- -> Var m a a -- ^ The 'Var' to iterate+ -> VarT m a a -- ^ The stream to iterate -> m a -- ^ The last sample whileVar f a v = if f a- then runVar v a >>= uncurry (whileVar f)+ then runVarT v a >>= uncurry (whileVar f) else return a++-- | Iterate a stream using a list of input until all input is consumed and+-- output the result.+stepMany :: (Monad m, Functor m, Monoid a) => [a] -> VarT m a b -> m (b, VarT m a b)+stepMany ([e]) y = runVarT y e+stepMany (e:es) y = execVar y e >>= stepMany es+stepMany [] y = runVarT y mempty++-- | Run the stream over the input values, gathering the output values in a +-- list. +scanVar :: (Applicative m, Monad m) => VarT m a b -> [a] -> m [b]+scanVar v = liftM snd . foldM f (v,[])+ where f (v', outs) a = do (b, v'') <- runVarT v' a+ return (v'', outs ++ [b]) -------------------------------------------------------------------------------- -- Testing and debugging ----------------------------------------------------------------------------------- | Trace the sample value of a 'Var' and pass it along as output. This is--- very useful for debugging graphs of 'Var's.-vtrace :: (Applicative a, Show b) => Var a b b+-- | Trace the sample value of a stream and pass it along as output. This is+-- very useful for debugging graphs of streams.+vtrace :: (Applicative a, Show b) => VarT a b b vtrace = vstrace "" --- | Trace the sample value of a 'Var' with a prefix and pass the sample along--- as output. This is very useful for debugging graphs of 'Var's.-vstrace :: (Applicative a, Show b) => String -> Var a b b+-- | Trace the sample value of a stream with a prefix and pass the sample along+-- as output. This is very useful for debugging graphs of streams.+vstrace :: (Applicative a, Show b) => String -> VarT a b b vstrace s = vftrace ((s ++) . show) -- | Trace the sample value after being run through a "show" function.--- This is very useful for debugging graphs of 'Var's.-vftrace :: Applicative a => (b -> String) -> Var a b b+-- This is very useful for debugging graphs of streams.+vftrace :: Applicative a => (b -> String) -> VarT a b b vftrace f = var $ \b -> trace (f b) b --- | A utility function for testing 'Var's that don't require input. Runs--- a 'Var' printing each sample until the given predicate fails.-testWhile_ :: Show a => (a -> Bool) -> Var IO () a -> IO ()+-- | A utility function for testing streams that don't require input. Runs+-- a stream printing each sample until the given predicate fails.+testWhile_ :: Show a => (a -> Bool) -> VarT IO () a -> IO () testWhile_ f v = do- (a, v') <- runVar v ()+ (a, v') <- runVarT v () when (f a) $ print a >> testWhile_ f v' --- | A utility function for testing 'Var's that require input. The input--- must have a 'Read' instance. Use this in GHCI to step through your 'Var's+-- | A utility function for testing streams that require input. The input+-- must have a 'Read' instance. Use this in GHCI to step through your streams -- by typing the input and hitting `return`.-testVar :: (Read a, Show b) => Var IO a b -> IO ()+testVar :: (Read a, Show b) => VarT IO a b -> IO () testVar v = loopVar_ $ varM (const $ putStrLn "input: ") ~> varM (const getLine) ~> var read ~> v ~> varM print --- | A utility function for testing 'Var's that don't require input. Use--- this in GHCI to step through your 'Var's using the `return` key.-testVar_ :: Show b => Var IO () b -> IO ()+-- | A utility function for testing streams that don't require input. Use+-- this in GHCI to step through your streams using the `return` key.+testVar_ :: Show b => VarT IO () b -> IO () testVar_ v = loopVar_ $ pure () ~> v ~> varM print ~> varM (const getLine) -------------------------------------------------------------------------------- -- Adjusting and accumulating -------------------------------------------------------------------------------- -- | Accumulates input values using a folding function and yields -- that accumulated value each sample.-accumulate :: Monad m => (c -> b -> c) -> c -> Var m b c-accumulate f b = Var $ \a -> do+accumulate :: Monad m => (c -> b -> c) -> c -> VarT m b c+accumulate f b = VarT $ \a -> do let b' = f b a return (b', accumulate f b') @@ -196,10 +214,10 @@ -- themselves for values. For example: -- -- > let v = 1 + delay 0 v in testVar_ v-delay :: Monad m => b -> Var m a b -> Var m a b-delay b v = Var $ \a -> return (b, go a v)- where go a v' = Var $ \a' -> do (b', v'') <- runVar v' a- return (b', go a' v'')+delay :: Monad m => b -> VarT m a b -> VarT m a b+delay b v = VarT $ \a -> return (b, go a v)+ where go a v' = VarT $ \a' -> do (b', v'') <- runVarT v' a+ return (b', go a' v'') -------------------------------------------------------------------------------- -- $composition -- You can compose value streams together using '~>' and '<~'. The "right plug"@@ -209,27 +227,27 @@ -- streams that read naturally. -------------------------------------------------------------------------------- -- | Same as '~>' with flipped parameters.-(<~) :: Monad m => Var m b c -> Var m a b -> Var m a c+(<~) :: Monad m => VarT m b c -> VarT m a b -> VarT m a c (<~) = flip (~>) infixl 1 <~ --- | Connects two 'Var's by chaining the first's output into the input of the--- second. This is the defacto 'Var' composition method and in fact '.' is an+-- | Connects two streams by chaining the first's output into the input of the+-- second. This is the defacto stream composition method and in fact '.' is an -- alias of '<~', which is just '~>' flipped.-(~>) :: Monad m => Var m a b -> Var m b c -> Var m a c-(~>) v1 v2 = Var $ \a -> do- (b, v1') <- runVar v1 a- (c, v2') <- runVar v2 b+(~>) :: Monad m => VarT m a b -> VarT m b c -> VarT m a c+(~>) v1 v2 = VarT $ \a -> do+ (b, v1') <- runVarT v1 a+ (c, v2') <- runVarT v2 b return (c, v1' ~> v2') infixr 1 ~> -------------------------------------------------------------------------------- -- Typeclass instances ----------------------------------------------------------------------------------- | You can transform the sample value of any 'Var':+-- | You can transform the sample value of any stream: -- -- > fmap (*3) $ accumulate (+) 0 -- Will sum input values and then multiply the sum by 3.-instance (Applicative m, Monad m) => Functor (Var m b) where+instance (Applicative m, Monad m) => Functor (VarT m b) where fmap f' v = v ~> var f' -- | A very simple category instance.@@ -244,20 +262,20 @@ -- -- It is preferable for consistency (and readability) to use 'plug left' ('<~') -- and 'plug right' ('~>') instead of ('.') where possible.-instance (Applicative m, Monad m) => Category (Var m) where+instance (Applicative m, Monad m) => Category (VarT m) where id = var id f . g = g ~> f --- | 'Var's are applicative.+-- | Streams are applicative. -- -- > (,) <$> pure True <*> var "Applicative"-instance (Applicative m, Monad m) => Applicative (Var m a) where+instance (Applicative m, Monad m) => Applicative (VarT m a) where pure = var . const- vf <*> va = Var $ \a -> do (f, vf') <- runVar vf a- (b, va') <- runVar va a- return (f b, vf' <*> va')+ vf <*> va = VarT $ \a -> do (f, vf') <- runVarT vf a+ (b, va') <- runVarT va a+ return (f b, vf' <*> va') --- | 'Var's are arrows, which means you can use proc notation.+-- | Streams are arrows, which means you can use proc notation. -- -- @ -- v = proc a -> do@@ -268,23 +286,23 @@ -- which is equivalent to -- -- > v = (\ex ey -> (+) <$> ex <*> ey) <$> intEventVar <*> anotherIntEventVar-instance (Applicative m, Monad m) => Arrow (Var m) where+instance (Applicative m, Monad m) => Arrow (VarT m) where arr = var- first v = Var $ \(b,d) -> do (c, v') <- runVar v b- return ((c,d), first v')+ first v = VarT $ \(b,d) -> do (c, v') <- runVarT v b+ return ((c,d), first v') --- | 'Var's can be monoids+-- | Streams can be monoids -- -- > let v = var (const "Hello ") `mappend` var (const "World!")-instance (Applicative m, Monad m, Monoid b) => Monoid (Var m a b) where+instance (Applicative m, Monad m, Monoid b) => Monoid (VarT m a b) where mempty = pure mempty mappend = liftA2 mappend --- | 'Var's can be written as numbers.+-- | Streams can be written as numbers. -- -- > let v = 1 ~> accumulate (+) 0 -- which will sum the natural numbers.-instance (Applicative m, Monad m, Num b) => Num (Var m a b) where+instance (Applicative m, Monad m, Num b) => Num (VarT m a b) where (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*)@@ -292,11 +310,11 @@ signum = fmap signum fromInteger = pure . fromInteger --- | 'Var's can be written as floats.+-- | Streams can be written as floats. -- -- > let v = pi ~> accumulate (*) 0.0 -- which will attempt (and succeed) to multiply pi by zero every step.-instance (Applicative m, Monad m, Floating b) => Floating (Var m a b) where+instance (Applicative m, Monad m, Floating b) => Floating (VarT m a b) where pi = pure pi exp = fmap exp log = fmap log@@ -304,23 +322,28 @@ cos = fmap cos; cosh = fmap cosh; acos = fmap acos; acosh = fmap acosh atan = fmap atan; atanh = fmap atanh --- | 'Var's can be written as fractionals.+-- | Streams can be written as fractionals. -- -- > let v = 2.5 ~> accumulate (+) 0 -- which will add 2.5 each step.-instance (Applicative m, Monad m, Fractional b) => Fractional (Var m a b) where+instance (Applicative m, Monad m, Fractional b) => Fractional (VarT m a b) where (/) = liftA2 (/) fromRational = pure . fromRational -------------------------------------------------------------------------------- -- Core datatypes ----------------------------------------------------------------------------------- | The vessel of a value stream. A 'Var' is a structure that contains a value--- that changes over some input. That input could be time (Float, Double, etc)--- or 'Control.Varying.Event.Event's or 'Char' - whatever.--- It's a kind of Mealy machine (an automaton) with effects.-data Var m b c =- Var { runVar :: b -> m (c, Var m b c)- -- ^ Given an input value, return a computation that- -- effectfully produces an output value (a sample) and a 'Var'- -- for producing the next sample.- }+-- | A value stream parameterized with Identity that takes input of type @a@+-- and gives output of type @b@. This is the pure, effect-free version of+-- 'VarT'.+type Var a b = VarT Identity a b++-- | A value stream is a structure that contains a value that changes over some +-- input. It's a kind of Mealy machine (an automaton) with effects. Using+-- 'runVarT' with an input value of type 'a' yields a "step", which is a value +-- of type 'b' and a new 'VarT' for yielding the next value.+data VarT m a b =+ VarT { runVarT :: a -> m (b, VarT m a b)+ -- ^ Given an input value, return a computation that effectfully + -- produces an output value and a new stream for producing the next + -- sample.+ }
src/Control/Varying/Event.hs view
@@ -6,7 +6,7 @@ -- -- 'Event' streams describe things that happen at a specific domain. -- For example, you can think of the event stream--- @Var IO Double (Event ())@ as an occurrence of () at a specific input+-- @VarT IO Double (Event ())@ as an occurrence of () at a specific input -- of type 'Double'. -- -- For sequencing streams please check out 'Control.Varying.Spline' which@@ -27,6 +27,8 @@ -- * Folding and gathering event streams foldStream, startingWith, startWith,+ -- * Using multiple streams+ eitherE, -- * List-like operations on event streams filterE, takeE,@@ -65,10 +67,10 @@ -------------------------------------------------------------------------------- -- | Produces values from the first unless the second produces event -- values and if so, produces the values of those events.-orE :: (Applicative m, Monad m) => Var m a b -> Var m a (Event b) -> Var m a b-orE y ye = Var $ \a -> do- (b, y') <- runVar y a- (e, ye') <- runVar ye a+orE :: (Applicative m, Monad m) => VarT m a b -> VarT m a (Event b) -> VarT m a b+orE y ye = VarT $ \a -> do+ (b, y') <- runVarT y a+ (e, ye') <- runVarT ye a return $ case e of NoEvent -> (b, orE y' ye') Event b' -> (b', orE y' ye')@@ -85,32 +87,32 @@ use a v = (a <$) <$> v -- | Triggers an `Event ()` when the input value is True.-onTrue :: (Applicative m, Monad m) => Var m Bool (Event ())+onTrue :: (Applicative m, Monad m) => VarT m Bool (Event ()) onTrue = var $ \b -> if b then Event () else NoEvent -- | Triggers an `Event a` when the input is `Just a`.-onJust :: (Applicative m, Monad m) => Var m (Maybe a) (Event a)+onJust :: (Applicative m, Monad m) => VarT m (Maybe a) (Event a) onJust = var $ \ma -> case ma of Nothing -> NoEvent Just a -> Event a -- | Triggers an `Event a` when the input is a unique value.-onUnique :: (Applicative m, Monad m, Eq a) => Var m a (Event a)-onUnique = Var $ \a -> return (Event a, trigger a)- where trigger a' = Var $ \a'' -> let e = if a' == a''+onUnique :: (Applicative m, Monad m, Eq a) => VarT m a (Event a)+onUnique = VarT $ \a -> return (Event a, trigger a)+ where trigger a' = VarT $ \a'' -> let e = if a' == a'' then NoEvent else Event a'' in return (e, trigger a'') -- | Triggers an `Event a` when the condition is met.-onWhen :: Applicative m => (a -> Bool) -> Var m a (Event a)+onWhen :: Applicative m => (a -> Bool) -> VarT m a (Event a) onWhen f = var $ \a -> if f a then Event a else NoEvent -------------------------------------------------------------------------------- -- Collecting -------------------------------------------------------------------------------- -- | Like a left fold over all the stream's produced values.-foldStream :: Monad m => (a -> t -> a) -> a -> Var m (Event t) a-foldStream f acc = Var $ \e ->+foldStream :: Monad m => (a -> t -> a) -> a -> VarT m (Event t) a+foldStream f acc = VarT $ \e -> case e of Event a -> let acc' = f acc a in return (acc', foldStream f acc')@@ -122,64 +124,78 @@ -- @ -- time ~> after 3 ~> startingWith 0 -- @-startingWith, startWith :: (Applicative m, Monad m) => a -> Var m (Event a) a+startingWith, startWith :: (Applicative m, Monad m) => a -> VarT m (Event a) a startingWith = startWith startWith = foldStream (\_ a -> a) -- | Stream through some number of successful events and then inhibit forever. takeE :: (Applicative m, Monad m)- => Int -> Var m a (Event b) -> Var m a (Event b)+ => Int -> VarT m a (Event b) -> VarT m a (Event b) takeE 0 _ = never-takeE n ve = Var $ \a -> do- (eb, ve') <- runVar ve a+takeE n ve = VarT $ \a -> do+ (eb, ve') <- runVarT ve a case eb of NoEvent -> return (NoEvent, takeE n ve') Event b -> return (Event b, takeE (n-1) ve') -- | Inhibit the first n occurences of an event. dropE :: (Applicative m, Monad m)- => Int -> Var m a (Event b) -> Var m a (Event b)+ => Int -> VarT m a (Event b) -> VarT m a (Event b) dropE 0 ve = ve-dropE n ve = Var $ \a -> do- (eb, ve') <- runVar ve a+dropE n ve = VarT $ \a -> do+ (eb, ve') <- runVarT ve a case eb of NoEvent -> return (NoEvent, dropE n ve') Event _ -> return (NoEvent, dropE (n-1) ve') -- | Inhibit all events that don't pass the predicate. filterE :: (Applicative m, Monad m)- => (b -> Bool) -> Var m a (Event b) -> Var m a (Event b)+ => (b -> Bool) -> VarT m a (Event b) -> VarT m a (Event b) filterE p v = v ~> var check where check (Event b) = if p b then Event b else NoEvent check _ = NoEvent --------------------------------------------------------------------------------+-- Using multiple streams+--------------------------------------------------------------------------------+-- | If the left event stream produces a value, wrap the value in 'Left' and+-- produce that value, else if the right event stream produces a value,+-- wrap the value in 'Right' and produce that value, else inhibit.+eitherE :: (Applicative m, Monad m) + => VarT m a (Event b) -> VarT m a (Event c) + -> VarT m a (Event (Either b c))+eitherE vb vc = f <$> vb <*> vc+ where f (Event b) _ = Event $ Left b+ f _ (Event c) = Event $ Right c+ f _ _ = NoEvent+-------------------------------------------------------------------------------- -- Primitive event streams -------------------------------------------------------------------------------- -- | Produce the given value once and then inhibit forever.-once :: (Applicative m, Monad m) => b -> Var m a (Event b)-once b = Var $ \_ -> return (Event b, never)+once :: (Applicative m, Monad m) => b -> VarT m a (Event b)+once b = VarT $ \_ -> return (Event b, never) -- | Never produces any event values.-never :: (Applicative m, Monad m) => Var m b (Event c)+never :: (Applicative m, Monad m) => VarT m b (Event c) never = pure NoEvent -- | Produces events with the initial value forever.-always :: (Applicative m, Monad m) => b -> Var m a (Event b)+always :: (Applicative m, Monad m) => b -> VarT m a (Event b) always = pure . Event+ -------------------------------------------------------------------------------- -- Switching -------------------------------------------------------------------------------- -- | Switches using a mode signal. Streams maintain state only for the duration -- of the mode. switchByMode :: (Applicative m, Monad m, Eq b)- => Var m a b -> (b -> Var m a c) -> Var m a c-switchByMode switch f = Var $ \a -> do- (b, _) <- runVar switch a- (_, v) <- runVar (f b) a- runVar (switchOnUnique v $ switch ~> onUnique) a- where switchOnUnique v sv = Var $ \a -> do- (eb, sv') <- runVar sv a- (c', v') <- runVar (vOf eb) a+ => VarT m a b -> (b -> VarT m a c) -> VarT m a c+switchByMode switch f = VarT $ \a -> do+ (b, _) <- runVarT switch a+ (_, v) <- runVarT (f b) a+ runVarT (switchOnUnique v $ switch ~> onUnique) a+ where switchOnUnique v sv = VarT $ \a -> do+ (eb, sv') <- runVarT sv a+ (c', v') <- runVarT (vOf eb) a return (c', switchOnUnique v' sv') where vOf eb = case eb of NoEvent -> v@@ -191,9 +207,9 @@ -- predicate 'f'. -- 'v' maintains state while cold. onlyWhen :: (Applicative m, Monad m)- => Var m a b -- ^ 'v' - The value stream+ => VarT m a b -- ^ 'v' - The value stream -> (a -> Bool) -- ^ 'f' - The predicate to run on 'v''s input values.- -> Var m a (Event b)+ -> VarT m a (Event b) onlyWhen v f = v `onlyWhenE` hot where hot = var id ~> onWhen f @@ -201,13 +217,13 @@ -- produces an event. -- 'v' and 'h' maintain state while cold. onlyWhenE :: (Applicative m, Monad m)- => Var m a b -- ^ 'v' - The value stream- -> Var m a (Event c) -- ^ 'h' - The event stream- -> Var m a (Event b)-onlyWhenE v hot = Var $ \a -> do- (e, hot') <- runVar hot a+ => VarT m a b -- ^ 'v' - The value stream+ -> VarT m a (Event c) -- ^ 'h' - The event stream+ -> VarT m a (Event b)+onlyWhenE v hot = VarT $ \a -> do+ (e, hot') <- runVarT hot a if isEvent e- then do (b, v') <- runVar v a+ then do (b, v') <- runVarT v a return (Event b, onlyWhenE v' hot') else return (NoEvent, onlyWhenE v hot') --------------------------------------------------------------------------------@@ -272,7 +288,7 @@ -- result is a @()@. A value of @NoEvent@ means that an event did not -- occur. ----- Event streams (like @Var m a (Event b)@) describe events that may occur over+-- Event streams (like @VarT m a (Event b)@) describe events that may occur over -- varying @a@ (also known as the series of @a@). Usually @a@ would be some -- form of time or some user input type. data Event a = Event a | NoEvent deriving (Eq)
src/Control/Varying/Spline.hs view
@@ -22,20 +22,23 @@ module Control.Varying.Spline ( -- * Spline Spline,- execSpline,- spline, -- * Spline Transformer SplineT(..), runSplineT,- evalSplineT,- execSplineT,- output,- -- * Special operations.+ scanSpline,+ fromEvents,+ outputStream,+ resultStream,+ step,+ -- * Combinators untilEvent,+ untilEvent_,+ _untilEvent,+ pair, race,- mix, capture, mapOutput,+ adjustInput, -- * Step Step(..), ) where@@ -47,28 +50,21 @@ import Control.Monad import Control.Applicative import Data.Monoid---- | A discrete step in a continuous function. This is simply a type that--- discretely describes an eventual value on the right and a monoidal output--- value on the left.-data Step f b where- Step :: Monoid f => f -> Event b -> Step f b---- | Returns the left value of a step.-stepIter :: Step f b -> f-stepIter (Step a _) = a+import Data.Functor.Identity --- | Returns the right value of a step.-stepResult :: Step f b -> Event b-stepResult (Step _ b) = b+-- | A discrete step in a continuous function. This type discretely describes +-- an eventual value on the right and an output value on the left.+data Step b c = Step { stepOutput :: b+ , stepResult :: Event c+ } -toIter :: (Functor f, Monoid (f b))- => (f a -> f b) -> Step (f a) c -> Step (f b) c-toIter f (Step a b) = Step (f a) b+-- | Map the output value of a 'Step'.+mapStepOutput :: (a -> b) -> Step a c -> Step b c+mapStepOutput f (Step a b) = Step (f a) b -- | A discrete step is a functor by applying a function to the contained -- event's value.-instance Functor (Step f) where+instance Functor (Step a) where fmap f (Step a b) = Step a $ fmap f b -- | A discrete spline is a monoid if its left and right types are monoids.@@ -83,31 +79,35 @@ pure a = Step mempty $ Event a (Step uia f) <*> (Step uib b) = Step (mappend uia uib) (f <*> b) --- | 'SplineT' shares a number of types with 'Var', specifically its monad,--- input and output types (m, a and b, respectively). A spline adds--- a container type that determines how empty output values should be--- created, appended and applied (the type must be monoidal and applicative).--- It also adds a result type which represents the monadic computation's result+-- | 'SplineT' shares a number of types with 'VarT', specifically its monad,+-- input and output types (@m@, @a@ and @b@, respectively). A spline adds+-- a result type which represents the monadic computation's result -- value. -- Much like the State monad it has an "internal state" and an eventual--- return value, where the internal state is the output value. The result+-- result value, where the internal state is the output value. The result -- value is used only in determining the next spline to sequence.-data SplineT f a b m c = SplineT { unSplineT :: Var m a (Step (f b) c) }- | SplineTConst c+data SplineT a b m c = SplineT { unSplineT :: VarT m a (Step (Event b) c) }+ | SplineTConst c -- | Unwrap a spline into a value stream.-runSplineT :: (Applicative m, Monad m, Monoid (f b))- => SplineT f a b m c -> Var m a (Step (f b) c)+runSplineT :: (Applicative m, Monad m)+ => SplineT a b m c -> VarT m a (Step (Event b) c) runSplineT (SplineT v) = v runSplineT (SplineTConst x) = pure $ pure x --- | 'Spline' is a specialized 'SplineT' that uses Event as its output--- container. This means that new values overwrite/replace old values due to--- Event's 'Last'-like monoid instance.-type Spline a b m c = SplineT Event a b m c+-- | Run the spline over the input values, gathering the output and result +-- values in a list. +scanSpline :: (Applicative m, Monad m) + => SplineT a b m c -> [a] -> m [(Event b, Event c)]+scanSpline s as = map f <$> scanVar (runSplineT s) as + where f (Step eb ec) = (eb,ec) +-- | A SplineT monad parameterized with Identity that takes input of type @a@, +-- output of type @b@ and a result value of type @c@. +type Spline a b c = SplineT a b Identity c+ -- | A spline is a functor by applying the function to the result.-instance (Applicative m, Monad m) => Functor (SplineT f a b m) where+instance (Applicative m, Monad m) => Functor (SplineT a b m) where fmap f (SplineTConst c) = SplineTConst $ f c fmap f (SplineT v) = SplineT $ fmap (fmap f) v @@ -116,8 +116,7 @@ -- argument. It responds to '<*>' by applying the left arguments eventual -- value (the function) to the right arguments eventual value. The -- output values will me combined with 'mappend'.-instance (Monoid (f b), Applicative m, Monad m)- => Applicative (SplineT f a b m) where+instance (Applicative m, Monad m) => Applicative (SplineT a b m) where pure = SplineTConst (SplineTConst f) <*> (SplineTConst x) = SplineTConst $ f x (SplineT vf) <*> (SplineTConst x) = SplineT $ fmap (fmap ($ x)) vf@@ -127,57 +126,50 @@ -- | A spline is monad if its output type is a monoid. A spline responds -- to bind by running until it produces an eventual value, then uses that -- value to run the next spline.-instance (Monoid (f b), Applicative m, Monad m) => Monad (SplineT f a b m) where+instance (Applicative m, Monad m) => Monad (SplineT a b m) where return = pure (SplineTConst x) >>= f = f x- (SplineT v) >>= f = SplineT $ Var $ \i -> do- (Step b e, v') <- runVar v i+ (SplineT v) >>= f = SplineT $ VarT $ \i -> do+ (Step b e, v') <- runVarT v i case e of NoEvent -> return (Step b NoEvent, runSplineT $ SplineT v' >>= f)- Event x -> runVar (runSplineT $ f x) i+ Event x -> runVarT (runSplineT $ f x) i -- | A spline is a transformer and other monadic computations can be lifted -- int a spline.-instance Monoid (f b) => MonadTrans (SplineT f a b) where+instance MonadTrans (SplineT a b) where lift f = SplineT $ varM $ const $ liftM (Step mempty . Event) f -- | A spline can do IO if its underlying monad has a MonadIO instance. It -- takes the result of the IO action as its immediate return value and -- uses 'mempty' to generate an empty output value.-instance (Monoid (f b), Functor m, Applicative m, MonadIO m)- => MonadIO (SplineT f a b m) where+instance (Functor m, Applicative m, MonadIO m) => MonadIO (SplineT a b m) where liftIO = lift . liftIO --- | Evaluates a spline to a value stream of its output type.-execSplineT :: (Applicative m, Monad m, Monoid (f b))- => SplineT f a b m c -> Var m a (f b)-execSplineT = (stepIter <$>) . runSplineT+-- | Evaluates a spline into a value stream of its output type.+outputStream :: (Applicative m, Monad m) + => b -> SplineT a b m c -> VarT m a b+outputStream x s = ((stepOutput <$>) $ runSplineT s) ~> foldStream (\_ y -> y) x -- | Evaluates a spline to an event stream of its result. The resulting -- value stream inhibits until the spline's domain is complete and then it -- produces events of the result type.-evalSplineT :: (Applicative m, Monad m, Monoid (f b))- => SplineT f a b m c -> Var m a (Event c)-evalSplineT = (stepResult <$>) . runSplineT+resultStream :: (Applicative m, Monad m) => SplineT a b m c -> VarT m a (Event c)+resultStream = (stepResult <$>) . runSplineT -- | Create a spline using an event stream. The spline will run until the -- stream inhibits, using the stream's last produced value as the current -- output value. In the case the stream inhibits before producing--- a value the default value is used. The spline's result value is the last+-- a value the default value is used. The spline's result is the last -- output value.-spline :: (Applicative m, Monad m) => b -> Var m a (Event b) -> Spline a b m b-spline x ve = SplineT $ Var $ \a -> do- (ex, ve') <- runVar ve a+fromEvents :: (Applicative m, Monad m) => b -> VarT m a (Event b) -> SplineT a b m b+fromEvents x ve = SplineT $ VarT $ \a -> do+ (ex, ve') <- runVarT ve a case ex of NoEvent -> let n = Step (Event x) (Event x) in return (n, pure n)- Event x' -> return (Step (Event x') NoEvent, runSplineT $ spline x' ve')---- | Using a default start value, evaluate the spline to a value stream.--- A spline is only defined over a finite domain so we must supply a default--- value to use before the spline produces its first output value.-execSpline :: (Applicative m, Monad m) => b -> Spline a b m c -> Var m a b-execSpline x (SplineTConst _) = pure x-execSpline x s = execSplineT s ~> foldStream (\_ y -> y) x+ Event x' -> return ( Step (Event x') NoEvent+ , runSplineT $ fromEvents x' ve'+ ) -- | Create a spline from a value stream and an event stream. The spline -- uses the value stream as its output value. The spline will run until@@ -185,80 +177,90 @@ -- value and the event value are tupled and returned as the spline's result -- value. untilEvent :: (Applicative m, Monad m)- => Var m a b -> Var m a (Event c)- -> Spline a b m (b,c)+ => VarT m a b -> VarT m a (Event c)+ -> SplineT a b m (b,c) untilEvent v ve = SplineT $ t ~> var (uncurry f) where t = (,) <$> v <*> ve f b ec = case ec of NoEvent -> Step (Event b) NoEvent Event c -> Step (Event b) (Event (b, c)) --- | Run two splines concurrently and return the result of the SplineT that--- concludes first. If they conclude at the same time the result is taken from--- the spline on the left.-race :: (Applicative m, Monad m, Monoid (f u))- => SplineT f i u m a -> SplineT f i u m a -> SplineT f i u m a-race (SplineTConst a) s =- race (SplineT $ pure $ Step mempty $ Event a) s-race s (SplineTConst b) =- race s (SplineT $ pure $ Step mempty $ Event b)-race (SplineT va) (SplineT vb) = SplineT $ Var $ \i -> do- (Step ua ea, va') <- runVar va i- (Step ub eb, vb') <- runVar vb i+-- | A variant of 'untilEvent' that only results in the left result,+-- discarding the right result.+untilEvent_ :: (Applicative m, Monad m)+ => VarT m a b -> VarT m a (Event c)+ -> SplineT a b m b+untilEvent_ v ve = fst <$> untilEvent v ve++-- | A variant of 'untilEvent' that only results in the right result,+-- discarding the left result.+_untilEvent :: (Applicative m, Monad m)+ => VarT m a b -> VarT m a (Event c)+ -> SplineT a b m b+_untilEvent v ve = fst <$> untilEvent v ve++-- | Run two splines in parallel, combining their output. Return the result of +-- the spline that concludes first. If they conclude at the same time the result +-- is taken from the left spline.+race :: (Applicative m, Monad m) + => (b -> d -> e) -> SplineT a b m c -> SplineT a d m c -> SplineT a e m c+race f (SplineTConst a) s =+ race f (SplineT $ pure $ Step mempty $ Event a) s+race f s (SplineTConst b) =+ race f s (SplineT $ pure $ Step mempty $ Event b)+race f (SplineT va) (SplineT vb) = SplineT $ VarT $ \i -> do+ (Step ua ea, va') <- runVarT va i+ (Step ub eb, vb') <- runVarT vb i+ let s' = runSplineT $ race f (SplineT va') (SplineT vb') case (ea,eb) of- (Event _,_) -> return (Step (ua <> ub) ea, va')- (_,Event _) -> return (Step (ua <> ub) eb, vb')- (_,_) -> return (Step (ua <> ub) NoEvent,- runSplineT $ race (SplineT va') (SplineT vb'))+ (Event a,_) -> return (Step (f <$> ua <*> ub) ea, s') + (_,Event b) -> return (Step (f <$> ua <*> ub) eb, s') + (_,_) -> return (Step (f <$> ua <*> ub) NoEvent, s') --- | Run a list of splines concurrently. Restart individual splines whenever--- they conclude in a value. Return a list of the most recent result values once--- the control spline concludes.-mix :: (Applicative m, Monad m, Monoid (f b))- => [Maybe c -> SplineT f a b m c] -> SplineT f a b m ()- -> SplineT f a b m [Maybe c]-mix gs = go gs es $ zipWith ($) gs xs- where es = replicate n NoEvent- xs = replicate n Nothing- n = length gs- go fs evs guis egui = SplineT $ Var $ \a -> do- let step (ecs, fb, vs) (f, ec, g) = do- (Step fb' ec', v) <- runVar (runSplineT g) a- let ec'' = ec <> ec'- fb'' = fb <> fb'- v' = case ec' of- NoEvent -> v- Event c -> runSplineT $ f $ Just c- return (ecs ++ [ec''], fb'', vs ++ [SplineT v'])- (ecs, fb, guis') <- foldM step ([],mempty,[]) (zip3 fs evs guis)- (Step fb' ec, v) <- runVar (runSplineT egui) a- let fb'' = fb <> fb'- ec' = map toMaybe ecs <$ ec- return (Step fb'' ec',- runSplineT $ go fs ecs guis' $ SplineT v)+-- | Run two splines in parallel, combining their output. When both conclude, +-- return their result values in a tuple.+pair :: (Monad m) + => (b -> d -> f) -> SplineT a b m c -> SplineT a d m e + -> SplineT a f m (c, e)+pair f (SplineTConst a) s = pair f (SplineT $ pure $ Step mempty $ Event a) s+pair f s (SplineTConst b) = pair f s (SplineT $ pure $ Step mempty $ Event b)+pair f (SplineT va) (SplineT vb) = SplineT $ VarT $ \a -> do+ (Step fa ea, va') <- runVarT va a+ (Step fb eb, vb') <- runVarT vb a+ return ( Step (f <$> fa <*> fb) ((,) <$> ea <*> eb)+ , runSplineT $ pair f (SplineT va') (SplineT vb')+ ) --- | Capture the spline's latest output value and tuple it with the--- spline's result value. This is helpful when you want to sample the last+-- | Capture the spline's last output value and tuple it with the+-- spline's result. This is helpful when you want to sample the last -- output value in order to determine the next spline to sequence.-capture :: (Applicative m, Monad m, Monoid (f b), Eq (f b))- => SplineT f a b m c -> SplineT f a b m (f b, c)-capture (SplineTConst x) = SplineTConst (mempty, x)-capture (SplineT v) = capture' mempty v- where capture' mb v' = SplineT $ Var $ \a -> do- (Step fb ec, v'') <- runVar v' a- let mb' = if fb == mempty then mb else fb+capture :: (Applicative m, Monad m, Eq b)+ => SplineT a b m c -> SplineT a b m (Maybe b, c)+capture (SplineTConst x) = SplineTConst (Nothing, x)+capture (SplineT v) = capture' Nothing v+ where capture' mb v' = SplineT $ VarT $ \a -> do+ (Step fb ec, v'') <- runVarT v' a+ let mb' = if fb == NoEvent then mb else toMaybe fb ec' = (mb',) <$> ec return (Step fb ec', runSplineT $ capture' mb' v'') --- | Produce the argument as an output value exactly once, then return ().-output :: (Applicative m, Monad m, Monoid (f b), Applicative f)- => b -> SplineT f a b m ()-output b = SplineT $ Var $ \_ ->+-- | Produce the argument as an output value exactly once.+step :: (Applicative m, Monad m) => b -> SplineT a b m ()+step b = SplineT $ VarT $ \_ -> return (Step (pure b) NoEvent, pure $ Step (pure b) $ Event ()) -- | Map the output value of a spline.-mapOutput :: (Functor f, Monoid (f t), Applicative m, Monad m)- => Var m a (b -> t) -> SplineT f a b m c -> SplineT f a t m c+mapOutput :: (Applicative m, Monad m) + => VarT m a (b -> t) -> SplineT a b m c -> SplineT a t m c mapOutput _ (SplineTConst c) = SplineTConst c-mapOutput vf (SplineT vx) = SplineT $ toIter <$> vg <*> vx+mapOutput vf (SplineT vx) = SplineT $ mapStepOutput <$> vg <*> vx where vg = (<$>) <$> vf++-- | Map the input value of a spline.+adjustInput :: (Monad m)+ => VarT m a (a -> r) -> SplineT r b m c -> SplineT a b m c+adjustInput _ (SplineTConst c) = SplineTConst c+adjustInput vf (SplineT vx) = SplineT $ VarT $ \a -> do+ (f, vf') <- runVarT vf a+ (b, vx') <- runVarT vx $ f a+ return (b, runSplineT $ adjustInput vf' $ SplineT vx')
src/Control/Varying/Time.hs view
@@ -9,19 +9,20 @@ import Control.Varying.Event import Control.Applicative import Data.Time.Clock+import Control.Monad.IO.Class (MonadIO,liftIO) -- | Produces time deltas using 'getCurrentTime' and 'diffUTCTime'.-deltaUTC :: Fractional t => Var IO b t-deltaUTC = delta getCurrentTime (\a b -> realToFrac $ diffUTCTime a b)+deltaUTC :: (MonadIO m, Fractional t) => VarT m b t+deltaUTC = delta (liftIO getCurrentTime) (\a b -> realToFrac $ diffUTCTime a b) -- | Produces time deltas using a monadic computation and a difference -- function. delta :: (Num t, Fractional t, Applicative m, Monad m)- => m a -> (a -> a -> t) -> Var m b t-delta m f = Var $ \_ -> do+ => m a -> (a -> a -> t) -> VarT m b t+delta m f = VarT $ \_ -> do t <- m return (0, delta' t)- where delta' t = Var $ \_ -> do+ where delta' t = VarT $ \_ -> do t' <- m let dt = t' `f` t return (dt, delta' t')@@ -31,8 +32,8 @@ -- | Emits events before accumulating t of input dt. -- Note that as soon as we have accumulated >= t we stop emitting events -- and there is no guarantee that an event will be emitted at time == t.-before :: (Applicative m, Monad m, Num t, Ord t) => t -> Var m t (Event ())-before t = Var $ \dt -> return $+before :: (Applicative m, Monad m, Num t, Ord t) => t -> VarT m t (Event ())+before t = VarT $ \dt -> return $ if t - dt >= 0 then (Event (), before $ t - dt) else (NoEvent, never)@@ -40,8 +41,8 @@ -- | Emits events after t input has been accumulated. -- Note that event emission is not guaranteed to begin exactly at t, -- only at some small delta after t.-after :: (Applicative m, Monad m, Num t, Ord t) => t -> Var m t (Event ())-after t = Var $ \dt -> return $+after :: (Applicative m, Monad m, Num t, Ord t) => t -> VarT m t (Event ())+after t = VarT $ \dt -> return $ if t - dt <= 0 then (Event (), pure $ Event ()) else (NoEvent, after $ t - dt)
src/Control/Varying/Tween.hs view
@@ -15,13 +15,13 @@ -- dreams). ---{-# LANGUAGE Arrows #-} {-# LANGUAGE Rank2Types #-} module Control.Varying.Tween ( -- * Creating tweens -- $creation tween, constant,+ timeAsPercentageOf, -- * Interpolation functions -- $lerping linear,@@ -127,7 +127,7 @@ -- $creation -- The most direct route toward tweening values is to use 'tween' -- along with an interpolation function such as 'easeInExpo'. For example,--- @tween easeInOutExpo 0 100 10@, this will create a spline that produces a+-- @tween easeInExpo 0 100 10@, this will create a spline that produces a -- number interpolated from 0 to 100 over 10 seconds. At the end of the -- tween the spline will return the result value. --------------------------------------------------------------------------------@@ -138,7 +138,7 @@ -- -- @ -- testWhile_ isEvent (deltaUTC ~> v)--- where v :: Var IO a (Event Double)+-- where v :: VarT IO a (Event Double) -- v = execSpline 0 $ tween easeOutExpo 0 100 5 -- @ --@@ -146,22 +146,22 @@ -- duration. This is mentioned because the author has made that mistake -- more than once ;) tween :: (Applicative m, Monad m, Fractional t, Ord t)- => Easing t -> t -> t -> t -> Spline t t m t-tween f start end dur = spline start $ timeAsPercentageOf dur ~> var g+ => Easing t -> t -> t -> t -> SplineT t t m t+tween f start end dur = fromEvents start $ timeAsPercentageOf dur ~> var g where g t = let c = end - start b = start x = f c t b- in if t >= 1.0 then NoEvent else Event x+ in if t > 1.0 then NoEvent else Event x -- | Creates a tween that performs no interpolation over the duration. constant :: (Applicative m, Monad m, Num t, Ord t)- => a -> t -> Spline t a m a-constant value duration = spline value $ use value $ before duration+ => a -> t -> SplineT t a m a+constant value duration = fromEvents value $ use value $ before duration --- | Varies 0.0 to 1.0 linearly for duration `t` and 1.0 after `t`.+-- | VarTies 0.0 to 1.0 linearly for duration `t` and 1.0 after `t`. timeAsPercentageOf :: (Applicative m, Monad m, Ord t, Num t, Fractional t)- => t -> Var m t t-timeAsPercentageOf t = ((\t' -> min 1 (t' / t)) <$> accumulate (+) 0)+ => t -> VarT m t t+timeAsPercentageOf t = (/t) <$> accumulate (+) 0 -------------------------------------------------------------------------------- -- $writing@@ -187,4 +187,4 @@ -- | A linear interpolation between two values over some duration. -- A `Tween` takes three values - a start value, an end value and -- a duration.-type Tween m t = t -> t -> t -> Var m t (Event t)+type Tween m t = t -> t -> t -> VarT m t (Event t)
− src/Example.hs
@@ -1,62 +0,0 @@-module Main where--import Control.Varying-import Control.Applicative-import Text.Printf---- | A simple 2d point type.-data Point = Point { px :: Float- , py :: Float- } deriving (Show, Eq)---- An exponential tween back and forth from 0 to 100 over 2 seconds that--- loops forever. This spline takes float values of delta time as input,--- outputs the current x value at every step and would result in () if it--- terminated.-tweenx :: (Applicative m, Monad m) => Spline Float Float m ()-tweenx = do- -- Tween from 0 to 100 over 1 second- x <- tween easeOutExpo 0 100 1- -- Chain another tween back to the starting position- _ <- tween easeOutExpo x 0 1- -- Loop forever- tweenx---- A quadratic tween back and forth from 0 to 100 over 2 seconds that never--- ends.-tweeny :: (Applicative m, Monad m) => Spline Float Float m ()-tweeny = do- y <- tween easeOutQuad 0 100 1- _ <- tween easeOutQuad y 0 1- tweeny---- Our time signal that provides delta time samples.-time :: Var IO a Float-time = deltaUTC---- | Our Point value that varies over time continuously in x and y.-backAndForth :: Var IO a Point-backAndForth =- -- Turn our splines back into continuous value streams. We must provide- -- a starting value since splines are not guaranteed to be defined at- -- their edges.- let x = execSpline 0 tweenx- y = execSpline 0 tweeny- in- -- Construct a varying Point that takes time as an input.- (Point <$> x <*> y)- -- Stream in a time signal using the 'plug left' combinator.- -- We could similarly use the 'plug right' (~>) function- -- and put the time signal before the construction above. This is needed- -- because the tween streams take time as an input.- <~ time--main :: IO ()-main = do- putStrLn "Varying Values"- loop backAndForth- where loop :: Var IO () Point -> IO ()- loop v = do (point, vNext) <- runVar v ()- printf "\nPoint %03.1f %03.1f" (px point) (py point)- loop vNext-
+ test/Main.hs view
@@ -0,0 +1,107 @@+module Main where++import Test.Hspec hiding (after)+import Test.QuickCheck+import Control.Varying+import Data.Functor.Identity++main :: IO ()+main = hspec $ do + describe "timeAsPercentageOf" $ do+ it "should run past 1.0" $ do+ let Identity scans = scanVar (timeAsPercentageOf 4)+ [1,1,1,1,1 :: Float]+ last scans `shouldSatisfy` (> 1)+ it "should progress by increments of the total" $ do+ let Identity scans = scanVar (timeAsPercentageOf 4)+ [1,1,1,1,1 :: Float]+ scans `shouldBe` [0.25,0.5,0.75,1.0,1.25 :: Float] ++ describe "tween" $ + it "should step by the dt passed in" $ do+ let Identity scans = scanSpline (tween linear 0 4 (4 :: Float)) + [0,1,1,1,1,1] + scans `shouldBe` [(Event 0, NoEvent)+ ,(Event 1, NoEvent)+ ,(Event 2, NoEvent)+ ,(Event 3, NoEvent)+ ,(Event 4, NoEvent)+ ,(Event 4, Event 4)+ ]++ describe "untilEvent" $ do+ let Identity scans = scanSpline (3 `untilEvent` (1 ~> after 10))+ (replicate 10 ())+ it "should produce output from the value stream until event procs" $+ head scans `shouldBe` (Event 3, NoEvent)+ it "should produce output from the value stream until event procs" $+ last scans `shouldBe` (Event 3, Event (3,()))++ describe "pair" $ do+ let s1 = 3 `untilEvent_` (1 ~> after 10)+ s2 = do 4 `untilEvent_` (1 ~> after 10)+ 5 `untilEvent_` (1 ~> after 10)+ Identity scans = scanSpline (pair (+) s1 s2) $ replicate 20 () + it "should end" $+ length (takeWhile ((== NoEvent) . snd) scans) `shouldBe` 18 + it "should combine output" $+ head scans `shouldBe` (Event 7, NoEvent)+ it "should progress" $+ (scans !! 11) `shouldBe` (Event 8, NoEvent)+ it "should pair both results" $+ last scans `shouldBe` (Event 8, Event (3,5))++ describe "race" $ do+ let s1 = pure 'a' `untilEvent_` (1 ~> after 3)+ s2 = pure 'x' `untilEvent_` (1 ~> after 4)+ r = race (\a x -> [a,x]) s1 s2+ Identity scans = scanSpline r $ replicate 20 ()+ it "should combine output" $+ head scans `shouldBe` (Event "ax", NoEvent) + it "should end" $+ length (takeWhile ((== NoEvent) . snd) scans) `shouldBe` 2+ it "should show 'a' as winner" $+ last scans `shouldBe` (Event "ax", Event 'a')++ describe "capture" $ do+ let fstr str char = str ++ [char]+ s = (1 ~> accumulate (+) (fromEnum 'a') + ~> var toEnum + ~> accumulate fstr "") + `untilEvent_` (1 ~> after 3)+ Identity scans = scanSpline (capture s) $ replicate 5 ()+ it "should end with the last value captured" $ + scans !! 2 `shouldBe` (Event "bcd", Event (Just "bcd", "bcd")) + + describe "step" $ do+ let s = step "hey"+ Identity scans = scanSpline s $ replicate 3 ()+ it "should produce exactly once" $ do+ head scans `shouldBe` (Event "hey", NoEvent)+ scans !! 1 `shouldBe` (Event "hey", Event ())++ describe "mapOutput" $ do+ let s :: Spline () String String + s = pure "hey" `untilEvent_` never+ f :: Int -> Char -> Int+ f acc char = acc + fromEnum char+ g :: String -> Int+ g = foldl f 0+ v :: Var () (String -> Int)+ v = var $ const g + s' = mapOutput v s + Identity scans = scanSpline s' $ replicate 3 ()+ it "should map the output" $ + head scans `shouldBe` (Event 326, NoEvent) ++ describe "adjustInput" $ do+ let s = var id `untilEvent_` never+ v :: Var a (Char -> Int) + v = pure fromEnum + s' = adjustInput v s+ Identity scans = scanSpline s' "abcd"+ it "should" $ map fst scans `shouldBe` [ Event 97+ , Event 98+ , Event 99+ , Event 100+ ]
varying.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.3.0.1+version: 0.4.0.0 -- A short (one-line) description of the package. synopsis: FRP through value streams and monadic splines.@@ -86,18 +86,40 @@ default-language: Haskell2010 executable varying-example- ghc-options: -Wall+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -- Other library packages from which modules are imported. build-depends: base >=4.7 && <4.9, time >=1.5 && <1.6,- transformers >= 0.4 && <0.5+ transformers >= 0.4 && <0.5,+ varying -- Directories containing source files.- hs-source-dirs: src+ hs-source-dirs: app - main-is: Example.hs+ main-is: Main.hs++ -- Base language which the package is written in.+ default-language: Haskell2010++test-suite varying-test+ type: exitcode-stdio-1.0+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N++ -- Other library packages from which modules are imported.+ build-depends: base >=4.7 && <4.9+ , time >=1.5 && <1.6+ , transformers+ , varying+ , hspec+ , QuickCheck+++ -- Directories containing source files.+ hs-source-dirs: test++ main-is: Main.hs -- Base language which the package is written in. default-language: Haskell2010