packages feed

varying (empty) → 0.1.0.0

raw patch · 9 files changed

+1014/−0 lines, 9 filesdep +basedep +timedep +varyingsetup-changed

Dependencies added: base, time, varying

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Schell Scivally++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Control/Varying.hs view
@@ -0,0 +1,14 @@+-- | Module:     Control.Varying+--   Copyright:  (c) 2015 Schell Scivally+--   License:    MIT+--   Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+module Control.Varying (+    -- * Reexports+    module Control.Varying.Core,+    module Control.Varying.Event,+    module Control.Varying.Tween+) where++import Control.Varying.Core+import Control.Varying.Event+import Control.Varying.Tween
+ src/Control/Varying/Core.hs view
@@ -0,0 +1,221 @@+-- | Module:     Control.Varying.Core+--   Copyright:  (c) 2015 Schell Scivally+--   License:    MIT+--   Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+module Control.Varying.Core where++import Prelude hiding (id, (.))+import Control.Arrow+import Control.Category+import Control.Applicative+import Debug.Trace+--------------------------------------------------------------------------------+-- Constructing+--------------------------------------------------------------------------------+-- | 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 monadic computation into a 'Var'.+varM :: Monad m => (a -> m b) -> Var m a b+varM f = Var $ \a -> do+    b <- f a+    return (b, varM f)+--------------------------------------------------------------------------------+-- Running+--------------------------------------------------------------------------------+-- | 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 '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)++-- | Loop over a 'Var' that takes no input value.+loopVar_ :: Monad m => Var 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++-- | Iterate a 'Var' that requires no input until the given predicate fails.+whileVar_ :: Monad m => (a -> Bool) -> Var m () a -> m a+whileVar_ f v = do+   (a, v') <- runVar v ()+   if f a then whileVar_ f v' else return a++-- | Iterate a 'Var' 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+         -> m a -- ^ The last sample+whileVar f a v = if f a+                 then runVar v a >>= uncurry (whileVar f)+                 else return a+--------------------------------------------------------------------------------+-- 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+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+vstrace s = var $ \b -> trace (s ++ show 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 ()+testWhile_ f v = do+    (a, v') <- runVar v ()+    if f a then print a >> testWhile_ f v' else return ()++-- | 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+-- by typing the input and hitting `return`.+testVar :: (Read a, Show b) => Var IO a b -> IO ()+testVar v = loopVar_ $ varM (const $ putStrLn "input: ")+                    ~> varM (const getLine)+                    ~> var read+                    ~> v+                    ~> varM (putStrLn . show)++-- | 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 ()+testVar_ v = loopVar_ $ pure () ~> v ~> varM print ~> varM (const $ getLine)+--------------------------------------------------------------------------------+-- Composition and accumulation+--------------------------------------------------------------------------------+-- | 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+    let b' = f b a+    return (b', accumulate f b')++-- | Delays the given 'Var' by one sample using a parameter as the first+-- sample. This enables the programmer to create 'Var's that depend on+-- 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'')++-- | Same as '~>' with flipped parameters.+(<~) :: Monad m => Var m b c -> Var m a b -> Var 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+-- 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+    return $ (c, v1' ~> v2')+infixr 1 ~>+--------------------------------------------------------------------------------+-- Typeclass instances+--------------------------------------------------------------------------------+-- | You can transform the sample value of any 'Var':+--+-- >  fmap (*3) $ accumulate (+) 0+-- Will sum input values and then multiply the sum by 3.+instance Monad m => Functor (Var m b) where+    fmap f' v = v ~> var f'++-- | A very simple category instance.+--+-- @+--   id = var id+--   f . g = g ~> f+-- @+-- or+--+-- >  f . g = f <~ g+--+-- It is preferable for consistency (and readability) to use 'plug left' ('<~')+-- and 'plug right' ('~>') instead of ('.') where possible.+instance Monad m => Category (Var m) where+    id = var id+    f . g = g ~> f++-- | 'Var's are applicative.+--+-- >  (,) <$> pure True <*> var "Applicative"+instance Monad m => Applicative (Var 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')++-- | 'Var's are arrows, which means you can use proc notation.+--+-- @+-- v = proc a -> do+--       ex <- intEventVar -< ()+--       ey <- anotherIntEventVar -< ()+--       returnA -\< (+) \<$\> ex \<*\> ey+-- @+-- which is equivalent to+--+-- >  v = (\ex ey -> (+) <$> ex <*> ey) <$> intEventVar <*> anotherIntEventVar+instance Monad m => Arrow (Var m) where+    arr = var+    first v = Var $ \(b,d) -> do (c, v') <- runVar v b+                                 return $ ((c,d), first v')++-- | 'Var's can be written as numbers.+--+-- >  let v = 1 ~> accumulate (+) 0+-- which will sum the natural numbers.+instance (Monad m, Num b) => Num (Var m a b) where+    (+) = liftA2 (+)+    (-) = liftA2 (-)+    (*) = liftA2 (*)+    abs = fmap abs+    signum = fmap signum+    fromInteger = pure . fromInteger++-- | 'Var's can be written as floats.+--+-- >  let v = pi ~> accumulate (*) 0.0+-- which will attempt (and succeed) to multiply pi by zero every step.+instance (Monad m, Floating b) => Floating (Var m a b) where+    pi = pure pi+    exp = fmap exp+    log = fmap log+    sin = fmap sin; sinh = fmap sinh; asin = fmap asin; asinh = fmap asinh+    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.+--+-- >  let v = 2.5 ~> accumulate (+) 0+-- which will add 2.5 each step.+instance (Monad m, Fractional b) => Fractional (Var m a b) where+    (/) = liftA2 (/)+    fromRational = pure . fromRational+--------------------------------------------------------------------------------+-- Core datatypes+--------------------------------------------------------------------------------+-- | The vessel of a varying value. A 'Var' is a structure that contains a value+-- that changes over some input. That input could be time (Float, Double, etc)+-- or events or a stream of 'Char' - whatever. Similar to the+-- 'Control.Monad.State' monad.+-- 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.+         }
+ src/Control/Varying/Event.hs view
@@ -0,0 +1,405 @@+-- | Module:     Control.Varying.Event+--   Copyright:  (c) 2015 Schell Scivally+--   License:    MIT+--   Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+{-# LANGUAGE Arrows #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PartialTypeSignatures #-}+module Control.Varying.Event (+    Event(..),+    -- * Transforming event values.+    toMaybe,+    isEvent,+    -- * Combining events and values+    latchWith,+    orE,+    tagOn,+    tagM,+    ringM,+    -- * Generating events from values+    use,+    onTrue,+    onJust,+    onUnique,+    onWhen,+    toEvent,+    -- * Using events+    collect,+    hold,+    holdWith,+    startingWith,+    startWith,+    -- * Temporal operations+    between,+    until,+    after,+    beforeWith,+    beforeOne,+    before,+    filterE,+    takeE,+    once,+    always,+    never,+    -- * Switching and chaining events+    andThen,+    andThenWith,+    andThenE,+    switchByMode,+    -- * Combining event streams+    combineWith,+    combine+) where++import Prelude hiding (until)+import Control.Varying.Core+import Control.Applicative+import Control.Arrow+import Control.Monad+--------------------------------------------------------------------------------+-- Transforming event values into usable values.+--------------------------------------------------------------------------------+-- | Turns an 'Event' into a 'Maybe'.+toMaybe :: Event a -> Maybe a+toMaybe (Event a) = Just a+toMaybe _ = Nothing++-- | Returns 'True' when the 'Event' contains a sample and 'False'+-- otherwise.+isEvent :: Event a -> Bool+isEvent (Event _) = True+isEvent _ = False+--------------------------------------------------------------------------------+-- Combining varying values and events+--------------------------------------------------------------------------------+-- | Holds the last value of one event stream while waiting for another event+-- stream to produce a value. Once both streams have produced a value combine+-- the two using the given combine function.+latchWith :: Monad m+          => (b -> c -> d) -> Var m a (Event b) -> Var m a (Event c)+          -> Var m a (Event d)+latchWith f vb vc = latchWith' (NoEvent, vb) vc+    where latchWith' (eb, vb') vc' =+              Var $ \a -> do (eb', vb'') <- runVar vb' a+                             (ec', vc'') <- runVar vc' a+                             let eb'' = eb' <|> eb+                             return $ ( f <$> eb'' <*> ec'+                                      , latchWith' (eb'', vb'') vc''+                                      )+++-- | Produces values from the first unless the second produces event+-- values and if so, produces the values of those events.+orE :: 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+    return $ case e of+        NoEvent  -> (b, orE y' ye')+        Event b' -> (b', orE y' ye')++-- | Injects the values of the `vb` into the events of `ve`.+tagOn :: Monad m => Var m a b -> Var m a (Event c) -> Var m a (Event b)+tagOn vb ve = proc a -> do+    b <- vb -< a+    e <- ve -< a+    returnA -< b <$ e++-- | Injects a monadic computation into an event stream, using the event+-- values of type `b` as a parameter to produce an event stream of type+-- `c`. After the first time an event is generated the result of the+-- previous event is used in a clean up function.+--+-- This is like `tagM` but performs a cleanup function first.+ringM :: Monad m+      => (c -> m ()) -> (b -> m c) -> Var m a (Event b) -> Var m a (Event c)+ringM cln = (go (const $ return ()) .) . tagM+    where go f ve = Var $ \a -> do (ec, ve') <- runVar ve a+                                   case ec of+                                       NoEvent -> return (ec, go f ve')+                                       Event c -> do f c+                                                     return (ec, go cln ve')++-- | Injects a monadic computation into the events of `vb`, providing a way+-- to perform side-effects inside an `Event` inside a `Var`.+tagM :: Monad m => (b -> m c) -> Var m a (Event b) -> Var m a (Event c)+tagM f vb = Var $ \a -> do+    (eb, vb') <- runVar vb a+    case eb of+        Event b -> do c <- f b+                      return (Event c, tagM f vb')+        NoEvent -> return (NoEvent, tagM f vb')+--------------------------------------------------------------------------------+-- Generating events from values+--------------------------------------------------------------------------------+-- | Populates a varying Event with a value. This is meant to be used with+-- the various 'on...' event triggers. For example+-- @+-- use 1 onTrue+-- @+-- produces values of `Event 1` when the input value is `True`.+use :: (Functor f, Functor e) => a -> f (e b) -> f (e a)+use a v = (a <$) <$> v++-- | Triggers an `Event ()` when the input value is True.+onTrue :: Monad m => Var m Bool (Event ())+onTrue = var $ \b -> if b then Event () else NoEvent++-- | Triggers an `Event a` when the input is `Just a`.+onJust :: Monad m => Var 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 :: (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''+                                             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 f = var $ \a -> if f a then Event a else NoEvent++-- | Wraps all produced values of the given var with events.+toEvent :: Monad m => Var m a b -> Var m a (Event b)+toEvent = (~> var Event)+--------------------------------------------------------------------------------+-- Using event values+--------------------------------------------------------------------------------+-- | Collect all produced values into a monoidal structure using the given+-- insert function.+collectWith :: (Monoid b, Monad m) => (a -> b -> b) -> Var m (Event a) b+collectWith f = Var $ \a -> collect' mempty a+    where collect' b e = let b' = case e of+                                        NoEvent -> b+                                        Event a' -> f a' b+                          in return (b', Var $ \a' -> collect' b' a')++-- | Collect all produced values into a list.+collect :: Monad m => Var m (Event a) [a]+collect = collectWith (:)++-- | Produces the given value until the input events produce a value, then+-- produce that value until a new input event produces. This always holds+-- the last produced value, starting with the given value.+-- @+-- time ~> after 3 ~> startingWith 0+-- @+-- This is similar to 'hold' except that it takes events from its input value+-- instead of another 'Var'.+startingWith, startWith :: Monad m => a -> Var m (Event a) a+startingWith = startWith+startWith a = Var $ \e ->+    return $ case e of+                 NoEvent  -> (a, startWith a)+                 Event a' -> (a', startWith a')++-- | Flipped version of 'hold'.+holdWith :: Monad m => b -> Var m a (Event b) -> Var m a b+holdWith = flip hold++-- | Produces the 'initial' value until the given 'Var' produces an event.+-- After an event is produced that event's value will be produced until the+-- next event produced by the given 'Var'.+hold :: Monad m => Var m a (Event b) -> b -> Var m a b+hold w initial = Var $ \x -> do+    (mb, w') <- runVar w x+    return $ case mb of+        NoEvent -> (initial, hold w' initial)+        Event e -> (e, hold w' e)++-- | Produce events after the first until the second. After a successful+-- cycle it will start over.+between :: Monad m => Var m a (Event b) -> Var m a (Event c) -> Var m a (Event ())+between vb vc = (never `before` vb) `andThenE` (toEvent vu `before` vc) `andThen` between vb vc+    where vu = pure ()++-- | Produce events with the initial value only after the input stream has+-- produced one event.+after :: Monad m => Var m a b -> Var m a (Event c) -> Var m a (Event b)+after vb ve = Var $ \a -> do+    (_, vb') <- runVar vb a+    (e, ve') <- runVar ve a+    case e of+        Event _ -> return (NoEvent, toEvent vb')+        NoEvent -> return (NoEvent, vb' `after` ve')++-- | Like before, but use the value produced by the switching stream to+-- create a stream to switch to.+beforeWith :: Monad m+           => Var m a b+           -> (Var m a (Event b), b -> Var m a (Event b))+           -> Var m a (Event b)+beforeWith vb (ve, f) = Var $ \a -> do+    (b, vb') <- runVar vb a+    (e, ve') <- runVar ve a+    case e of+        Event b' -> runVar (f b') a+        NoEvent  -> return (Event b, beforeWith vb' (ve', f))++-- | Like before, but sample the value of the second stream once before+-- inhibiting.+beforeOne :: Monad m => Var m a b -> Var m a (Event b) -> Var m a (Event b)+beforeOne vb ve = Var $ \a -> do+    (b, vb') <- runVar vb a+    (e, ve') <- runVar ve a+    case e of+        Event b' -> return (Event b', never)+        NoEvent  -> return (Event b, vb' `beforeOne` ve')++-- | Produce events with the initial varying value only before the second stream+-- has produced one event.+before :: Monad m => Var m a b -> Var m a (Event c) -> Var m a (Event b)+before = until++-- | Produce events with the initial varying value until the input event stream+-- `ve` produces its first event, then never produce any events.+until :: Monad m => Var m a b -> Var m a (Event c) -> Var m a (Event b)+until vb ve = Var $ \a -> do+    (b, vb') <- runVar vb a+    (e, ve') <- runVar ve a+    case e of+        Event _ -> return (NoEvent, never)+        NoEvent -> return (Event b, vb' `until` ve')++-- | Produce the given value once and then inhibit forever.+once :: Monad m => b -> Var m a (Event b)+once b = Var $ \_ -> return (Event b, never)++-- | Stream through some number of successful events and then inhibit forever.+takeE :: Monad m => Int -> Var m a (Event b) -> Var m a (Event b)+takeE n ve = Var $ \a -> do+    (eb, ve') <- runVar ve a+    case eb of+        NoEvent -> return (NoEvent, takeE n ve')+        Event b -> return (Event b, takeE (n-1) ve')++-- | Inhibit all events that don't pass the predicate.+filterE :: Monad m => (b -> Bool) -> Var m a (Event b) -> Var m a (Event b)+filterE p v = v ~> var check+    where check (Event b) = if p b then Event b else NoEvent+          check _ = NoEvent++-- | TODO:+-- | Produce events of a stream only when both streams produce events.+-- | Combine simultaneous events.++-- | Never produces any event values.+never :: Monad m => Var m b (Event c)+never = pure NoEvent++-- | Produces events with the initial value forever.+always :: Monad m => b -> Var m a (Event b)+always = pure . Event+--------------------------------------------------------------------------------+-- Switching on events+--------------------------------------------------------------------------------+-- | Produces the first 'Var's Event values until that stops producing, then+-- switches to the second 'Var'.+andThen :: Monad m => Var m a (Event b) -> Var m a b -> Var m a b+andThen w1 w2 = w1 `andThenWith` const w2++-- | Switches from one event stream to another once the first stops+-- producing.+andThenE :: Monad m+         => Var m a (Event b) -> Var m a (Event b) -> Var m a (Event b)+andThenE y1 y2 = Var $ \a -> do+    (e, y1') <- runVar y1 a+    case e of+        NoEvent -> runVar y2 a+        Event b -> return $ (Event b, y1' `andThenE` y2)++-- | Switches from one event stream when that stream stops producing. A new+-- stream is created using the last produced value (or `Nothing`) and used+-- as the second stream.+andThenWith :: Monad m+            => Var m a (Event b) -> (Maybe b -> Var m a b) -> Var m a b+andThenWith = go Nothing+    where go mb w1 f = Var $ \a -> do+              (e, w1') <- runVar w1 a+              case e of+                  NoEvent -> runVar (f mb) a+                  Event b -> return $ (b, go (Just b) w1' f)++-- | Switches using a mode signal. Signals maintain state for the duration+-- of the mode.+switchByMode :: (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+                  return $ (c', switchOnUnique v' sv')+                      where vOf eb = case eb of+                                         NoEvent -> v+                                         Event b -> f b+--------------------------------------------------------------------------------+-- Combining event streams+--------------------------------------------------------------------------------+-- | Combine two events streams into one event stream. Like `combine` but+-- uses a combining function instead of (,).+combineWith :: Monad m+            => (b -> c -> d) -> Var m a (Event b) -> Var m a (Event c)+            -> Var m a (Event d)+combineWith f vb vc = (uncurry f <$>) <$> (combine vb vc)++-- | Combine two event streams into an event stream of tuples. A tuple is+-- only produced when both event streams produce a value.+combine :: Monad m+        => Var m a (Event b) -> Var m a (Event c) -> Var m a (Event (b,c))+combine vb vc = (\eb ec -> (,) <$> eb <*> ec) <$> vb <*> vc+--------------------------------------------------------------------------------+-- Operations on Events+--------------------------------------------------------------------------------+instance Show a => Show (Event a) where+    show (Event a) = "Event " ++ show a+    show NoEvent   = "NoEvent"++instance (Floating a) => Floating (Event a) where+    pi = pure pi+    exp = fmap exp+    log = fmap log+    sin = fmap sin; sinh = fmap sinh; asin = fmap asin; asinh = fmap asinh+    cos = fmap cos; cosh = fmap cosh; acos = fmap acos; acosh = fmap acosh+    atan = fmap atan; atanh = fmap atanh++instance (Fractional a) => Fractional (Event a) where+    (/) = liftA2 (/)+    fromRational = pure . fromRational++instance Num a => Num (Event a) where+    (+) = liftA2 (+)+    (-) = liftA2 (-)+    (*) = liftA2 (*)+    abs = fmap abs+    signum = fmap signum+    fromInteger = pure . fromInteger++instance MonadPlus Event++instance Monad Event where+   return = Event+   (Event a) >>= f = f a+   _ >>= _ = NoEvent++instance Alternative Event where+    empty = NoEvent+    (<|>) (Event e) _ = Event e+    (<|>) NoEvent e = e++instance Applicative Event where+    pure = Event+    (<*>) (Event f) (Event a) = Event $ f a+    (<*>) _ _ = NoEvent++instance Functor Event where+    fmap f (Event a) = Event $ f a+    fmap _ NoEvent = NoEvent++-- | An Event is just like a Maybe.+data Event a = Event a | NoEvent deriving (Eq)
+ src/Control/Varying/Time.hs view
@@ -0,0 +1,46 @@+-- | Module:     Control.Varying.Time+--   Copyright:  (c) 2015 Schell Scivally+--   License:    MIT+--   Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+{-# LANGUAGE Arrows #-}+{-# LANGUAGE TupleSections #-}+module Control.Varying.Time where++import Control.Varying.Core+import Control.Varying.Event hiding (after, before)+import Data.Time.Clock++-- | Produces "time" deltas using 'getCurrentTime' and 'diffUTCTime'.+deltaUTC :: Fractional t => Var IO b t+deltaUTC = delta getCurrentTime (\a b -> realToFrac $ diffUTCTime a b)++-- | Produces "time" deltas using a monadic computation and a difference+-- function.+delta :: (Num t, Fractional t, Monad m) => m a -> (a -> a -> t) -> Var m b t+delta m f = Var $ \_ -> do+    t <- m+    return (0, delta' t)+    where delta' t = Var $ \_ -> do+            t' <- m+            let dt = t' `f` t+            return (dt, delta' t')+--------------------------------------------------------------------------------+-- Using timed events+--------------------------------------------------------------------------------+-- | 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 :: (Monad m, Num t, Ord t) => t -> Var m t (Event ())+before t = Var $ \dt -> do+    if t - dt >= 0+    then return (Event (), before $ t - dt)+    else return (NoEvent, never)++-- | 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 :: (Monad m, Num t, Ord t) => t -> Var m t (Event ())+after t = Var $ \dt -> do+    if t - dt <= 0+    then return (Event (), pure $ Event ())+    else return (NoEvent, after $ t - dt)
+ src/Control/Varying/Tween.hs view
@@ -0,0 +1,142 @@+-- | Module:     Control.Varying.Tween+--   Copyright:  (c) 2015 Schell Scivally+--   License:    MIT+--   Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE Arrows #-}+{-# LANGUAGE Rank2Types #-}+module Control.Varying.Tween where++import Control.Varying.Core+import Control.Varying.Event hiding (after, before)+import Control.Varying.Time+import Control.Arrow++-- | Ease in quadratic.+easeInQuad :: Num t => Easing t+easeInQuad c t b =  c * t*t + b++-- | Ease out quadratic.+easeOutQuad :: Num t => Easing t+easeOutQuad c t b =  (-c) * (t * (t - 2)) + b++-- | Ease in and out quadratic.+easeInOutQuad :: (Ord t, Fractional t) => Easing t+easeInOutQuad = easeInOut easeInQuad easeOutQuad++-- | Ease in cubic.+easeInCubic :: Num t => Easing t+easeInCubic c t b =  c * t*t*t + b++-- | Ease out cubic.+easeOutCubic :: Num t => Easing t+easeOutCubic c t b =  let t' = t - 1 in c * (t'*t'*t' + 1) + b++-- | Ease in and out cubic.+easeInOutCubic :: (Ord t, Fractional t) => Easing t+easeInOutCubic = easeInOut easeInCubic easeOutCubic++-- | Ease in by some power.+easeInPow :: Num t => Int -> Easing t+easeInPow power c t b =  c * (t^power) + b++-- | Ease out by some power.+easeOutPow :: Num t => Int -> Easing t+easeOutPow power c t b =+    let t' = t - 1+        c' = if power `mod` 2 == 1 then c else -c+        i  = if power `mod` 2 == 1 then 1 else -1+    in c' * ((t'^power) + i) + b++-- | Ease in sinusoidal.+easeInSine :: Floating t => Easing t+easeInSine c t b =  let cos' = cos (t * (pi / 2))+                               in -c * cos' + c + b++-- | Ease out sinusoidal.+easeOutSine :: Floating t => Easing t+easeOutSine c t b =  let cos' = cos (t * (pi / 2)) in c * cos' + b++-- | Ease in and out sinusoidal.+easeInOutSine :: Floating t => Easing t+easeInOutSine c t b =  let cos' = cos (pi * t)+                                  in (-c / 2) * (cos' - 1) + b++-- | Ease in exponential.+easeInExpo :: Floating t => Easing t+easeInExpo c t b =  let e = 10 * (t - 1) in c * (2**e) + b++-- | Ease out exponential.+easeOutExpo :: Floating t => Easing t+easeOutExpo c t b =  let e = -10 * t in c * (-(2**e) + 1) + b++-- | Ease in and out exponential.+easeInOutExpo :: (Ord t, Floating t) => Easing t+easeInOutExpo = easeInOut easeInExpo easeOutExpo++-- | Ease in circular.+easeInCirc :: Floating t => Easing t+easeInCirc c t b = let s = sqrt (1 - t*t) in -c * (s - 1) + b++-- | Ease out circular.+easeOutCirc :: Floating t => Easing t+easeOutCirc c t b = let t' = (t - 1)+                        s  = sqrt (1 - t'*t')+                    in c * s + b++-- | Ease in and out circular.+easeInOutCirc :: (Ord t, Floating t) => Easing t+easeInOutCirc = easeInOut easeInCirc easeOutCirc++-- | Ease in and out using the given easing equations.+easeInOut :: (Ord t, Num t, Fractional t) => Easing t -> Easing t -> Easing t+easeInOut ein eout c t b = if t >= 0.5 then ein c t b else eout c t b++-- | Ease linear.+linear :: Num t => Easing t+linear c t b = c * t + b++-- | Ease none.+-- This performs no interpolation over the duration, it just samples at a+-- constant value until the duration is up.+constant :: (Monad m, Num t, Ord t) => a -> t -> Var m t (Event a)+constant value duration = use value $ before duration++-- | An easing function.+type Easing t = t -> t -> t -> t++-- | A linear interpolation between two values over some duration.+type Tween m t = t -> t -> t -> Var m t (Event t)++-- | Produces an event sample interpolated between a start and end value+-- using an easing equation ('Easing') over a duration. The resulting 'Var' will+-- take a time delta as input. For example:+--+-- @+-- testWhile_ isEvent v+--    where v :: Var IO a (Event Double)+--          v = deltaUTC ~> tween easeOutExpo 0 100 5+-- @+--+-- Keep in mind `tween` must be fed time deltas, not absolute time or+-- duration. This is mentioned because the author has made that mistake+-- more than once ;)+tween :: (Monad m, Fractional t, Ord t)+      => Easing t -> t -> t -> t -> Var m t (Event t)+tween f start end dur = proc dt -> do+    -- Current time as percentage / amount of interpolation (0.0 - 1.0)+    t <- timeAsPercentageOf dur -< dt+    -- Emitted event+    e <- before dur -< dt+    -- Total change in value+    let c = end - start+        b = start+        x = f c t b+    -- Tag the event with the value.+    returnA -< x <$ e++-- | Varies 0.0 to 1.0 linearly for duration `t` and 1.0 after `t`.+timeAsPercentageOf :: (Monad m, Ord t, Num t, Fractional t) => t -> Var m t t+timeAsPercentageOf t = proc dt -> do+    t' <- accumulate (+) 0 -< dt+    returnA -< min 1 (t' / t)
+ src/Example.hs view
@@ -0,0 +1,67 @@+module Main where++import Control.Varying+import Control.Varying.Time as Time -- time is not auto-exported+import Text.Printf++-- | A simple 2d point type.+data Point = Point { x :: Float+                   , y :: Float+                   } deriving (Show, Eq)++-- | Our Point value that varies over time continuously in x and y.+backAndForth :: Var IO a Point+backAndForth =+    -- Here we use Applicative to construct a varying Point that takes time+    -- as an input.+    (Point <$> tweenx <*> tweeny)+        -- Here we feed the varying Point a time signal using the 'plug left'+        -- function. We could similarly use the 'plug right' (~>) function+        -- and put the time signal before the Point. This is needed because the+        -- tweens take time as an input.+        <~ time++-- An exponential tween back and forth from 0 to 100 over 2 seconds.+tweenx :: Monad m => Var m Float Float+tweenx =+    -- Tweens only happen for a certain duration and so their sample+    -- values have the type (Ord t, Fractional t => Event t). After construction+    -- a tween's full type will be+    -- (Ord t, Fractional t, Monad m) => Var m t (Event t).+     tween easeOutExpo 0 100 1+         -- We can chain another tween back to the starting position using+         -- `andThenE`, which will sample the first tween until it ends and then+         -- switch to sampling the next tween.+         `andThenE`+             -- Tween back to the starting position.+             tween easeOutExpo 100 0 1+                 -- At this point our resulting sample values will still have the+                 -- type (Event Float). The tween as a whole will be an event+                 -- stream. The tween also only runs back and forth once. We'd+                 -- like the tween to loop forever so that our point cycles back+                 -- and forth between 0 and 100 indefinitely.+                 -- We can accomplish this with recursion and the `andThen`+                 -- combinator, which samples an event stream until it+                 -- inhibits and then switches to a normal value stream (a+                 -- varying value). Put succinctly, it disolves our events into+                 -- values.+                 `andThen` tweenx++-- A quadratic tween back and forth from 0 to 100 over 2 seconds.+tweeny :: Monad m => Var m Float Float+tweeny =+    tween easeOutQuad 0 100 1 `andThenE` tween easeOutQuad 100 0 1 `andThen` tweeny++-- Our time signal.+time :: Var IO a Float+time = deltaUTC++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" (x point) (y point)+                          loop vNext+
+ varying.cabal view
@@ -0,0 +1,97 @@+-- Initial varying.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                varying++-- The package version.  See the Haskell package versioning policy (PVP)+-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            Automaton based varying values, event streams and tweening.++-- A longer description of the package.+description:         Varying is another FRP or LSP library aimed at providing a+                     simple way to describe discrete or continuously varying+                     values. It is capable of tweening values out of the box and+                     provides a small, well documented API.++-- URL for the project homepage or repository.+homepage:            https://github.com/schell/varying++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Schell Scivally++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer:          schell.scivally@synapsegroup.com++-- A copyright notice.+-- copyright:++category:            Control++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a+-- README.+-- extra-source-files:++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/schell/varying.git++library+  ghc-options:         -Wall+  -- Modules exported by the library.+  exposed-modules:     Control.Varying,+                       Control.Varying.Core,+                       Control.Varying.Time,+                       Control.Varying.Event,+                       Control.Varying.Tween++  -- Modules included in this library but not exported.+  -- other-modules:++  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:++  -- Other library packages from which modules are imported.+  build-depends:       base >=4.8 && <4.9,+                       time >=1.5 && <1.6++  -- Directories containing source files.+  hs-source-dirs:      src++  -- Base language which the package is written in.+  default-language:    Haskell2010++executable varying-example+  ghc-options:         -Wall++  -- Other library packages from which modules are imported.+  build-depends:       base >=4.8 && <4.9,+                       time >=1.5 && <1.6,+                       varying++  -- Directories containing source files.+  hs-source-dirs:      src++  main-is:             Example.hs++  -- Base language which the package is written in.+  default-language:    Haskell2010