varying 0.6.0.0 → 0.8.1.0
raw patch · 13 files changed
Files
- README.md +20/−6
- app/Main.hs +43/−50
- bench/Main.hs +15/−15
- changelog.md +12/−0
- src/Control/Varying.hs +14/−22
- src/Control/Varying/Core.hs +798/−635
- src/Control/Varying/Event.hs +170/−220
- src/Control/Varying/Spline.hs +399/−125
- src/Control/Varying/Time.hs +0/−23
- src/Control/Varying/Tween.hs +201/−102
- test/DocTests.hs +7/−0
- test/Main.hs +38/−36
- varying.cabal +95/−132
README.md view
@@ -1,10 +1,11 @@ # varying [](http://hackage.haskell.org/package/varying)-[](https://travis-ci.org/schell/varying)+[](https://gitlab.com/schell/varying) This library provides automaton based value streams and sequencing useful for functional reactive programming (FRP) and locally stateful programming (LSP). + ## Getting started ```haskell@@ -26,7 +27,7 @@ -- An exponential tween back and forth from 0 to 50 over 1 seconds that -- loops forever. This spline takes float values of delta time as input, -- outputs the current x value at every step.-tweenx :: (Applicative m, Monad m) => TweenT Float Float m Float+tweenx :: Monad m => TweenT Float Float m Float tweenx = do -- Tween from 0 to 50 over 1 second tween_ easeOutExpo 0 50 1@@ -35,20 +36,20 @@ -- Loop forever tweenx --- A quadratic tween back and forth from 0 to 50 over 1 seconds that never+-- An exponential tween back and forth from 0 to 50 over 1 seconds that never -- ends.-tweeny :: (Applicative m, Monad m) => TweenT Float Float m Float+tweeny :: Monad m => TweenT Float Float m Float tweeny = do tween_ easeOutExpo 50 0 1 tween_ easeOutExpo 0 50 1 tweeny -- Our time signal counts input delta time samples.-time :: (Applicative m, Monad m) => VarT m Delta Float+time :: Monad m => VarT m Delta Float time = var unDelta -- | Our Point value that varies over time continuously in x and y.-backAndForth :: (Applicative m, Monad m) => VarT m Delta Point+backAndForth :: Monad m => VarT m Delta Point backAndForth = -- Turn our splines into continuous output streams. We must provide -- a starting value since splines are not guaranteed to be defined at@@ -93,4 +94,17 @@ f _ _ = ' ' putStrLn str loop vNext t1+```++# Publications++The concept of `VarT` that this library is built on is isomorphic to Monadic Stream Functions as defined in "[Functional Reactive Programming, Refactored](http://dl.acm.org/citation.cfm?id=2976010)" ([mirror](http://www.cs.nott.ac.uk/~psxip1/#FRPRefactored)).++The isomorphism is+``` haskell+toMSF :: Functor m => VarT m a b -> MSF m a b+toMSF = MSF . (fmap . fmap . fmap $ toMSF) . runVarT++toVarT :: Functor m => MSF m a b -> VarT m a b+toVarT = VarT . (fmap . fmap . fmap $ toVarT) . unMSF ```
app/Main.hs view
@@ -1,44 +1,51 @@ module Main where -import Control.Varying-import Control.Applicative-import Control.Concurrent (forkIO, killThread)-import Data.Functor.Identity-import Data.Time.Clock+import Control.Concurrent (threadDelay)+import Control.Varying+import Data.Function (fix)+import Data.Functor.Identity (Identity (..))+import Data.Time.Clock (diffUTCTime, getCurrentTime) -- | A simple 2d point type. data Point = Point { px :: Float , py :: Float } deriving (Show, Eq) -newtype Delta = Delta { unDelta :: Float } +-- | The duration (in seconds) to tween in each direction.+dur :: Float+dur = 3+++-- | A novel, start-stop tween.+easeMiddle :: Monad m => Float -> Float -> Float -> TweenT Float Float m ()+easeMiddle start end t = do+ let change = end - start+ tween_ easeOutExpo start (start + change/2) $ t/2+ tween_ easeInExpo (start + change/2) end $ t/2+ -- An exponential tween back and forth from 0 to 50 over 1 seconds that -- loops forever. This spline takes float values of delta time as input, -- outputs the current x value at every step.-tweenx :: (Applicative m, Monad m) => TweenT Float Float m Float+tweenx :: Monad m => TweenT Float Float m () tweenx = do- -- Tween from 0 to 50 over 1 second- tween_ easeOutExpo 0 50 1+ -- Tween from 0 to 50 over 'dur' seconds+ easeMiddle 0 50 dur -- Chain another tween back to the starting position- tween_ easeOutExpo 50 0 1+ easeMiddle 50 0 dur -- Loop forever tweenx -- A quadratic tween back and forth from 0 to 50 over 1 seconds that never -- ends.-tweeny :: (Applicative m, Monad m) => TweenT Float Float m Float+tweeny :: Monad m => TweenT Float Float m () tweeny = do- tween_ easeOutExpo 50 0 1- tween_ easeOutExpo 0 50 1+ easeMiddle 50 0 dur+ easeMiddle 0 50 dur tweeny --- Our time signal counts input delta time samples.-time :: (Applicative m, Monad m) => VarT m Delta Float-time = var unDelta- -- | Our Point value that varies over time continuously in x and y.-backAndForth :: (Applicative m, Monad m) => VarT m Delta Point+backAndForth :: Monad m => VarT m Float Point backAndForth = -- Turn our splines into continuous output streams. We must provide -- a starting value since splines are not guaranteed to be defined at@@ -48,38 +55,24 @@ 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, and then a newline to quit"- _ <- getLine-- t <- getCurrentTime- tId <- forkIO $ loop backAndForth t-- _ <- getLine- killThread tId--loop :: Var Delta Point -> UTCTime -> IO ()-loop v t = do- t1 <- getCurrentTime- -- Here we'll run in the Identity monad using a time delta provided by- -- getCurrentTime and diffUTCTime.- let dt = realToFrac $ diffUTCTime t1 t- Identity (Point x y, vNext) = runVarT v $ Delta dt- xStr = replicate (round x) ' ' ++ "x" ++ replicate (50 - round x) ' '- yStr = replicate (round y) ' ' ++ "y" ++ replicate (50 - round y) ' '- str = zipWith f xStr yStr- f 'x' 'y' = '|'- f 'y' 'x' = '|'- f a ' ' = a- f ' ' b = b- f _ _ = ' '- putStrLn str- loop vNext t1+ t <- getCurrentTime+ ($ t) . ($ backAndForth) $ fix $ \loop v lastT -> do+ thisT <- getCurrentTime+ -- Here we'll run in the Identity monad using a time delta provided by+ -- getCurrentTime and diffUTCTime.+ let dt = realToFrac $ diffUTCTime thisT lastT+ Identity (Point x y, vNext) = runVarT v dt+ xStr = replicate (round x) ' ' ++ "x" ++ replicate (50 - round x) ' '+ yStr = replicate (round y) ' ' ++ "y" ++ replicate (50 - round y) ' '+ str = zipWith f xStr yStr+ f 'x' 'y' = '|'+ f 'y' 'x' = '|'+ f a ' ' = a+ f ' ' b = b+ f _ _ = ' '+ putStrLn str+ threadDelay $ floor $ 1000000 / (20 :: Double)+ loop vNext thisT
bench/Main.hs view
@@ -7,25 +7,25 @@ main :: IO () main = do let run v a = runIdentity (fst <$> runVarT v a)- defaultMain $ [ bgroup "runVarT" [ bench "1" $ nf (run $ chain 1) 0- , bench "2" $ nf (run $ chain 2) 0- , bench "4" $ nf (run $ chain 4) 0- , bench "8" $ nf (run $ chain 8) 0- , bench "16" $ nf (run $ chain 16) 0- , bench "32" $ nf (run $ chain 32) 0- , bench "64" $ nf (run $ chain 64) 0- , bench "128" $ nf (run $ chain 128) 0- ]- , bgroup "TweenT"- [ bench "tweenStream" $- nf (run $ tweenStream myTween 0) 0- ]- ]+ defaultMain [ bgroup "runVarT" [ bench "1" $ nf (run $ chain 1) 0+ , bench "2" $ nf (run $ chain 2) 0+ , bench "4" $ nf (run $ chain 4) 0+ , bench "8" $ nf (run $ chain 8) 0+ , bench "16" $ nf (run $ chain 16) 0+ , bench "32" $ nf (run $ chain 32) 0+ , bench "64" $ nf (run $ chain 64) 0+ , bench "128" $ nf (run $ chain 128) 0+ ]+ , bgroup "TweenT"+ [ bench "tweenStream" $+ nf (run $ tweenStream myTween 0) 0+ ]+ ] return () chain :: Int -> Var Int Int chain n = seq x x- where x = foldl (~>) (var (+1)) $ take (n - 1) $ cycle [var (+1)]+ where x = foldl (>>>) (var (+1)) $ replicate (n - 1) $ var (+1) myTween :: Tween Float Float () myTween = do
changelog.md view
@@ -24,3 +24,15 @@ 0.6.0.0 - changed the internal type of SplineT to use Either, reducing unused output values and preventing time/space leaks. Updated tween types. Added withTween(_).++0.7.0.0 - added proofs, reduced API size by removing trivial or weird (special)+ combinators, changed some names, Event is a synonym of Maybe, removed+ Time (moved functions to Event), renamed Event.mergeE to Event.bothE,+ added Spline.untilProc and Spline.whileProc, documentation - working+ towards 1.0++0.7.1.2 - Fixed broken ArrowLoop instance, updated documentation.++0.8.0.0 - TweenT is a newtype.++0.8.1.0 - Remove senseless ArrowApply instance
src/Control/Varying.hs view
@@ -1,37 +1,29 @@ -- | -- Module: Control.Varying--- Copyright: (c) 2015 Schell Scivally+-- Copyright: (c) 2016 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+-- Maintainer: Schell Scivally <schell@takt.com> -- -- [@Core@]--- Get started writing value streams using the pure constructor 'var', the--- monadic constructor 'varM' or the raw constructor 'VarT'+-- Automaton based value streams. -- -- [@Event@]--- Write event streams using the many event emitters and combinators.+-- Discontinuous value streams that occur only sometimes. -- -- [@Spline@]--- Use do-notation to sequence event streams to form complex behavior.+-- Sequencing of value and event streams using do-notation to form complex+-- behavior. -- -- [@Tween@]--- Tween numerical values over time using interpolation functions and the--- "quick 'n dirty" time generators in 'Control.Varying.Time'.------ [@Time@]--- Create time streams and temporal event streams.+-- Tween numerical values over time using common easing functions. Great for+-- animation. -- module Control.Varying (- -- * Reexports- module Control.Varying.Core,- module Control.Varying.Event,- module Control.Varying.Spline,- module Control.Varying.Time,- module Control.Varying.Tween,+ -- * Reexports+ module V ) where -import Control.Varying.Core-import Control.Varying.Event-import Control.Varying.Tween-import Control.Varying.Time-import Control.Varying.Spline+import Control.Varying.Core as V+import Control.Varying.Event as V+import Control.Varying.Spline as V+import Control.Varying.Tween as V
src/Control/Varying/Core.hs view
@@ -1,635 +1,798 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE BangPatterns #-}--- |--- Module: Control.Varying.Core--- Copyright: (c) 2015 Schell Scivally--- License: MIT--- Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>------ 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 '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,- VarT(..),- -- * Creating value streams- -- $creation- done,- var,- varM,- mkState,- -- * Composing value streams- -- $composition- (<~),- (~>),- (<<<),- (>>>),- -- * Adjusting and accumulating- delay,- accumulate,- -- * Sampling value streams (running and other entry points)- -- $running- scanVar,- stepMany,- -- * Tracing value streams in flight- vtrace,- vstrace,- vftrace,-) where--import Prelude hiding (id, (.))-import Control.Arrow-import Control.Category-import Control.Monad-import Control.Applicative-import Data.Monoid-import Data.Functor.Identity-import Debug.Trace------------------------------------------------------------------------------------ Core datatypes------------------------------------------------------------------------------------ | 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.-newtype 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.------------------------------------------------------------------------------------ $creation--- You can create a pure value stream by lifting a function @(a -> b)@--- with 'var':------ @--- addsOne :: Monad m => VarT m Int Int--- addsOne = var (+1)--- @------ 'var' is equivalent to 'arr'.------ You can create a monadic value stream by lifting a monadic computation--- @(a -> m b)@ using 'varM':------ @--- getsFile :: VarT IO FilePath String--- getsFile = varM readFile--- @------ You can create either with the raw constructor. You can also create your--- own combinators using the raw constructor, as it allows you full control--- over how value streams are stepped and sampled:------ @--- 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 stream.-var :: Applicative m => (a -> b) -> VarT m a b-var f = VarT $ \(!a) -> pure (f a, var f)---- | Lift a constant value into a stream.-done :: (Applicative m, Monad m) => b -> VarT m a b-done b = VarT $ \(!_) -> return (b, done b)---- | 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 stream from a state transformer.-mkState :: Monad m- => (a -> s -> (b, s)) -- ^ state transformer- -> s -- ^ intial state- -> VarT m a b-mkState f s = VarT $ \(!a) -> do- let (b', s') = f a s- return (b', mkState f s')------------------------------------------------------------------------------------ $running--- To sample a stream simply run it in the desired monad with--- 'runVarT'. This will produce a sample value and a new stream.------ > do (sample, v') <- runVarT v inputValue------------------------------------------------------------------------------------- | Iterate a stream over a list of input until all input is consumed,--- then iterate the stream using one single input. Returns the resulting--- output value and the new stream.-stepMany :: (Monad m, Functor m) => VarT m a b -> [a] -> a -> m (b, VarT m a b)-stepMany v [] e = runVarT v e-stepMany v (e:es) x = snd <$> runVarT v e >>= \v1 -> stepMany v1 es x---- | 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], VarT m a b)-scanVar v = foldM f ([], v)- where f (outs, v') a = do (b, v'') <- runVarT v' a- return (outs ++ [b], v'')------------------------------------------------------------------------------------ Testing and debugging------------------------------------------------------------------------------------ | 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 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 streams.-vftrace :: Applicative a => (b -> String) -> VarT a b b-vftrace f = var $ \b -> trace (f b) b------------------------------------------------------------------------------------ Adjusting and accumulating------------------------------------------------------------------------------------ | Accumulates input values using a folding function and yields--- that accumulated value each sample.-accumulate :: (Monad m, Applicative 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')---- | Delays the given stream by one sample using the argument as the first--- sample. This enables the programmer to create streams that depend on--- themselves for values. For example:------ > let v = 1 + delay 0 v in testVar_ v-delay :: (Monad m, Applicative 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 Arrow's '>>>' and '<<<' or the--- synonyms '~>' and '<~'. The "right plug" ('>>>' and '~>') takes the output--- from a value stream on the left and "plugs" it into the input of the value--- stream on the right.--- The "left plug" does the same thing in the opposite direction. This allows--- you to write value streams that read naturally.----------------------------------------------------------------------------------(~>) :: (Monad m, Applicative m) => VarT m a b -> VarT m b c -> VarT m a c-(~>) = (>>>)--(<~) :: (Monad m, Applicative m) => VarT m b c -> VarT m a b -> VarT m a c-(<~) = (<<<)------------------------------------------------------------------------------------ Typeclass instances------------------------------------------------------------------------------------ | 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 (VarT 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 (Applicative m, Monad m) => Category (VarT m) where- id = var id- f0 . g0 = VarT $ \(!a) -> do- (b, g) <- runVarT g0 a- (c, f) <- runVarT f0 b- return (c, f . g)---- | Streams are applicative.------ > (,) <$> pure True <*> var "Applicative"-instance (Applicative m, Monad m) => Applicative (VarT m a) where- pure = done- vf <*> vx = VarT $ \(!a) -> do- (f, vf') <- runVarT vf a- (x, vx') <- runVarT vx a- return (f x, vf' <*> vx')--- Note [1]---- | Streams 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 (Applicative m, Monad m) => Arrow (VarT m) where- arr = var- first v = VarT $ \(b,d) -> do (c, v') <- runVarT v b- return ((c,d), first v')---- | Streams can be monoids------ > let v = var (const "Hello ") `mappend` var (const "World!")-instance (Applicative m, Monad m, Monoid b) => Monoid (VarT m a b) where- mempty = pure mempty- mappend = liftA2 mappend---- | 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 (VarT m a b) where- (+) = liftA2 (+)- (-) = liftA2 (-)- (*) = liftA2 (*)- abs = fmap abs- signum = fmap signum- fromInteger = pure . fromInteger---- | 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 (VarT 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---- | 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 (VarT m a b) where- (/) = liftA2 (/)- fromRational = pure . fromRational----- [1] Proof of the applicative laws:------ identity--- ========--- pure id <*> va = va------ -- Definition of pure--- VarT (\_ -> pure (id, pure id)) <*> v------ -- Definition of <*>--- VarT (\x -> do--- (f, vf') <- runVarT (VarT (\_ -> pure (id, pure id))) x--- (a, va') <- runVarT va x--- pure (f a, vf' <*> va'))------ -- Newtype--- VarT (\x -> do--- (f, vf') <- (\_ -> pure (id, pure id)) x--- (a, va') <- runVarT va x--- pure (f a, vf' <*> va'))------ -- Application--- VarT (\x -> do--- (f, vf') <- pure (id, pure id)--- (a, va') <- runVarT va x--- pure (f a, vf' <*> va'))------ -- pure x >>= f = f x--- VarT (\x -> do--- (a, va') <- runVarT va x--- pure (id a, pure id <*> va'))------ -- Definition of id--- VarT (\x -> do--- (a, va') <- runVarT va x--- pure (a, pure id <*> va'))------ -- Coinduction--- VarT (\x -> do--- (a, va') <- runVarT va x--- pure (a, va'))------ -- f >>= pure = f--- VarT (\x -> runVarT va x)------ -- Eta reduction--- VarT (runVarT va)------ -- Newtype--- va--------- composition--- ===========--- pure (.) <*> u <*> v <*> w = u <*> (v <*> w)------ -- Definition of pure--- VarT (\_ -> pure ((.), pure (.))) <*> u <*> v <*> w------ -- Definition of <*>--- VarT (\x -> do--- (h, t) <- runVarT (VarT (\_ -> pure ((.), pure (.)))) x--- (f, u') <- runVarT u x--- pure (h f, t <*> u')) <*> v <*> w------ -- Newtype--- VarT (\x -> do--- (h, t) <- (\_ -> pure ((.), pure (.))) x--- (f, u') <- runVarT u x--- pure (h f, t <*> u')) <*> v <*> w------ -- Application--- VarT (\x -> do--- (h, t) <- pure ((.), pure (.)))--- (f, u') <- runVarT u x--- pure (h f, t <*> u')) <*> v <*> w------ -- pure x >>= f = f x--- VarT (\x -> do--- (f, u') <- runVarT u x--- pure ((.) f, pure (.) <*> u')) <*> v <*> w------ -- Definition of <*>--- VarT (\x -> do--- (h, t) <---- runVarT--- (VarT (\y -> do--- (f, u') <- runVarT u y--- pure ((.) f, pure (.) <*> u'))) x--- (g, v') <- runVarT v x--- pure (h g, t <*> v')) <*> w------ -- Newtype--- VarT (\x -> do--- (h, t) <---- (\y -> do--- (f, u') <- runVarT u y--- pure ((.) f, pure (.) <*> u')) x--- (g, v') <- runVarT v x--- pure (h g, t <*> v')) <*> w------ -- Application--- VarT (\x -> do--- (h, t) <- do--- (f, u') <- runVarT u x--- pure ((.) f, pure (.) <*> u')--- (g, v') <- runVarT v x--- pure (h g, t <*> v')) <*> w------ -- (f >=> g) >=> h = f >=> (g >=> h)--- VarT (\x -> do--- (f, u') <- runVarT u x--- (h, t) <- pure ((.) f, pure (.) <*> u')--- (g, v') <- runVarT v x--- pure (h g, t <*> v')) <*> w------ -- pure x >>= f = f x--- VarT (\x -> do--- (f, u') <- runVarT u x--- (g, v') <- runVarT v x--- pure ((.) f g, pure (.) <*> u' <*> v')) <*> w------ -- Definition of <*>--- VarT (\x -> do--- (h, t) <---- runVarT--- (VarT (\y -> do--- (f, u') <- runVarT u y--- (g, v') <- runVarT v y--- pure ((.) f g, pure (.) <*> u' <*> v'))) x--- (a, w') <- runVarT w x--- pure (h a, t <*> w'))------ -- Newtype--- VarT (\x -> do--- (h, t) <---- (\y -> do--- (f, u') <- runVarT u y--- (g, v') <- runVarT v y--- pure ((.) f g, pure (.) <*> u' <*> v')) x--- (a, w') <- runVarT w x--- pure (h a, t <*> w'))------ -- Application--- VarT (\x -> do--- (h, t) <- do--- (f, u') <- runVarT u x--- (g, v') <- runVarT v x--- pure ((.) f g, pure (.) <*> u' <*> v'))--- (a, w') <- runVarT w x--- pure (h a, t <*> w'))------ -- (f >=> g) >=> h = f >=> (g >=> h)--- VarT (\x -> do--- (f, u') <- runVarT u x--- (g, v') <- runVarT v x--- (h, t) <- pure ((.) f g, pure (.) <*> u' <*> v'))--- (a, w') <- runVarT w x--- pure (h a, t <*> w'))------ -- pure x >>= f = f x--- VarT (\x -> do--- (f, u') <- runVarT u x--- (g, v') <- runVarT v x--- (a, w') <- runVarT w x--- pure ((.) f g a, pure (.) <*> u' <*> v' <*> w'))------ -- Definition of .--- VarT (\x -> do--- (f, u') <- runVarT u x--- (g, v') <- runVarT v x--- (a, w') <- runVarT w x--- pure (f (g a), pure (.) <*> u' <*> v' <*> w'))------ -- Coinduction--- VarT (\x -> do--- (f, u') <- runVarT u x--- (g, v') <- runVarT v x--- (a, w') <- runVarT w x--- pure (f (g a), u' <*> (v' <*> w')))------ -- pure x >>= f = f--- VarT (\x -> do--- (f, u') <- runVarT u x--- (g, v') <- runVarT v x--- (a, w') <- runVarT w x--- (b, vw) <- pure (g a, v' <*> w')--- pure (f b, u' <*> vw))------ -- (f >=> g) >=> h = f >=> (g >=> h)--- VarT (\x -> do--- (f, u') <- runVarT u x--- (b, vw) <- do--- (g, v') <- runVarT v x--- (a, w') <- runVarT w x--- pure (g a, v' <*> w')--- pure (f b, u' <*> vw))------ -- Abstraction--- VarT (\x -> do--- (f, u') <- runVarT u x--- (b, vw) <---- (\y -> do--- (g, v') <- runVarT v y--- (a, w') <- runVarT w y)--- pure (g a, v' <*> w')) x--- pure (f b, u' <*> vw))------ -- Newtype--- VarT (\x -> do--- (f, u') <- runVarT u x--- (b, vw) <---- runVarT--- (VarT (\y -> do--- (g, v') <- runVarT v y--- (a, w') <- runVarT w y)--- pure (g a, v' <*> w')) x--- pure (f b, u' <*> vw))------ -- Definition of <*>--- VarT (\x -> do--- (f, u') <- runVarT u x--- (b, vw) <- runVarT (v <*> w) x--- pure (f b, u' <*> vw))------ -- Definition of <*>--- u <*> (v <*> w)--------- homomorphism--- ============--- pure f <*> pure a = pure (f a)------ -- Definition of pure--- VarT (\_ -> pure (f, pure f)) <*> pure a------ -- Definition of pure--- VarT (\_ -> pure (f, pure f)) <*> VarT (\_ -> pure (a, pure a))------ -- Definition of <*>--- VarT (\x -> do--- (f', vf') <- runVarT (VarT (\_ -> pure (f, pure f))) x--- (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x--- pure (f' a', vf' <*> va'))------ -- Newtype--- VarT (\x -> do--- (f', vf') <- (\_ -> pure (f, pure f)) x--- (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x--- pure (f' a', vf' <*> va'))------ -- Application--- VarT (\x -> do--- (f', vf') <- pure (f, pure f)--- (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x--- pure (f' a', vf' <*> va'))------ -- pure x >>= f = f x--- VarT (\x -> do--- (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x--- pure (f a', pure f <*> va'))------ -- Newtype--- VarT (\x -> do--- (a', va') <- (\_ -> pure (a, pure a)) x--- pure (f a', pure f <*> va'))------ -- Application--- VarT (\x -> do--- (a', va') <- pure (a, pure a)--- pure (f a', pure f <*> va'))------ -- pure x >>= f = f x--- VarT (\x -> pure (f a, pure f <*> pure a))------ -- Coinduction--- VarT (\x -> pure (f a, pure (f a)))------ -- Definition of pure--- pure (f a)--------- interchange--- ===========--- u <*> pure y = pure ($ y) <*> u------ -- Definition of <*>--- VarT (\x -> do--- (f, u') <- runVarT u x--- (a, y') <- runVarT (pure y) x--- pure (f a, u' <*> y'))------ -- Definition of pure--- VarT (\x -> do--- (f, u') <- runVarT u x--- (a, y') <- runVarT (VarT (\_ -> pure (y, pure y))) x--- pure (f a, u' <*> y'))------ -- Newtype--- VarT (\x -> do--- (f, u') <- runVarT u x--- (a, y') <- (\_ -> pure (y, pure y)) x--- pure (f a, u' <*> y'))------ -- Application--- VarT (\x -> do--- (f, u') <- runVarT u x--- (a, y') <- pure (y, pure y))--- pure (f a, u' <*> y'))------ -- pure x >>= f = f--- VarT (\x -> do--- (f, u') <- runVarT u x--- pure (f y, u' <*> pure y))------ -- Coinduction--- VarT (\x -> do--- (f, u') <- runVarT u x--- pure (f y, pure ($ y) <*> u'))------ -- Definition of $--- VarT (\x -> do--- (f, u') <- runVarT u x--- pure (($ y) f, pure ($ y) <*> u')------ -- pure x >>= f = f--- VarT (\x -> do--- (g, y') <- pure (($ y), pure ($ y))--- (f, u') <- runVarT u x--- pure (g f, y' <*> u')------ -- Abstraction--- VarT (\x -> do--- (g, y') <- (\_ -> pure (($ y), pure ($ y))) x--- (f, u') <- runVarT u x--- pure (g f, y' <*> u')------ -- Newtype--- VarT (\x -> do--- (g, y') <- runVarT (VarT (\_ -> pure (($ y), pure ($ y)))) x--- (f, u') <- runVarT u x--- pure (g f, y' <*> u')------ -- Definition of <*>--- VarT (\_ -> pure (($ y), pure ($ y))) <*> u------ -- Definition of pure--- pure ($ y) <*> u+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Control.Varying.Core+-- Copyright: (c) 2015 Schell Scivally+-- License: MIT+-- Maintainer: Schell Scivally <schell@takt.com>+--+-- Varying values represent values that change over a given domain.+--+-- A varying value takes some input as its domain (e.g. time, place, etc)+-- and when run using 'runVarT' it produces a value and a new varying value.+-- This pattern is known as an automaton and `varying` uses this pattern at its+-- core. With the additon of monadic event sequencing, 'varying' makes it easy+-- to construct complicated signals that control program and data flow.+module Control.Varying.Core+ ( -- * Types and Typeclasses+ Var+ , VarT(..)+ -- * Creating vars+ -- $creation+ , done+ , var+ , arr+ , varM+ , mkState+ -- * Composing vars+ -- $composition+ , (<<<)+ , (>>>)+ -- * Adjusting and accumulating+ , delay+ , accumulate+ -- * Sampling vars (running and other entry points)+ -- $running+ , scanVar+ , stepMany+ -- * Debugging and tracing vars in flight+ , vtrace+ , vstrace+ , vftrace+ , testVarOver+ -- * Proofs of the Applicative laws+ -- $proofs+ ) where++import Control.Applicative+import Control.Arrow+import Control.Category+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Data.Functor.Contravariant+import Data.Functor.Identity+import Debug.Trace+import Prelude hiding (id, (.))++--------------------------------------------------------------------------------+-- Core datatypes+--------------------------------------------------------------------------------+-- | A continuously varying value, with effects.+-- It's a kind of <https://en.wikipedia.org/wiki/Mealy_machine Mealy machine>+-- (an automaton).+newtype VarT m a b+ = VarT+ { runVarT :: a -> m (b, VarT m a b) }+ -- ^ Run a @VarT@ computation with an input value of+ -- type 'a', yielding a step - a value of type 'b'+ -- and a new computation for yielding the next step.+++-- | A var 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++--------------------------------------------------------------------------------+-- Typeclass instances+--------------------------------------------------------------------------------+-- | You can transform the output value of any var:+--+-- >>> let v = 1 >>> fmap (*3) (accumulate (+) 0)+-- >>> testVarOver v [(),(),()]+-- 3+-- 6+-- 9+instance Applicative m => Functor (VarT m b) where+ fmap f v = VarT $ (g <$>) . runVarT v+ where g (b, vb) = (f b, f <$> vb)++-- | A var is a category.+--+-- @+-- id = var id+-- f . g = g >>> f+-- @+--+-- or+--+-- > f . g = f <<< g+--+-- >>> let v = accumulate (+) 0 . 1+-- >>> testVarOver v [(),(),()]+-- 1+-- 2+-- 3+instance Monad m => Category (VarT m) where+ id = var id+ f0 . g0 = VarT $ \a -> do+ (b, g) <- runVarT g0 a+ (c, f) <- runVarT f0 b+ return (c, f . g)++-- | Vars are applicative.+--+-- >>> let v = (,) <$> pure True <*> pure "Applicative"+-- >>> testVarOver v [()]+-- (True,"Applicative")+--+-- Note - checkout the <$proofs proofs>+instance Applicative m => Applicative (VarT m a) where+ pure = done+ vf <*> vx = VarT $ \a ->+ g <$> runVarT vf a <*> runVarT vx a+ where g (f, vf1) (x, vx1) = (f x, vf1 <*> vx1)++-- | Vars are arrows, which means you can use proc notation, among other+-- meanings.+--+-- >>> :set -XArrows+-- >>> :{+-- let v = proc t -> do+-- x <- accumulate (+) 0 -< t+-- y <- accumulate (+) 1 -< t+-- returnA -< x + y+-- in testVarOver v [1,1,1]+-- >>> :}+-- 3+-- 5+-- 7+--+-- which is equivalent to+--+-- >>> let v = (+) <$> accumulate (+) 0 <*> accumulate (+) 1+-- >>> testVarOver v [1,1,1]+-- 3+-- 5+-- 7+instance Monad m => Arrow (VarT m) where+ arr = var+ first v = VarT $ \(b, d) -> g d <$> runVarT v b+ where g d (c, v') = ((c, d), first v')++instance MonadPlus m => ArrowZero (VarT m) where+ zeroArrow = varM $ const mzero++instance MonadPlus m => ArrowPlus (VarT m) where+ VarT f <+> VarT g = VarT $ \a -> f a `mplus` g a++-- |+instance Monad m => ArrowChoice (VarT m) where+ left f = f +++ arr id+ right f = arr id +++ f+ f +++ g = (f >>> arr Left) ||| (g >>> arr Right)+ f ||| g = VarT $ \case+ Left b -> do+ (d, f1) <- runVarT f b+ return (d, f1 ||| g)+ Right c -> do+ (d, g1) <- runVarT g c+ return (d, f ||| g1)++-- | Inputs can depend on outputs as long as no time-travel is required.+--+-- This isn't the best example but it does make a good test case:+--+-- >>> :{+-- let+-- testVar :: VarT IO Double (Maybe Double)+-- testVar = proc val -> do+-- rec _ <- returnA -< 0.5+-- returnA -< Just 5.0+-- in+-- testVarOver testVar [5.0]+-- >>> :}+-- Just 5.0+instance MonadFix m => ArrowLoop (VarT m) where+ loop vmbdcd = VarT $ \b -> fmap fst $ mfix $ \(~(_, d)) -> do+ ((c1, d1), vmbdcd1) <- runVarT vmbdcd (b, d)+ return ((c1, loop vmbdcd1), d1)++-- | VarT with its input and output parameters flipped.+newtype FlipVarT m b a = FlipVarT { unFlipVarT :: VarT m a b }++-- | A VarT is contravariant when the type arguments are flipped.+instance Monad m => Contravariant (FlipVarT m b) where+ contramap f (FlipVarT vmab) = FlipVarT $ VarT $ \c -> do+ (b, vmab1) <- runVarT vmab $ f c+ return (b, unFlipVarT $ contramap f $ FlipVarT vmab1)++#if __GLASGOW_HASKELL__ >= 804+-- | Vars can be semigroups+--+-- >>> let v = var (const "Hello ") <> var (const "World!")+-- >>> testVarOver v [()]+-- "Hello World!"+instance (Applicative m, Semigroup b) => Semigroup (VarT m a b) where+ (<>) = liftA2 (<>)+#endif++-- | Vars can be monoids+--+-- >>> let v = var (const "Hello ") `mappend` var (const "World!")+-- >>> testVarOver v [()]+-- "Hello World!"+instance (Applicative m, Monoid b) => Monoid (VarT m a b) where+ mempty = pure mempty+ mappend = liftA2 mappend++-- | Vars can be written as numbers.+--+-- >>> let v = 1 >>> accumulate (+) 0+-- >>> testVarOver v [(),(),()]+-- 1+-- 2+-- 3+instance (Monad m, Num b) => Num (VarT m a b) where+ (+) = liftA2 (+)+ (-) = liftA2 (-)+ (*) = liftA2 (*)+ abs = fmap abs+ signum = fmap signum+ fromInteger = pure . fromInteger++-- | Vars can be written as floats.+--+-- >>> let v = pi >>> accumulate (*) 1 >>> arr round+-- >>> testVarOver v [(),(),()]+-- 3+-- 10+-- 31+instance (Monad m, Floating b) => Floating (VarT 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++-- | Vars can be written as fractionals.+--+-- >>> let v = 2.5 >>> accumulate (/) 10+-- >>> testVarOver v [(),(),()]+-- 4.0+-- 1.6+-- 0.64+instance (Monad m, Fractional b) => Fractional (VarT m a b) where+ (/) = liftA2 (/)+ fromRational = pure . fromRational+--------------------------------------------------------------------------------+-- $creation+-- You can create a pure var by lifting a function @(a -> b)@+-- with 'var':+--+-- > arr (+1) == var (+1) :: VarT m Int Int+--+-- 'var' is a parameterized version of 'arr'.+--+-- You can create a monadic var by lifting a monadic computation+-- @(a -> m b)@ using 'varM':+--+-- @+-- getsFile :: VarT IO FilePath String+-- getsFile = varM readFile+-- @+--+-- You can create either with the raw constructor. You can also create your+-- own combinators using the raw constructor, as it allows you full control+-- over how vars are stepped and sampled:+--+-- > 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 to a var. This is 'arr' parameterized over the+-- @a `VarT m` b@ arrow.+var :: Applicative m => (a -> b) -> VarT m a b+var f = VarT $ \a -> pure (f a, var f)++-- | Lift a monadic computation to a var. This is+-- <http://hackage.haskell.org/package/arrow-list-0.7/docs/Control-Arrow-Kleisli-Class.html#v:arrM arrM>+-- parameterized over the @a `VarT m` b@ arrow.+varM :: Monad m => (a -> m b) -> VarT m a b+varM f = VarT $ \a -> do+ b <- f a+ return (b, varM f)++-- | Lift a constant value to a var.+done :: Applicative m => b -> VarT m a b+done = var . const++-- | Create a var from a state transformer.+mkState :: Monad m+ => (a -> s -> (b, s)) -- ^ state transformer+ -> s -- ^ intial state+ -> VarT m a b+mkState f s = VarT $ \a -> do+ let (b', s') = f a s+ return (b', mkState f s')+--------------------------------------------------------------------------------+-- $composition+-- You can compose vars together using Category's '>>>' and '<<<'. The "right+-- plug" ('>>>') takes the output from a var on the left and "plugs" it into+-- the input of the var on the right. The "left plug" does the same thing in+-- the opposite direction. This allows you to write vars that read+-- naturally.+--------------------------------------------------------------------------------+--------------------------------------------------------------------------------+-- Adjusting and accumulating+--------------------------------------------------------------------------------+-- | Accumulates input values using a folding function and yields+-- that accumulated value each sample. This is analogous to a stepwise foldl.+--+-- >>> testVarOver (accumulate (++) []) $ words "hey there man"+-- "hey"+-- "heythere"+-- "heythereman"+--+-- >>> print $ foldl (++) [] $ words "hey there man"+-- "heythereman"+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')++-- | Delays the given var by one sample using the argument as the first+-- sample.+--+-- >>> testVarOver (delay 0 id) [1,2,3]+-- 0+-- 1+-- 2+--+-- This enables the programmer to create vars that depend on+-- themselves for values. For example:+--+-- >>> let v = delay 0 v + 1 in testVarOver v [1,1,1]+-- 1+-- 2+-- 3+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'')+--------------------------------------------------------------------------------+-- $running+-- To sample a var simply run it in the desired monad with+-- 'runVarT'. This will produce a sample value and a new var.+--+-- >>> :{+-- do let v0 = accumulate (+) 0+-- (b, v1) <- runVarT v0 1+-- print b+-- (c, v2) <- runVarT v1 b+-- print c+-- (d, _) <- runVarT v2 c+-- print d+-- >>> :}+-- 1+-- 2+-- 4+--------------------------------------------------------------------------------+-- | Iterate a var over a list of input until all input is consumed,+-- then iterate the var using one single input. Returns the resulting+-- output value and the new var.+--+-- >>> let Identity (outputs, _) = stepMany (accumulate (+) 0) [1,1,1] 1+-- >>> print outputs+-- 4+stepMany :: (Monad m) => VarT m a b -> [a] -> a -> m (b, VarT m a b)+stepMany v [] e = runVarT v e+stepMany v (e:es) x = snd <$> runVarT v e >>= \v1 -> stepMany v1 es x++-- | Run the var over the input values, gathering the output values in a+-- list.+--+-- >>> let Identity (outputs, _) = scanVar (accumulate (+) 0) [1,1,1,1]+-- >>> print outputs+-- [1,2,3,4]+scanVar :: Monad m => VarT m a b -> [a] -> m ([b], VarT m a b)+scanVar v = foldM f ([], v)+ where f (outs, v') a = do (b, v'') <- runVarT v' a+ return (outs ++ [b], v'')+--------------------------------------------------------------------------------+-- Testing and debugging+--------------------------------------------------------------------------------+-- | Trace the sample value of a var and pass it along as output. This is+-- very useful for debugging graphs of vars. The (v|vs|vf)trace family of+-- vars use 'Debug.Trace.trace' under the hood, so the value is only traced+-- when evaluated.+--+-- >>> let v = id >>> vtrace+-- >>> testVarOver v [1,2,3]+-- 1+-- 1+-- 2+-- 2+-- 3+-- 3+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 vars.+--+-- >>> let v = id >>> vstrace "test: "+-- >>> testVarOver v [1,2,3]+-- test: 1+-- 1+-- test: 2+-- 2+-- test: 3+-- 3+vstrace :: (Applicative a, Show b) => String -> VarT a b b+vstrace s = vftrace ((s ++) . show)++-- | Trace the sample value using a custom show-like function. This is useful+-- when you would like to debug a var that uses values that don't have show+-- instances.+--+-- >>> newtype NotShowableInt = NotShowableInt { unNotShowableInt :: Int }+-- >>> let v = id >>> vftrace (("NotShowableInt: " ++) . show . unNotShowableInt)+-- >>> let as = map NotShowableInt [1,1,1]+-- >>> bs <- fst <$> scanVar v as+-- >>> -- We need to do something to evaluate these output values...+-- >>> print $ sum $ map unNotShowableInt bs+-- NotShowableInt: 1+-- NotShowableInt: 1+-- NotShowableInt: 1+-- 3+vftrace :: Applicative a => (b -> String) -> VarT a b b+vftrace f = var $ \b -> trace (f b) b++-- | Run a var in IO over some input, printing the output each step. This is+-- the function we've been using throughout this documentation.+testVarOver :: (Monad m, MonadIO m, Show b)+ => VarT m a b -> [a] -> m ()+testVarOver v xs = fst <$> scanVar v xs >>= mapM_ (liftIO . print)+--------------------------------------------------------------------------------+-- $proofs+-- ==Identity+-- > pure id <*> va = va+--+-- > -- Definition of pure+-- > VarT (\_ -> pure (id, pure id)) <*> v+--+-- > -- Definition of <*>+-- > VarT (\x -> do+-- > (f, vf') <- runVarT (VarT (\_ -> pure (id, pure id))) x+-- > (a, va') <- runVarT va x+-- > pure (f a, vf' <*> va'))+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (f, vf') <- (\_ -> pure (id, pure id)) x+-- > (a, va') <- runVarT va x+-- > pure (f a, vf' <*> va'))+--+-- > -- Application+-- > VarT (\x -> do+-- > (f, vf') <- pure (id, pure id)+-- > (a, va') <- runVarT va x+-- > pure (f a, vf' <*> va'))+--+-- > -- pure x >>= f = f x+-- > VarT (\x -> do+-- > (a, va') <- runVarT va x+-- > pure (id a, pure id <*> va'))+--+-- > -- Definition of id+-- > VarT (\x -> do+-- > (a, va') <- runVarT va x+-- > pure (a, pure id <*> va'))+--+-- > -- Coinduction+-- > VarT (\x -> do+-- > (a, va') <- runVarT va x+-- > pure (a, va'))+--+-- > -- f >>= pure = f+-- > VarT (\x -> runVarT va x)+--+-- > -- Eta reduction+-- > VarT (runVarT va)+--+-- > -- Newtype+-- > va+-- >+--+-- ==Composition+-- > pure (.) <*> u <*> v <*> w = u <*> (v <*> w)+--+-- > -- Definition of pure+-- > VarT (\_ -> pure ((.), pure (.))) <*> u <*> v <*> w+--+-- > -- Definition of <*>+-- > VarT (\x -> do+-- > (h, t) <- runVarT (VarT (\_ -> pure ((.), pure (.)))) x+-- > (f, u') <- runVarT u x+-- > pure (h f, t <*> u')) <*> v <*> w+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (h, t) <- (\_ -> pure ((.), pure (.))) x+-- > (f, u') <- runVarT u x+-- > pure (h f, t <*> u')) <*> v <*> w+--+-- > -- Application+-- > VarT (\x -> do+-- > (h, t) <- pure ((.), pure (.)))+-- > (f, u') <- runVarT u x+-- > pure (h f, t <*> u')) <*> v <*> w+--+-- > -- pure x >>= f = f x+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > pure ((.) f, pure (.) <*> u')) <*> v <*> w+--+-- > -- Definition of <*>+-- > VarT (\x -> do+-- > (h, t) <-+-- > runVarT+-- > (VarT (\y -> do+-- > (f, u') <- runVarT u y+-- > pure ((.) f, pure (.) <*> u'))) x+-- > (g, v') <- runVarT v x+-- > pure (h g, t <*> v')) <*> w+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (h, t) <-+-- > (\y -> do+-- > (f, u') <- runVarT u y+-- > pure ((.) f, pure (.) <*> u')) x+-- > (g, v') <- runVarT v x+-- > pure (h g, t <*> v')) <*> w+--+-- > -- Application+-- > VarT (\x -> do+-- > (h, t) <- do+-- > (f, u') <- runVarT u x+-- > pure ((.) f, pure (.) <*> u')+-- > (g, v') <- runVarT v x+-- > pure (h g, t <*> v')) <*> w+--+-- > -- (f >=> g) >=> h = f >=> (g >=> h)+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (h, t) <- pure ((.) f, pure (.) <*> u')+-- > (g, v') <- runVarT v x+-- > pure (h g, t <*> v')) <*> w+--+-- > -- pure x >>= f = f x+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (g, v') <- runVarT v x+-- > pure ((.) f g, pure (.) <*> u' <*> v')) <*> w+--+-- > -- Definition of <*>+-- > VarT (\x -> do+-- > (h, t) <-+-- > runVarT+-- > (VarT (\y -> do+-- > (f, u') <- runVarT u y+-- > (g, v') <- runVarT v y+-- > pure ((.) f g, pure (.) <*> u' <*> v'))) x+-- > (a, w') <- runVarT w x+-- > pure (h a, t <*> w'))+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (h, t) <-+-- > (\y -> do+-- > (f, u') <- runVarT u y+-- > (g, v') <- runVarT v y+-- > pure ((.) f g, pure (.) <*> u' <*> v')) x+-- > (a, w') <- runVarT w x+-- > pure (h a, t <*> w'))+--+-- > -- Application+-- > VarT (\x -> do+-- > (h, t) <- do+-- > (f, u') <- runVarT u x+-- > (g, v') <- runVarT v x+-- > pure ((.) f g, pure (.) <*> u' <*> v'))+-- > (a, w') <- runVarT w x+-- > pure (h a, t <*> w'))+--+-- > -- (f >=> g) >=> h = f >=> (g >=> h)+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (g, v') <- runVarT v x+-- > (h, t) <- pure ((.) f g, pure (.) <*> u' <*> v'))+-- > (a, w') <- runVarT w x+-- > pure (h a, t <*> w'))+--+-- > -- pure x >>= f = f x+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (g, v') <- runVarT v x+-- > (a, w') <- runVarT w x+-- > pure ((.) f g a, pure (.) <*> u' <*> v' <*> w'))+--+-- > -- Definition of .+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (g, v') <- runVarT v x+-- > (a, w') <- runVarT w x+-- > pure (f (g a), pure (.) <*> u' <*> v' <*> w'))+--+-- > -- Coinduction+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (g, v') <- runVarT v x+-- > (a, w') <- runVarT w x+-- > pure (f (g a), u' <*> (v' <*> w')))+--+-- > -- pure x >>= f = f+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (g, v') <- runVarT v x+-- > (a, w') <- runVarT w x+-- > (b, vw) <- pure (g a, v' <*> w')+-- > pure (f b, u' <*> vw))+--+-- > -- (f >=> g) >=> h = f >=> (g >=> h)+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (b, vw) <- do+-- > (g, v') <- runVarT v x+-- > (a, w') <- runVarT w x+-- > pure (g a, v' <*> w')+-- > pure (f b, u' <*> vw))+--+-- > -- Abstraction+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (b, vw) <-+-- > (\y -> do+-- > (g, v') <- runVarT v y+-- > (a, w') <- runVarT w y)+-- > pure (g a, v' <*> w')) x+-- > pure (f b, u' <*> vw))+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (b, vw) <-+-- > runVarT+-- > (VarT (\y -> do+-- > (g, v') <- runVarT v y+-- > (a, w') <- runVarT w y)+-- > pure (g a, v' <*> w')) x+-- > pure (f b, u' <*> vw))+--+-- > -- Definition of <*>+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (b, vw) <- runVarT (v <*> w) x+-- > pure (f b, u' <*> vw))+--+-- > -- Definition of <*>+-- > u <*> (v <*> w)+--+--+-- ==Homomorphism+-- > pure f <*> pure a = pure (f a)+--+-- > -- Definition of pure+-- > VarT (\_ -> pure (f, pure f)) <*> pure a+--+-- > -- Definition of pure+-- > VarT (\_ -> pure (f, pure f)) <*> VarT (\_ -> pure (a, pure a))+--+-- > -- Definition of <*>+-- > VarT (\x -> do+-- > (f', vf') <- runVarT (VarT (\_ -> pure (f, pure f))) x+-- > (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x+-- > pure (f' a', vf' <*> va'))+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (f', vf') <- (\_ -> pure (f, pure f)) x+-- > (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x+-- > pure (f' a', vf' <*> va'))+--+-- > -- Application+-- > VarT (\x -> do+-- > (f', vf') <- pure (f, pure f)+-- > (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x+-- > pure (f' a', vf' <*> va'))+--+-- > -- pure x >>= f = f x+-- > VarT (\x -> do+-- > (a', va') <- runVarT (VarT (\_ -> pure (a, pure a))) x+-- > pure (f a', pure f <*> va'))+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (a', va') <- (\_ -> pure (a, pure a)) x+-- > pure (f a', pure f <*> va'))+--+-- > -- Application+-- > VarT (\x -> do+-- > (a', va') <- pure (a, pure a)+-- > pure (f a', pure f <*> va'))+--+-- > -- pure x >>= f = f x+-- > VarT (\x -> pure (f a, pure f <*> pure a))+--+-- > -- Coinduction+-- > VarT (\x -> pure (f a, pure (f a)))+--+-- > -- Definition of pure+-- > pure (f a)+--+--+-- ==Interchange+-- > u <*> pure y = pure ($ y) <*> u+--+-- > -- Definition of <*>+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (a, y') <- runVarT (pure y) x+-- > pure (f a, u' <*> y'))+--+-- > -- Definition of pure+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (a, y') <- runVarT (VarT (\_ -> pure (y, pure y))) x+-- > pure (f a, u' <*> y'))+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (a, y') <- (\_ -> pure (y, pure y)) x+-- > pure (f a, u' <*> y'))+--+-- > -- Application+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > (a, y') <- pure (y, pure y))+-- > pure (f a, u' <*> y'))+--+-- > -- pure x >>= f = f+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > pure (f y, u' <*> pure y))+--+-- > -- Coinduction+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > pure (f y, pure ($ y) <*> u'))+--+-- > -- Definition of $+-- > VarT (\x -> do+-- > (f, u') <- runVarT u x+-- > pure (($ y) f, pure ($ y) <*> u')+--+-- > -- pure x >>= f = f+-- > VarT (\x -> do+-- > (g, y') <- pure (($ y), pure ($ y))+-- > (f, u') <- runVarT u x+-- > pure (g f, y' <*> u')+--+-- > -- Abstraction+-- > VarT (\x -> do+-- > (g, y') <- (\_ -> pure (($ y), pure ($ y))) x+-- > (f, u') <- runVarT u x+-- > pure (g f, y' <*> u')+--+-- > -- Newtype+-- > VarT (\x -> do+-- > (g, y') <- runVarT (VarT (\_ -> pure (($ y), pure ($ y)))) x+-- > (f, u') <- runVarT u x+-- > pure (g f, y' <*> u')+--+-- > -- Definition of <*>+-- > VarT (\_ -> pure (($ y), pure ($ y))) <*> u+--+-- > -- Definition of pure+-- > pure ($ y) <*> u
src/Control/Varying/Event.hs view
@@ -1,82 +1,73 @@+{-# LANGUAGE LambdaCase #-} -- | -- Module: Control.Varying.Event -- Copyright: (c) 2015 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+-- Maintainer: Schell Scivally <schell@takt.com> ----- 'Event' streams describe things that happen at a specific domain.+-- An event stream is simply a stream of @Maybe a@. This kind of stream is+-- considered to be only defined at those occurances of @Just a@. Events+-- describe things that happen at a specific time, place or any collection of+-- inputs.+-- -- For example, you can think of the event stream -- @'VarT' 'IO' 'Double' ('Event' ())@ as an occurrence of @()@ at a specific--- input of type 'Double'.+-- value of 'Double'. It is possible that this 'Double' is time, or it could be+-- the number of ice cream sandwiches eaten by a particular cat. ----- For sequencing streams please check out 'Control.Varying.Spline' which--- lets you chain together sequences of event streams using do-notation.-module Control.Varying.Event (- Event(..),- -- * Transforming event values.- toMaybe,- isEvent,- -- * Combining event and value streams- orE,+-- In `varying` we use event streams to dynamically update the network while it+-- is running. For more info on switching and sequencing streams with events+-- please check out 'Control.Varying.Spline', which lets you chain together+-- sequences of values and events using a familiar do-notation.++module Control.Varying.Event+ ( -- * Event constructors (synonyms of Maybe)+ Event+ , event+ , noevent -- * Generating events from value streams- use,- onTrue,- onJust,- onUnique,- onWhen,+ , use+ , onTrue+ , onUnique+ , onWhen -- * Folding and gathering event streams- foldStream,- startingWith, startWith,- -- * Using multiple streams- eitherE,- anyE,+ , foldStream+ , startingWith, startWith+ -- * Combining multiple event streams+ , bothE+ , anyE -- * List-like operations on event streams- filterE,- takeE,- dropE,+ , filterE+ , takeE+ , dropE -- * Primitive event streams- once,- always,- never,+ , once+ , always+ , never+ , before+ , after -- * Switching- andThenWith,- switchByMode,+ , switch -- * Bubbling- onlyWhen,- onlyWhenE,-) where+ , onlyWhen+ , onlyWhenE+ ) where -import Prelude hiding (until)-import Control.Varying.Core-import Control.Applicative-import Control.Monad-import Data.Monoid-import Data.Foldable (foldl')------------------------------------------------------------------------------------ Transforming event values into usable values------------------------------------------------------------------------------------ | Turns an 'Event' into a 'Maybe'.-toMaybe :: Event a -> Maybe a-toMaybe (Event a) = Just a-toMaybe _ = Nothing+import Control.Applicative+import Control.Monad+import Control.Varying.Core+import Data.Foldable (foldl')+import Prelude hiding (until) --- | Returns 'True' when the 'Event' contains a sample and 'False'--- otherwise.-isEvent :: Event a -> Bool-isEvent (Event _) = True-isEvent _ = False------------------------------------------------------------------------------------ Combining value streams and events------------------------------------------------------------------------------------ | 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) => 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')+type Event = Maybe++-- | A synonym for the @Maybe@ constructor @Just@.+event :: a -> Event a+event = Just++-- | A synonym for the @Maybe@ constructor @Nothing@.+noevent :: Event a+noevent = Nothing -------------------------------------------------------------------------------- -- Generating events from values --------------------------------------------------------------------------------@@ -99,18 +90,8 @@ -- @ -- 'use' b 'onTrue' :: 'Monad' m => 'VarT' m 'Bool' ('Event' b) -- @-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@.------ @--- 'use' b 'onJust' :: 'Monad' m => 'VarT' m ('Maybe' x) ('Event' b)--- @-onJust :: (Applicative m, Monad m) => VarT m (Maybe a) (Event a)-onJust = var $ \ma -> case ma of- Nothing -> NoEvent- Just a -> Event a+onTrue :: Monad m => VarT m Bool (Event ())+onTrue = var $ \b -> if b then Just () else Nothing -- | Triggers an @'Event' a@ when the input is distinct from the previous -- input.@@ -118,16 +99,16 @@ -- @ -- 'use' b 'onUnique' :: ('Eq' x, 'Monad' m) => 'VarT' m x ('Event' b) -- @-onUnique :: (Applicative m, Monad m, Eq a) => VarT m a (Event a)-onUnique = VarT $ \a -> return (Event a, trigger a)+onUnique :: (Monad m, Eq a) => VarT m a (Event a)+onUnique = VarT $ \a -> return (Just a, trigger a) where trigger a' = VarT $ \a'' -> let e = if a' == a''- then NoEvent- else Event a''+ then Nothing+ else Just a'' in return (e, trigger a'') -- | Triggers an @'Event' a@ when the condition is met. onWhen :: Applicative m => (a -> Bool) -> VarT m a (Event a)-onWhen f = var $ \a -> if f a then Event a else NoEvent+onWhen f = var $ \a -> if f a then Just a else Nothing -------------------------------------------------------------------------------- -- Collecting --------------------------------------------------------------------------------@@ -135,10 +116,11 @@ 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')- NoEvent -> return (acc, foldStream f acc)+ Just a -> let acc' = f acc a+ in return (acc', foldStream f acc')+ Nothing -> return (acc, foldStream f acc) + -- | 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.@@ -146,199 +128,167 @@ -- @ -- time '>>>' 'Control.Varying.Time.after' 3 '>>>' 'startingWith' 0 -- @-startingWith, startWith :: (Applicative m, Monad m) => a -> VarT m (Event a) a+--+-- >>> :{+-- let v = onWhen (== 3) >>> startingWith 0+-- in testVarOver v [0, 1, 2, 3, 4]+-- >>> :}+-- 0+-- 0+-- 0+-- 3+-- 3+startWith, startingWith+ :: Monad m+ => a+ -> VarT m (Event a) a+startWith = foldStream (\_ a -> a) startingWith = startWith-startWith = foldStream (\_ a -> a) -- | Stream through some number of successful 'Event's and then inhibit -- forever.-takeE :: (Applicative m, Monad m)+takeE :: Monad m => Int -> VarT m a (Event b) -> VarT m a (Event b) takeE 0 _ = never 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')+ Nothing -> return (Nothing, takeE n ve')+ Just b -> return (Just b, takeE (n-1) ve') -- | Inhibit the first n occurences of an 'Event'.-dropE :: (Applicative m, Monad m)+dropE :: Monad m => Int -> VarT m a (Event b) -> VarT m a (Event b) dropE 0 ve = ve 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')+ Nothing -> return (Nothing, dropE n ve')+ Just _ -> return (Nothing, dropE (n-1) ve') -- | Inhibit all 'Event's that don't pass the predicate.-filterE :: (Applicative m, Monad m)+filterE :: Monad m => (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+filterE p v = (join . (check <$>)) <$> v+ where check b = if p b then Just b else Nothing -------------------------------------------------------------------------------- -- 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+-- | Combine two 'Event' streams. Produces an event only when both streams proc+-- at the same time.+bothE :: Monad m+ => (a -> b -> c) -> VarT m a (Event a) -> VarT m a (Event b)+ -> VarT m a (Event c)+bothE f va vb = (\ea eb -> f <$> ea <*> eb) <$> va <*> vb -- | Combine two 'Event' streams and produce an 'Event' any time either stream -- produces. In the case that both streams produce, this produces the 'Event'--- of the left stream.-anyE :: (Applicative m, Monad m) => [VarT m a (Event b)] -> VarT m a (Event b)+-- of the leftmost stream.+anyE :: Monad m => [VarT m a (Event b)] -> VarT m a (Event b) anyE [] = never anyE vs = VarT $ \a -> do outs <- mapM (`runVarT` a) vs let f (eb, vs1) (eb1, v) = (msum [eb, eb1], vs1 ++ [v])- return (anyE <$> foldl' f (NoEvent, []) outs)+ return (anyE <$> foldl' f (Nothing, []) outs) -------------------------------------------------------------------------------- -- Primitive event streams ----------------------------------------------------------------------------------- | Produce the given value once and then inhibit forever.-once :: (Applicative m, Monad m) => b -> VarT m a (Event b)-once b = VarT $ \_ -> return (Event b, never)+-- | Produce the given event value once and then inhibit forever.+once :: Monad m => b -> VarT m a (Event b)+once b = VarT $ \_ -> return (Just b, never) -- | Never produces any 'Event' values. -- -- @--- 'never' = 'pure' 'NoEvent'+-- 'never' = 'pure' 'Nothing' -- @-never :: (Applicative m, Monad m) => VarT m b (Event c)-never = pure NoEvent+never :: Monad m => VarT m b (Event c)+never = pure Nothing -- | Produces 'Event's with the initial value forever. -- -- @ -- 'always' e = 'pure' ('Event' e) -- @-always :: (Applicative m, Monad m) => b -> VarT m a (Event b)-always = pure . Event+always :: Monad m => b -> VarT m a (Event b)+always = pure . Just +-- | Emits events before accumulating t of input dt.+-- Note that as soon as we have accumulated >= t we stop emitting events+-- and therefore an event will never be emitted exactly at time == t.+before :: (Monad m, Num t, Ord t) => t -> VarT m t (Event t)+before t = accumulate (+) 0 >>> onWhen (< t)++-- | Emits events after t input has been accumulated.+-- Note that event emission is not guaranteed to begin exactly at t,+-- since it depends on the input.+after :: (Monad m, Num t, Ord t) => t -> VarT m t (Event t)+after t = accumulate (+) 0 >>> onWhen (>= t)+ -------------------------------------------------------------------------------- -- Switching ----------------------------------------------------------------------------------- | Switches using a mode signal. Streams maintain state only for the duration--- of the mode.-switchByMode :: (Applicative m, Monad m, Eq b)- => 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- Event b -> f b+-- | Higher-order switching.+-- Use an event stream of value streams and produces event values of the latest+-- produced value stream. Switches to a new value stream each time one is+-- produced. The currently used value stream maintains local state until the+-- outer event stream produces a new value stream.+--+-- In this example we're sequencing the value streams we'd like to use and then+-- switching them when the outer event stream fires.+--+-- >>> import Control.Varying.Spline+-- >>> :{+-- let v :: VarT IO () (Event Int)+-- v = switch $ flip outputStream Nothing $ do+-- step $ Just $ 1 >>> accumulate (+) 0+-- step Nothing+-- step Nothing+-- step $ Just 5+-- step Nothing+-- in testVarOver v [(), (), (), (), ()] -- testing over five frames+-- >>> :}+-- Just 1+-- Just 2+-- Just 3+-- Just 5+-- Just 5+switch+ :: Monad m+ => VarT m a (Event (VarT m a b))+ -> VarT m a (Event b)+switch = switchGo $ pure Nothing+ where switchGo vInner v = VarT $ \a -> runVarT v a >>= \case+ (Nothing, vOuter) -> do+ (mayB, vInner1) <- runVarT vInner a+ return (mayB, switchGo vInner1 vOuter)+ (Just vInner2, vOuter) -> do+ (mayB, vInner3) <- runVarT (Just <$> vInner2) a+ return (mayB, switchGo vInner3 vOuter) -andThenWith :: (Applicative m, Monad m)- => VarT m a (Event b) -> (Event b -> VarT m a (Event b)) -> VarT m a (Event b)-v `andThenWith` f = run v NoEvent- where run v1 eb = VarT $ \a -> do- (eb1, v2) <- runVarT v1 a- case eb1 of- NoEvent -> runVarT (f eb) a- _ -> return (eb1, run v2 eb1) -------------------------------------------------------------------------------- -- Bubbling --------------------------------------------------------------------------------+-- | Produce events of a stream @v@ only when an event stream @h@ produces an+-- event.+-- @v@ and @h@ maintain state while cold.+onlyWhenE :: Monad m+ => 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+ case e of+ Just _ -> do (b, v') <- runVarT v a+ return (Just b, onlyWhenE v' hot')+ _ -> return (Nothing, onlyWhenE v hot')+ -- | Produce 'Event's of a value stream @v@ only when its input value passes a -- predicate @f@. -- @v@ maintains state while cold.-onlyWhen :: (Applicative m, Monad m)+onlyWhen :: Monad m => VarT m a b -- ^ @v@ - The value stream -> (a -> Bool) -- ^ @f@ - The predicate to run on @v@'s input values. -> VarT m a (Event b) onlyWhen v f = v `onlyWhenE` hot where hot = var id >>> onWhen f---- | Produce events of a value stream @v@ only when an event stream @h@--- produces an event.--- @v@ and @h@ maintain state while cold.-onlyWhenE :: (Applicative m, Monad m)- => 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') <- runVarT v a- return (Event b, onlyWhenE v' hot')- else return (NoEvent, onlyWhenE v hot')------------------------------------------------------------------------------------ Event typeclass instances----------------------------------------------------------------------------------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 where- mzero = mempty- mplus = (<|>)--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---- | Any event is a 'Monoid' that responds to 'mempty' with 'NoEvent'. It--- responds to 'mappend' by always choosing the rightmost event. This means--- left events are replaced unless the right event is 'NoEvent'.-instance Monoid (Event a) where- mempty = NoEvent- mappend a NoEvent = a- mappend _ b = b--instance Functor Event where- fmap f (Event a) = Event $ f a- fmap _ NoEvent = NoEvent---- | A value of @'Event' ()@ means that an event has occurred and that the--- result is a @()@. A value of 'NoEvent' means that an event did not--- occur.------ 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
@@ -1,80 +1,95 @@ -- |--- Module: Control.Varying.SplineT+-- Module: Control.Varying.Spline -- Copyright: (c) 2015 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>------ Using splines we can easily create continuous value streams from--- multiple piecewise event streams. A spline is a monadic layer on top of--- event streams which are only continuous over a certain domain. The idea--- is that we use do notation to "run an event stream" from which we will--- consume produced values. Once the event stream inhibits the computation--- completes and returns a result value. That result value is then--- used to determine the next spline in the sequence.------ A spline can be converted back into a value stream using 'execSpline' or--- 'execSplineT'. This allows us to build long, complex, sequential behaviors--- using familiar notation.+-- Maintainer: Schell Scivally <schell@takt.com> ---{-# LANGUAGE GADTs #-}+-- Using splines we can easily create continuous streams from discontinuous+-- streams. A spline is a monadic layer on top of event streams which are only+-- continuous over a certain domain. The idea is that we use a monad to+-- "run a stream switched by events". This means taking two streams - an output+-- stream and an event stream, and combining them into a temporarily producing+-- stream. Once that "stream pair" inhibits, the computation completes and+-- returns a result value. That result value is then used to determine the next+-- spline in the sequence. {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-module Control.Varying.Spline (- -- * Spline- Spline,+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+module Control.Varying.Spline+ ( -- * Spline+ Spline -- * Spline Transformer- SplineT(..),- -- * Running and streaming- scanSpline,- outputStream,+ , SplineT(..)+ -- * Creating streams from splines+ , outputStream+ -- * Creating splines from streams+ , fromEvent+ , untilProc+ , whileProc+ , untilEvent+ , untilEvent_+ , _untilEvent+ , _untilEvent_+ -- * Other runners+ , scanSpline -- * Combinators- step,- fromEvent,- untilEvent,- untilEvent_,- _untilEvent,- _untilEvent_,- race,- raceMany,- merge,- capture,- mapOutput,- adjustInput,-) where+ , step+ , race+ , raceAny+ , merge+ , capture+ , mapOutput+ , adjustInput+ -- * Hand Proofs of the Monad laws+ -- $proofs+ ) where -import Control.Varying.Core-import Control.Varying.Event-import Control.Monad-import Control.Monad.Trans.Class-import Control.Monad.IO.Class-import Control.Applicative-import Data.Functor.Identity-import Data.Function-import Data.Monoid+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Varying.Core+import Control.Varying.Event+import Data.Functor.Identity + -- | 'SplineT' shares all the types of 'VarT' and adds a result value. Its--- monad, input and output types (@m@, @a@ and @b@, respectively) reflect the--- underlying 'VarT`. 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--- result value, where the internal state is the output value. The result--- value is used only in determining the next spline to sequence.---newtype SplineT a b m c = SplineT { unSplineT :: VarT m a (Either b c) }-newtype SplineT a b m c = SplineT { runSplineT :: a -> m (Either c (b, SplineT a b m c)) }+-- monad, input and output types (@m@, @a@ and @b@, respectively) represent the+-- same parameters in 'VarT'. A spline adds a result type which represents the+-- monadic computation's result value.+--+-- A spline either concludes in a result or it produces an output value and+-- another spline. This makes it a stream that eventually ends. We can use this+-- to set up our streams in a monadic fashion, where the end result of one spline+-- can be used to determine the next spline to run. Using 'outputStream' we can+-- then fuse these piecewise continuous (but otherwise discontinuous) streams+-- into one continuous stream of type @VarT m a b@. Alternatively you can simply+-- poll the network until it ends using 'runSplineT'.+newtype SplineT a b m c =+ SplineT { runSplineT :: a -> m (Either c (b, SplineT a b m c)) } -- | A spline is a functor by applying the function to the result of the--- spline.-instance (Applicative m, Monad m) => Functor (SplineT a b m) where- fmap f (SplineT s) = SplineT $ \a -> s a >>= \case+-- spline. This does just what you would expect of other Monads such as 'StateT'+-- or 'Maybe'.+--+-- >>> :{+-- let s0 = pure "first" `untilEvent` (1 >>> after 2)+-- s = do str <- fmap show s0+-- step str+-- v = outputStream s ""+-- in testVarOver v [(),()]+-- >>> :}+-- "first"+-- "(\"first\",2)"+instance Monad m => Functor (SplineT a b m) where+ fmap f (SplineT s) = SplineT $ s >=> \case Left c -> return $ Left $ f c Right (b, s1) -> return $ Right (b, fmap f s1) -- | A spline responds to bind by running until it concludes in a value, -- then uses that value to run the next spline.-instance (Applicative m, Monad m) => Monad (SplineT a b m) where+--+-- Note - checkout the <$proofs proofs>+instance Monad m => Monad (SplineT a b m) where return = SplineT . const . return . Left (SplineT s0) >>= f = SplineT $ g s0 where g s a = do e <- s a@@ -82,34 +97,70 @@ Left c -> runSplineT (f c) a Right (b, SplineT s1) -> return $ Right (b, SplineT $ g s1) --- A spline responds to 'pure' by returning a spline that never produces an++-- | A spline responds to 'pure' by returning a spline that never produces an -- output value and immediately returns the argument. It responds to '<*>' by -- applying the left arguments result value (the function) to the right -- arguments result value (the argument), sequencing them both in serial.-instance (Applicative m, Monad m) => Applicative (SplineT a b m) where+--+-- @+-- pure = return+-- sf <*> sx = do+-- f <- sf+-- x <- sx+-- return $ f x+-- @+instance Monad m => Applicative (SplineT a b m) where pure = return sf <*> sx = do f <- sf- x <- sx- return $ f x+ f <$> sx --- #if MIN_VERSION_base(4,8,0)--- | A spline is a transformer by using @effect@.++-- | A spline is a transformer by running the effect and immediately concluding,+-- using the effect's result as the result value.+--+-- >>> :{+-- let s = do () <- lift $ print "Hello"+-- step 2+-- v = outputStream s 0+-- in testVarOver v [()]+-- >>> :}+-- "Hello"+-- 2 instance MonadTrans (SplineT a b) where- lift f = SplineT $ const $ f >>= return . Left+ lift f = SplineT $ const $ Left <$> 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.-instance (Applicative m, Monad m, MonadIO m) => MonadIO (SplineT a b m) where+instance (Monad m, MonadIO m) => MonadIO (SplineT a b m) where liftIO = lift . liftIO--- #endif---+ -- | 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 --- | Evaluates a spline into a value stream of its output type.-outputStream :: (Applicative m, Monad m)+-- | Permute a spline into one continuous stream. Since a spline is not+-- guaranteed to be defined over any domain (specifically on its edges), this+-- function takes a default value to use as the "last known value".+--+-- >>> :{+-- let s :: SplineT () String IO ()+-- s = do first <- pure "accumulating until 3" `_untilEvent` (1 >>> after 3)+-- secnd <- pure "accumulating until 4" `_untilEvent` (1 >>> after 4)+-- if first + secnd == 7+-- then step "done"+-- else step "something went wrong!"+-- v = outputStream s ""+-- in testVarOver v $ replicate 6 ()+-- >>> :}+-- "accumulating until 3"+-- "accumulating until 3"+-- "accumulating until 4"+-- "accumulating until 4"+-- "accumulating until 4"+-- "done"+outputStream :: Monad m => SplineT a b m c -> b -> VarT m a b outputStream (SplineT s0) b0 = VarT $ f s0 b0 where f s b a = do e <- s a@@ -119,56 +170,75 @@ -- | Run the spline over the input values, gathering the output values in a -- list.-scanSpline :: (Applicative m, Monad m)+scanSpline :: Monad m => SplineT a b m c -> b -> [a] -> m [b] scanSpline s b = fmap fst <$> scanVar (outputStream s b) -- | Create a spline from an event stream.-fromEvent :: (Applicative m, Monad m) => VarT m a (Event b) -> SplineT a (Event b) m b+fromEvent :: Monad m => VarT m a (Event b) -> SplineT a (Event b) m b fromEvent ve = SplineT $ \a -> do (e, ve1) <- runVarT ve a return $ case e of- Event b -> Left b- NoEvent -> Right (NoEvent, fromEvent ve1)+ Just b -> Left b+ Nothing -> Right (Nothing, fromEvent ve1) --- | 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--- the event stream produces a value, at that point the last output--- value and the event value are tupled and returned as the spline's result--- value.-untilEvent :: (Applicative m, Monad m)- => VarT m a b -> VarT m a (Event c)- -> SplineT a b m (b,c)+-- | Create a spline from an event stream. Outputs 'noevent' until the event+-- stream procs, at which point the spline concludes with the event value.+untilProc :: Monad m => VarT m a (Event b) -> SplineT a (Event b) m b+untilProc ve = SplineT $ runVarT ve >=> return . \case+ (Just b, _) -> Left b+ (Nothing, ve1) -> Right (Nothing, untilProc ve1)++-- | Create a spline from an event stream. Outputs @b@ until the event stream+-- inhibits, at which point the spline concludes with @()@.+whileProc :: Monad m => VarT m a (Event b) -> SplineT a b m ()+whileProc ve = SplineT $ runVarT ve >=> return . \case+ (Just b, ve1) -> Right (b, whileProc ve1)+ (Nothing, _) -> Left ()++-- | Create a spline from a stream and an event stream. The spline+-- uses the stream's values as its own output values. The spline will run until+-- the event stream produces an event, at that point the last known output+-- value and the event value are tupled and returned as the spline's result.+untilEvent :: Monad m+ => VarT m a b -> VarT m a (Event c) -> SplineT a b m (b,c) untilEvent v ve = SplineT $ f ((,) <$> v <*> ve) where f vve a = do t <-runVarT vve a return $ case t of- ((b, NoEvent), vve1) -> Right (b, SplineT $ f vve1)- ((b, Event c), _) -> Left (b, c)+ ((b, Nothing), vve1) -> Right (b, SplineT $ f vve1)+ ((b, Just c), _) -> Left (b, c) --- | 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+-- | A variant of 'untilEvent' that results in the last known output value.+untilEvent_ :: 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 c+-- | A variant of 'untilEvent' that results in the event steam's event value.+_untilEvent :: Monad m+ => VarT m a b -> VarT m a (Event c) -> SplineT a b m c _untilEvent v ve = snd <$> untilEvent v ve ----- | A variant of 'untilEvent' that discards both the right and left results.-_untilEvent_ :: (Applicative m, Monad m)- => VarT m a b -> VarT m a (Event c)- -> SplineT a b m ()+-- | A variant of 'untilEvent' that discards both the output and event values.+_untilEvent_ :: Monad m+ => VarT m a b -> VarT m a (Event c) -> SplineT a b m () _untilEvent_ v ve = void $ _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)+--+-- >>> :{+-- let s1 = pure "route " `_untilEvent` (1 >>> after 2)+-- s2 = pure 666 `_untilEvent` (1 >>> after 3)+-- s = do winner <- race (\l r -> l ++ show r) s1 s2+-- step $ show winner+-- v = outputStream s ""+-- in testVarOver v [(),(),()]+-- >>> :}+-- "route 666"+-- "Left 2"+-- "Left 2"+race :: Monad m => (a -> b -> c) -> SplineT i a m d -> SplineT i b m e -> SplineT i c m (Either d e) race f sa0 sb0 = SplineT (g sa0 sb0)@@ -178,10 +248,26 @@ Left e -> return $ Left $ Right e Right (b, sb1) -> return $ Right (f a b, SplineT $ g sa1 sb1) -raceMany :: (Applicative m, Monad m, Monoid b)+-- | Run many splines in parallel, combining their output with 'mappend'.+-- Returns the result of the spline that concludes first. If any conclude at the+-- same time the leftmost result will be returned.+--+-- >>> :{+-- let ss = [ pure "hey " `_untilEvent` (1 >>> after 5)+-- , pure "there" `_untilEvent` (1 >>> after 3)+-- , pure "!" `_untilEvent` (1 >>> after 2)+-- ]+-- s = do winner <- raceAny ss+-- step $ show winner+-- v = outputStream s ""+-- in testVarOver v [(),()]+-- >>> :}+-- "hey there!"+-- "2"+raceAny :: (Monad m, Monoid b) => [SplineT a b m c] -> SplineT a b m c-raceMany [] = pure mempty `_untilEvent` never-raceMany ss = SplineT $ f [] (map runSplineT ss) mempty+raceAny [] = pure mempty `_untilEvent` never+raceAny ss = SplineT $ f [] (map runSplineT ss) mempty where f ys [] b _ = return $ Right (b, SplineT $ f [] ys mempty) f ys (v:vs) b a = v a >>= \case Left c -> return $ Left c@@ -189,57 +275,245 @@ -- | Run two splines in parallel, combining their output. Once both splines -- have concluded, return the results of each in a tuple.-merge :: (Applicative m, Monad m)+--+-- >>> :{+-- let s1 = pure "hey " `_untilEvent` (1 >>> after 3)+-- s2 = pure "there!" `_untilEvent` (1 >>> after 2)+-- s = do tuple <- merge (++) s1 s2+-- step $ show tuple+-- v = outputStream s ""+-- in testVarOver v [(),(),()]+-- >>> :}+-- "hey there!"+-- "hey "+-- "(3,2)"+merge :: Monad m => (b -> b -> b) -> SplineT a b m c -> SplineT a b m d -> SplineT a b m (c, d) merge apnd s1 s2 = SplineT $ f s1 s2 where r c d = return $ Left (c, d) - fr c vb a = runSplineT vb a >>= \case- Left d -> r c d+ fr c vb = runSplineT vb >=> \case+ Left d -> r c d Right (b, vb1) -> return $ Right (b, SplineT $ fr c vb1) - fl d va a = runSplineT va a >>= \case- Left c -> r c d+ fl d va = runSplineT va >=> \case+ Left c -> r c d Right (b, va1) -> return $ Right (b, SplineT $ fl d va1) f va vb a = runSplineT va a >>= \case Left c -> fr c vb a Right (b1, va1) -> runSplineT vb a >>= \case Left d -> return $ Right (b1, SplineT $ fl d va1)- Right (b2, vb1) -> return $ Right $ (apnd b1 b2, SplineT $ f va1 vb1)+ Right (b2, vb1) -> return $ Right (apnd b1 b2, SplineT $ f va1 vb1) -- | 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)- => SplineT a b m c -> SplineT a b m (Maybe b, c)+--+-- The tupled value is returned in as a 'Maybe b' since it is not+-- guaranteed that an output value is produced before a Spline concludes.+--+-- >>> :{+-- let+-- s :: MonadIO m => SplineT () Int m String+-- s = do+-- (mayX, boomStr) <-+-- capture+-- $ do+-- step 0+-- step 1+-- step 2+-- return "boom"+-- -- x is 2, but 'capture' can't be sure of that+-- maybe+-- (return "Failure")+-- ( (>> return boomStr)+-- . step+-- . (+1)+-- )+-- mayX+-- in+-- testVarOver (outputStream s 666) [(),(),(),()]+-- >>> :}+-- 0+-- 1+-- 2+-- 3+capture+ :: Monad m+ => SplineT a b m c+ -> SplineT a b m (Maybe b, c) capture = SplineT . f Nothing- where f mb s a = runSplineT s a >>= \case- Left c -> return $ Left (mb, c)- Right (b, s1) -> return $ Right (b, SplineT $ f (Just b) s1)+ where f mb s = runSplineT s >=> return . \case+ Left c -> Left (mb, c)+ Right (b, s1) -> Right (b, SplineT $ f (Just b) s1) -- | Produce the argument as an output value exactly once.-step :: (Applicative m, Monad m) => b -> SplineT a b m ()+--+-- >>> :{+-- let s = do step "hi"+-- step "there"+-- step "friend"+-- in testVarOver (outputStream s "") [1,2,3,4]+-- >>> :}+-- "hi"+-- "there"+-- "friend"+-- "friend"+step :: Monad m => b -> SplineT a b m () step b = SplineT $ const $ return $ Right (b, return ()) -- | Map the output value of a spline.-mapOutput :: (Applicative m, Monad m)+--+-- >>> :{+-- let s = mapOutput (pure show) $ step 1 >> step 2 >> step 3+-- in testVarOver (outputStream s "") [(),(),()]+-- >>> :}+-- "1"+-- "2"+-- "3"+mapOutput :: Monad m => VarT m a (b -> t) -> SplineT a b m c -> SplineT a t m c mapOutput vf0 s0 = SplineT $ g vf0 s0 where g vf s a = do (f, vf1) <- runVarT vf a- runSplineT s a >>= \case- Left c -> return $ Left c- Right (b, s1) -> return $ Right (f b, SplineT $ g vf1 s1)+ flip fmap (runSplineT s a) $ \case+ Left c -> Left c+ Right (b, s1) -> Right (f b, SplineT $ g vf1 s1) -- | Map the input value of a spline.-adjustInput :: (Applicative m, Monad m)+adjustInput :: Monad m => VarT m a (a -> r) -> SplineT r b m c -> SplineT a b m c adjustInput vf0 s = SplineT $ g vf0 s- where g vf sx (!a) = do+ where g vf sx a = do (f, vf1) <- runVarT vf a- runSplineT sx (f a) >>= \case- Left c -> return $ Left c- Right (b, sx1) -> return $ Right (b, SplineT $ g vf1 sx1)+ flip fmap (runSplineT sx (f a)) $ \case+ Left c -> Left c+ Right (b, sx1) -> Right (b, SplineT $ g vf1 sx1)++--------------------------------------------------------------------------------+-- $proofs+-- ==Left Identity+-- > k =<< return c = k c+--+-- > -- Definition of =<<+-- > fix (\f s ->+-- > SplineT (\a ->+-- > runSplineT s a >>= \case+-- > Left c -> runSplineT (k c) a+-- > Right s' -> return (Right (fmap f s')))) (return c)+--+-- > -- Definition of fix+-- > (\s ->+-- > SplineT (\a ->+-- > runSplineT s a >>= \case+-- > Left c -> runSplineT (k c) a+-- > Right s' -> return (Right (fmap (k =<<) s')))) (return c)+--+-- > -- Application+-- > SplineT (\a ->+-- > runSplineT (return c) a >>= \case+-- > Left c -> runSplineT (k c) a+-- > Right s' -> return (Right (fmap (k =<<) s')))+--+-- > -- Definition of return+-- > SplineT (\a ->+-- > runSplineT (SplineT (\_ -> return (Left c))) a >>= \case+-- > Left c -> runSplineT (k c) a+-- > Right s' -> return (Right (fmap (k =<<) s')))+--+-- > -- Newtype+-- > SplineT (\a ->+-- > (\_ -> return (Left c)) a >>= \case+-- > Left c -> runSplineT (k c) a+-- > Right s' -> return (Right (fmap (k =<<) s')))+--+-- > -- Application+-- > SplineT (\a ->+-- > return (Left c) >>= \case+-- > Left c -> runSplineT (k c) a+-- > Right s' -> return (Right (fmap (k =<<) s')))+--+-- > -- return x >>= f = f x+-- > SplineT (\a ->+-- > case (Left c) of+-- > Left c -> runSplineT (k c) a+-- > Right s' -> return (Right (fmap (k =<<) s')))+--+-- > -- Case evaluation+-- > SplineT (\a -> runSplineT (k c) a)+--+-- > -- Eta reduction+-- > SplineT (runSplineT (k c))+--+-- > -- Newtype+-- > k c+--+-- ==Right Identity+-- > return =<< m = m+--+-- > -- Definition of =<<+-- > fix (\f s ->+-- > SplineT (\a ->+-- > runSplineT s a >>= \case+-- > Left c -> runSplineT (return c) a+-- > Right s' -> return (Right (fmap f s')))) m+--+-- > -- Definition of fix+-- > (\s ->+-- > SplineT (\a ->+-- > runSplineT s a >>= \case+-- > Left c -> runSplineT (return c) a+-- > Right s' -> return (Right (fmap (return =<<) s')))) m+--+-- > -- Application+-- > SplineT (\a ->+-- > runSplineT m a >>= \case+-- > Left c -> runSplineT (return c) a+-- > Right s' -> return (Right (fmap (return =<<) s')))+--+-- > -- Definition of return+-- > SplineT (\a ->+-- > runSplineT m a >>= \case+-- > Left c -> runSplineT (SplineT (\_ -> return (Left c))) a+-- > Right s' -> return (Right (fmap (return =<<) s')))+--+-- > -- Newtype+-- > SplineT (\a ->+-- > runSplineT m a >>= \case+-- > Left c -> (\_ -> return (Left c)) a+-- > Right s' -> return (Right (fmap (return =<<) s')))+--+-- > -- Application+-- > SplineT (\a ->+-- > runSplineT m a >>= \case+-- > Left c -> return (Left c)+-- > Right s' -> return (Right (fmap (return =<<) s')))+--+-- > -- m >>= return . f = fmap f m+-- > SplineT (\a -> fmap (either id (fmap (return =<<))) (runSplineT m a))+--+-- > -- Coinduction+-- > SplineT (\a -> fmap (either id (fmap id)) (runSplineT m a))+--+-- > -- fmap id = id+-- > SplineT (\a -> fmap (either id id) (runSplineT m a))+--+-- > -- either id id = id+-- > SplineT (\a -> fmap id (runSplineT m a))+--+-- > -- fmap id = id+-- > SplineT (\a -> runSplineT m a)+--+-- > -- Eta reduction+-- > SplineT (runSplineT m)+--+-- > -- Newtype+-- > m+--+-- ==Application+-- > (m >>= f) >>= g = m >>= (\x -> f x >>= g)++-- TODO: Finish the rest of the hand proofs
− src/Control/Varying/Time.hs
@@ -1,23 +0,0 @@--- | Module: Control.Varying.Time--- Copyright: (c) 2015 Schell Scivally--- License: MIT--- Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>-module Control.Varying.Time where--import Control.Varying.Core-import Control.Varying.Event-import Control.Applicative------------------------------------------------------------------------------------ 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 therefore an event will be never be emitted exactly at time == t.-before :: (Applicative m, Monad m, Num t, Ord t) => t -> VarT m t (Event t)-before t = accumulate (+) 0 ~> onWhen (< t)---- | Emits events after t input has been accumulated.--- Note that event emission is not guaranteed to begin exactly at t,--- since it depends on the input.-after :: (Applicative m, Monad m, Num t, Ord t) => t -> VarT m t (Event t)-after t = accumulate (+) 0 ~> onWhen (>= t)
src/Control/Varying/Tween.hs view
@@ -1,8 +1,8 @@ -- | -- Module: Control.Varying.Tween--- Copyright: (c) 2015 Schell Scivally+-- Copyright: (c) 2016 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+-- Maintainer: Schell Scivally <schell@takt.com> -- -- Tweening is a technique of generating intermediate samples of a type -- __between__ a start and end value. By sampling a running tween@@ -13,19 +13,15 @@ -- time you use. At some point it would be great to be able to tween -- arbitrary types, and possibly tween one type into another (pipe -- dreams).-----{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-} module Control.Varying.Tween ( -- * Tweening types Easing , TweenT , Tween- -- * Running tweens- , runTweenT- , scanTween- , tweenStream -- * Creating tweens -- $creation , tween@@ -33,6 +29,8 @@ , constant , withTween , withTween_+ -- * Combining tweens+ -- $combining -- * Interpolation functions -- $lerping , linear@@ -49,50 +47,72 @@ , easeOutCubic , easeInQuad , easeOutQuad- -- * Writing your own tweens- -- $writing+ -- * Running tweens+ , tweenStream+ , runTweenT+ , scanTween ) where -import Control.Varying.Core-import Control.Varying.Event-import Control.Varying.Spline-import Control.Varying.Time-import Control.Arrow-import Control.Applicative-import Control.Monad.Trans.State-import Control.Monad.Trans.Class-import Data.Functor.Identity+import Control.Monad (void)+import Control.Monad.Trans.State (StateT, evalStateT, get, put,+ runStateT)+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Varying.Core (VarT (..), done)+import Control.Varying.Event (after)+import Control.Varying.Spline (SplineT (..), mapOutput, scanSpline,+ untilEvent_)+import Data.Bifunctor (first, second)+import Data.Functor.Identity (Identity)+import GHC.Generics (Generic) ++-- $setup+-- >>> import Control.Varying.Core++ --------------------------------------------------------------------------------+-- | An easing function. The parameters are often named `c`, `t` and `b`,+-- where `c` is the total change in value over the complete duration+-- (endValue - startValue), `t` is the current percentage (0 to 1) of the+-- duration that has elapsed and `b` is the start value.+--+-- To make things simple only numerical values can be tweened and the type+-- of time deltas must match the tween's value type. This may change in the+-- future :)+type Easing t f = t -> f -> t -> t+++-------------------------------------------------------------------------------- -- $lerping -- These pure functions take a `c` (total change in value, ie end - start), -- `t` (percent of duration completion) and `b` (start value) and result in--- and interpolation of a value. To see what these look like please check+-- an interpolation of a value. To see what these look like please check -- out http://www.gizma.com/easing/. -------------------------------------------------------------------------------- + -- | Ease in quadratic.-easeInQuad :: (Num t, Fractional t, Real f) => Easing t f-easeInQuad c t b = c * (realToFrac $ t*t) + b+easeInQuad :: (Fractional t, Real f) => Easing t f+easeInQuad c t b = c * realToFrac (t*t) + b -- | Ease out quadratic.-easeOutQuad :: (Num t, Fractional t, Real f) => Easing t f-easeOutQuad c t b = (-c) * (realToFrac $ t * (t - 2)) + b+easeOutQuad :: (Fractional t, Real f) => Easing t f+easeOutQuad c t b = (-c) * realToFrac (t * (t - 2)) + b -- | Ease in cubic.-easeInCubic :: (Num t, Fractional t, Real f) => Easing t f-easeInCubic c t b = c * (realToFrac $ t*t*t) + b+easeInCubic :: (Fractional t, Real f) => Easing t f+easeInCubic c t b = c * realToFrac (t*t*t) + b -- | Ease out cubic.-easeOutCubic :: (Num t, Fractional t, Real f) => Easing t f+easeOutCubic :: (Fractional t, Real f) => Easing t f easeOutCubic c t b = let t' = realToFrac t - 1 in c * (t'*t'*t' + 1) + b -- | Ease in by some power.-easeInPow :: (Num t, Fractional t, Real f) => Int -> Easing t f+easeInPow :: (Fractional t, Real f) => Int -> Easing t f easeInPow power c t b = c * (realToFrac t^power) + b -- | Ease out by some power.-easeOutPow :: (Num t, Fractional t, Real f) => Int -> Easing t f+easeOutPow :: (Fractional t, Real f) => Int -> Easing t f easeOutPow power c t b = let t' = realToFrac t - 1 c' = if power `mod` 2 == 1 then c else -c@@ -133,28 +153,123 @@ -- | Ease linear. linear :: (Floating t, Real f) => Easing t f-linear c t b = c * (realToFrac t) + b+linear c t b = c * realToFrac t + b -type TweenT f t m = SplineT f t (StateT f m)-type Tween f t = TweenT f t Identity+-- | A 'TweenT' is a 'SplineT' that holds a duration in local state. This allows+-- 'TweenT's to be sequenced monadically.+--+-- * 'f' is the input time delta type (the input type)+-- * 't' is the start and end value type (the output type)+-- * 'a' is the result value type+--+-- You can sequence 'TweenT's with monadic notation to produce more complex ones.+-- This is especially useful for animation:+--+-- >>> :{+-- let+-- tweenInOutExpo+-- :: ( Monad m, Floating t, Real t, Real f, Fractional f )+-- => t+-- -> t+-- -> f+-- -> TweenT f t m t+-- tweenInOutExpo start end dur = do+-- x <- tween easeInExpo start (end/2) (dur/2)+-- tween easeOutExpo x end $ dur/2+-- >>> :}+newtype TweenT f t m a+ = TweenT { unTweenT :: SplineT f t (StateT f m) a }+ deriving (Generic, Functor, Applicative, Monad) -runTweenT :: (Monad m, Num f)- => TweenT f t m x -> f -> f -> m (Either x ((t, TweenT f t m x)), f)-runTweenT s dt = runStateT (runSplineT s dt) -scanTween :: (Functor m, Applicative m, Monad m, Num f)- => TweenT f t m a -> t -> [f] -> m [t]-scanTween s t dts = evalStateT (scanSpline s t dts) 0+instance MonadTrans (TweenT f t) where+ lift = TweenT . lift . lift ++type Tween f t a = TweenT f t Identity a+++runTweenT+ :: Functor m+ => TweenT f t m a+ -> f+ -- ^ The input time delta this frame+ -> f+ -- ^ The leftover time delta from last frame+ -> m (Either a (t, TweenT f t m a), f)+ -- ^ Returns+ -- @+ -- a tuple of+ -- either+ -- the result+ -- or a tuple of+ -- this step's output value+ -- and the tween for the next step+ -- and the leftover time delta for the next step+ -- @+runTweenT (TweenT s) dt leftover =+ first (second $ second TweenT)+ <$> runStateT+ (runSplineT s dt)+ leftover+++scanTween+ :: (Monad m, Num f)+ => TweenT f t m a+ -> t+ -> [f]+ -> m [t]+scanTween (TweenT s) t dts =+ evalStateT+ (scanSpline s t dts)+ 0++ -- | Converts a tween into a continuous value stream. This is the tween version--- of `outputStream`.-tweenStream :: (Applicative m, Monad m, Num f)- => TweenT f t m x -> t -> VarT m f t-tweenStream s0 t0 = VarT $ f s0 t0 0- where f s t l i = do (e, l1) <- runTweenT s i l- case e of- Left _ -> return (t, done t)- Right (b, s1) -> return (b, VarT $ f s1 b l1)+-- of 'Control.Varying.Spline.outputStream'. This is the preferred way to run+-- your tweens.+--+-- >>> :{+-- let+-- x :: TweenT Float Float IO Float+-- x = tween linear 0 1 1+-- y :: TweenT Float Float IO Float+-- y = tween linear 0 1 2+-- v :: VarT IO Float (Float, Float)+-- v = (,)+-- <$> tweenStream x 0+-- <*> tweenStream y 0+-- in+-- testVarOver v [0.5, 0.5, 0.5, 0.5]+-- >>> :}+-- (0.5,0.25)+-- (1.0,0.5)+-- (1.0,0.75)+-- (1.0,1.0)+tweenStream+ :: forall m f t x+ . (Functor m, Monad m, Num f)+ => TweenT f t m x+ -- ^ The tween to convert into a stream+ -> t+ -- ^ An initial output value+ -> VarT m f t+tweenStream s0 t0 = VarT $ go s0 t0 0+ where+ go ::+ TweenT f t m x -- The Tween+ -> t -- the last output value+ -> f -- the leftover time delta from last fram+ -> f -- the input time delta+ -> m (t, VarT m f t)+ go s t l i = do+ (e, l1) <- runTweenT s i l+ case e of+ Left _ -> return (t, done t)+ Right (b, s1) -> return (b, VarT $ go s1 b l1)++ -------------------------------------------------------------------------------- -- $creation -- The most direct route toward tweening values is to use 'tween'@@ -166,36 +281,34 @@ -- | Creates a spline that produces a value interpolated between a start and -- end value using an easing equation ('Easing') over a duration. The--- resulting spline will take a time delta as input. For example:------ @--- testWhile_ isEvent (deltaUTC >>> v)--- where v :: VarT IO a (Event Double)--- v = flip outputStream 0 $ tween easeOutExpo 0 100 5--- @------ Keep in mind `tween` must be fed time deltas, not absolute time or+-- resulting spline will take a time delta as input.+-- Keep in mind that `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` concludes returning the latest output value.-tween :: (Applicative m, Monad m, Real f, Fractional f, Real t, Fractional t)+tween :: (Monad m, Real t, Real f, Fractional f) => Easing t f -> t -> t -> f -> TweenT f t m t-tween f start end dur = SplineT g- where c = end - start- b = start- g dt = do- leftover <- get- let t = dt + leftover+tween f start end dur =+ TweenT+ $ SplineT g+ where+ c = end - start+ b = start+ g dt = do+ leftover <- get+ let+ t = dt + leftover+ if t == dur+ then+ put 0 >> return (Right (end, return end))+ else+ if t > dur+ then+ put (t - dur - dt) >> return (Left end)+ else+ put t >> return (Right (f c (t/dur) b, SplineT g)) - if t == dur- then do put 0- return $ Right (end, return end)- else if t > dur- then do put $ t - dur - dt- return $ Left end- else do put t- return $ Right (f c (t/dur) b, SplineT g) -- | A version of 'tween' that discards the result. It is simply --@@ -203,46 +316,32 @@ -- tween f a b c >> return () -- @ ---tween_ :: (Applicative m, Monad m, Real t, Fractional t, Real f, Fractional f)+tween_ :: (Monad m, Real t, Real f, Fractional f) => Easing t f -> t -> t -> f -> TweenT f t m ()-tween_ f a b c = tween f a b c >> return ()+tween_ f a b c = Control.Monad.void (tween f a b c) -- | A version of 'tween' that maps its output using the given constant -- function.+-- -- @ -- withTween ease from to dur f = mapOutput (pure f) $ tween ease from to dur -- @-withTween :: (Applicative m, Monad m, Real t, Fractional t, Real a, Fractional a)+withTween :: (Monad m, Real t, Real a, Fractional a) => Easing t a -> t -> t -> a -> (t -> x) -> TweenT a x m t-withTween ease from to dur f = mapOutput (pure f) $ tween ease from to dur+withTween ease from to dur f =+ TweenT+ $ mapOutput (pure f)+ $ unTweenT+ $ tween ease from to dur --- | A version of 'withTween' that discards its output.-withTween_ :: (Applicative m, Monad m, Real t, Fractional t, Real a, Fractional a)+-- | A version of 'withTween' that discards its result.+withTween_ :: (Monad m, Real t, Real a, Fractional a) => Easing t a -> t -> t -> a -> (t -> x) -> TweenT a x m ()-withTween_ ease from to dur f = withTween ease from to dur f >> return ()+withTween_ ease from to dur f = Control.Monad.void (withTween ease from to dur f) -- | Creates a tween that performs no interpolation over the duration.-constant :: (Applicative m, Monad m, Num t, Ord t)+constant :: (Monad m, Num t, Ord t) => a -> t -> TweenT t a m a-constant value duration = pure value `untilEvent_` after duration------------------------------------------------------------------------------------- $writing--- To create your own tweens just write a function that takes a start--- value, end value and a duration and return an event stream.------ @--- tweenInOutExpo start end dur = do--- (dt, x) <- tween easeInExpo start end (dur/2)--- tween easeOutExpo x end $ dt + dur/2--- @------------------------------------------------------------------------------------ | An easing function. The parameters are often named `c`, `t` and `b`,--- where `c` is the total change in value over the complete duration--- (endValue - startValue), `t` is the current percentage (0 to 1) of the--- duration that has elapsed and `b` is the start value.------ To make things simple only numerical values can be tweened and the type--- of time deltas much match the tween's value type. This may change in the--- future :)-type Easing t f = t -> f -> t -> t+constant value duration =+ TweenT+ $ pure value `untilEvent_` after duration
+ test/DocTests.hs view
@@ -0,0 +1,7 @@+module Main where++import Test.DocTest++main :: IO ()+main =+ doctest ["src", "app"]
test/Main.hs view
@@ -1,39 +1,39 @@+{-# LANGUAGE ScopedTypeVariables #-}+ module Main where + import Test.Hspec hiding (after, before)-import Control.Applicative import Control.Varying-import Control.Monad.Trans.Class import Control.Monad.IO.Class-import Control.Monad.Trans.State-import Control.Monad (when) import Data.Functor.Identity import Data.Time.Clock main :: IO () main = hspec $ do- describe "before" $ do+ describe "before" $ it "should produce events before a given step" $ do- let varEv :: Var () (Event Int)- varEv = 1 ~> before 3+ let varEv :: Var () (Maybe Int)+ varEv = 1 >>> before 3 scans = fst $ runIdentity $ scanVar varEv $ replicate 4 ()- scans `shouldBe` [Event 1, Event 2, NoEvent, NoEvent]+ scans `shouldBe` [Just 1, Just 2, Nothing, Nothing] - describe "after" $ do+ describe "after" $ it "should produce events after a given step" $ do- let varEv :: Var () (Event Int)- varEv = 1 ~> after 3+ let varEv :: Var () (Maybe Int)+ varEv = 1 >>> after 3 scans = fst $ runIdentity $ scanVar varEv $ replicate 4 ()- scans `shouldBe` [NoEvent, NoEvent, Event 3, Event 4]- describe "anyE" $ do+ scans `shouldBe` [Nothing, Nothing, Just 3, Just 4]++ describe "anyE" $ it "should produce on any event" $ do- let v1,v2,v3 :: Var () (Event Int)- v1 = use 1 ((1 :: Var () Int) ~> before 2)- v2 = use 2 ((1 :: Var () Int) ~> after 3)+ let v1,v2,v3 :: Var () (Maybe Int)+ v1 = use 1 ((1 :: Var () Int) >>> before 2)+ v2 = use 2 ((1 :: Var () Int) >>> after 3) v3 = always 3 v = anyE [v1,v2,v3] scans = fst $ runIdentity $ scanVar v $ replicate 4 ()- scans `shouldBe` [Event 1, Event 3, Event 2, Event 2]+ scans `shouldBe` [Just 1, Just 3, Just 2, Just 2] describe "tween/tweenWith" $ do it "should step by the dt passed in" $ do let mytween :: Tween Double Double ()@@ -49,7 +49,7 @@ describe "untilEvent" $ do let Identity scans = scanSpline (3 `untilEvent` ((1 :: Var () Int)- ~> after 10))+ >>> after 10)) 0 (replicate 10 ()) it "should produce output from the value stream until event procs" $@@ -66,18 +66,18 @@ it "should produce output exactly one time per call" $ concat scans `shouldBe` "hey, there..." - describe "fromEvent" $ do+ describe "untilProc" $ do let s = do- str <- fromEvent (var f ~> onJust)- step $ Event str- step $ Event "done"+ str <- untilProc $ var f+ step $ Just str+ step $ Just "done" f :: Int -> Maybe String f 0 = Nothing f 1 = Just "YES" f x = Just $ show x- Identity scans = scanSpline s NoEvent [0,0,0,1,0]- it "should produce NoEvent until it procs" $- scans `shouldBe` [NoEvent,NoEvent,NoEvent,Event "YES",Event "done"]+ Identity scans = scanSpline s Nothing [0,0,0,1,0]+ it "should produce Nothing until it procs" $+ scans `shouldBe` [Nothing,Nothing,Nothing,Just "YES",Just "done"] describe "lift/liftIO" $ do let s :: SplineT () String IO ()@@ -108,8 +108,9 @@ it "should step twice and left should win" $ unwords scans `shouldBe` "start s10:s20 s11:s21 right won with True" - describe "raceMany" $ do- let s1 = do step "t"+ describe "raceAny" $ do+ let s1 :: Spline () String Int+ s1 = do step "t" step "c" return 0 s2 = do step "h"@@ -118,7 +119,8 @@ s3 = do step "e" step "t" return (2 :: Int)- s = do x <- raceMany [s1,s2,s3]+ s = do x <- raceAny [s1,s2,s3]+ step $ show x Identity scans = scanSpline s "" $ replicate 3 () it "should output in parallel (mappend) and return the first or leftmost result" $ unwords scans `shouldBe` "the cat 0"@@ -127,7 +129,7 @@ let r :: Spline () String () r = do x <- capture $ do step "a" step "b"- return 2+ return (2 :: Int) case x of (Just "b", 2) -> step "True" _ -> step "False"@@ -160,9 +162,9 @@ -- Adherance to typeclass laws -------------------------------------------------------------------------------- -- Spline helpers- let inc = 1 ~> accumulate (+) 0+ let inc = 1 >>> accumulate (+) 0 sinc :: Spline a Int (Int, Int)- sinc = inc `untilEvent` (1 ~> after 3)+ sinc = inc `untilEvent` (1 >>> after 3) go a = runIdentity (scanSpline a 0 [0..9]) equal a b = go a `shouldBe` go b @@ -182,8 +184,8 @@ let f = (+1) x = 1 it "(homomorphism) pure f <*> pure x = pure (f x)" $- (fst $ runIdentity $ scanVar (pure f <*> pure x) [0..5])- `shouldBe` (fst $ runIdentity $ scanVar (pure $ f x) [0..5])+ fst (runIdentity $ scanVar (pure f <*> pure x) [0..5])+ `shouldBe` fst (runIdentity $ scanVar (pure $ f x) [0..5]) describe "spline's applicative instance" $ do let ident = pure id <*> sinc@@ -193,13 +195,13 @@ pfx = pure (1+1) it "(homomorphism) pure f <*> pure x = pure (f x)" $ equal pfpx pfx let u :: Spline a Int (Int -> Int)- u = pure 66 `_untilEvent` (use (+1) $ 1 ~> after (3 :: Int))+ u = pure 66 `_untilEvent` use (+1) (1 >>> after (3 :: Int)) upy = u <*> pure 1 pyu = pure ($ 1) <*> u it "(interchange) u <*> pure y = pure ($ y) <*> u" $ equal upy pyu let v :: Spline a Int (Int -> Int)- v = pure 66 `_untilEvent` (use (1-) $ 1 ~> after (4 :: Float))- w = pure 72 `_untilEvent` (use 3 $ 1 ~> after (1 :: Float))+ v = pure 66 `_untilEvent` use (1-) (1 >>> after (4 :: Float))+ w = pure 72 `_untilEvent` use 3 (1 >>> after (1 :: Float)) pduvw = pure (.) <*> u <*> v <*> w uvw = u <*> (v <*> w) it "(compisition) pure (.) <*> u <*> v <*> w = u <*> (v <*> w)" $
varying.cabal view
@@ -1,144 +1,107 @@--- 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.6.0.0---- A short (one-line) description of the package.-synopsis: FRP through value streams and monadic splines.---- A longer description of the package.-description: Varying is a FRP library aimed at providing a- simple way to describe values that change over a domain.- It allows monadic, applicative and arrow notation and has- convenience functions for tweening.---- 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, FRP--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+cabal-version: 1.12 -extra-source-files: README.md, changelog.md+-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 238c3b9ce9b85922d1e595508d4616c90817444c1d7b7e3c85527c9014f90094 +name: varying+version: 0.8.1.0+synopsis: FRP through value streams and monadic splines.+description: Varying is a FRP library aimed at providing a simple way to describe values that change over a domain. It allows monadic, applicative and arrow notation and has convenience functions for tweening. Great for animation.+category: Control, FRP+homepage: https://github.com/schell/varying+bug-reports: https://github.com/schell/varying/issues+author: Schell Scivally+maintainer: schell@takt.com+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ changelog.md source-repository head- type: git- location: https://github.com/schell/varying.git+ type: git+ location: https://github.com/schell/varying 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,- Control.Varying.Spline-- -- 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.6 && <5.0- , transformers >=0.3-- -- Directories containing source files.- hs-source-dirs: src-- -- Base language which the package is written in.- default-language: Haskell2010+ exposed-modules:+ Control.Varying+ Control.Varying.Core+ Control.Varying.Event+ Control.Varying.Spline+ Control.Varying.Tween+ other-modules:+ Paths_varying+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.8 && <5.0+ , contravariant >=1.4+ , transformers >=0.3+ default-language: Haskell2010 executable varying-example- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N-- -- Other library packages from which modules are imported.- build-depends: base >=4.6 && <5.0- , transformers >=0.3- , time >=1.4- , varying--- -- Directories containing source files.- hs-source-dirs: app-- 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.6 && <5.0- , time >=1.4- , transformers- , varying- , hspec- , QuickCheck--- -- Directories containing source files.- hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Paths_varying+ hs-source-dirs:+ app+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.8 && <5.0+ , contravariant >=1.4+ , time >=1.4+ , transformers >=0.3+ , varying+ default-language: Haskell2010 - main-is: Main.hs+test-suite doctests+ type: exitcode-stdio-1.0+ main-is: DocTests.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.8 && <5.0+ , contravariant >=1.4+ , doctest+ , transformers >=0.3+ , varying+ default-language: Haskell2010 - -- Base language which the package is written in.- default-language: Haskell2010+test-suite other+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , base >=4.8 && <5.0+ , contravariant >=1.4+ , hspec+ , time >=1.4+ , transformers >=0.3+ , varying+ default-language: Haskell2010 benchmark varying-bench- 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.6- , time >=1.4- , transformers- , varying- , criterion--- -- Directories containing source files.- hs-source-dirs: bench-- main-is: Main.hs-- -- Base language which the package is written in.- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_varying+ hs-source-dirs:+ bench+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.8 && <5.0+ , contravariant >=1.4+ , criterion+ , time >=1.4+ , transformers+ , varying+ default-language: Haskell2010