varying 0.5.0.0 → 0.5.0.2
raw patch · 10 files changed
+233/−119 lines, 10 filesdep ~basedep ~timedep ~transformers
Dependency ranges changed: base, time, transformers
Files
- README.md +57/−5
- app/Main.hs +30/−14
- bench/Main.hs +12/−4
- changelog.md +6/−1
- src/Control/Varying/Core.hs +15/−16
- src/Control/Varying/Event.hs +1/−1
- src/Control/Varying/Spline.hs +33/−14
- src/Control/Varying/Tween.hs +42/−32
- test/Main.hs +26/−20
- varying.cabal +11/−12
README.md view
@@ -3,11 +3,11 @@ [](https://travis-ci.org/schell/varying) This library provides automaton based value streams useful for both functional-reactive programming (FRP) and locally stateful programming (LSP). It is -influenced by the [netwire](http://hackage.haskell.org/package/netwire) and -[auto](http://hackage.haskell.org/package/auto) packages. Unlike netwire the -concepts of inhibition and time are explicit (through `Control.Varying.Event` -and `Control.Varying.Time`). The library aims at being minimal and well +reactive programming (FRP) and locally stateful programming (LSP). It is+influenced by the [netwire](http://hackage.haskell.org/package/netwire) and+[auto](http://hackage.haskell.org/package/auto) packages. Unlike netwire the+concepts of inhibition and time are explicit (through `Control.Varying.Event`+and `Control.Varying.Time`). The library aims at being minimal and well documented with a small API. ## Getting started@@ -80,3 +80,55 @@ loop vNext ```++## Caveats+With tweening, if your input time delta is greater than the duration of the+first spline, that spline immediately concludes and returns its result value -+the stream then continues on to the next spline in the sequence, *applying the+same unmodified input* as the previous spline. This is because splines+immediately conclude and trigger the next spline, and there is no machinery for+altering input after the splines conclusion. What's worse is if you have a+cyclical (infinite) sequence of spline tweens, each with a duration less than+the given delta - the stream will never produce an output. The input will+conclude every spline prematurely and the stream will loop infinitely, hanging+the current thread.++### Here is an example++```haskell+let dv :: Monad m => SplineT Float (V2 Float) m ()+ dv = do tween_ easeInExpo 10 (V2 100 10) 0.25+ tween_ easeInExpo (V2 100 10) 100 0.25+ tween_ easeInExpo 100 (V2 10 100) 0.25+ tween_ easeInExpo (V2 10 100) 10 0.25+ dv+ v :: Monad m => VarT m Float (V2 Float)+ v = (deltaTime ~> outputStream dv 0)+(vec2, v1) <- runVarT v 0.5 -- hangs indefinitely+```++Surprisingly enough, this is expected behavior (inputs that conclude the+current spline should be passed downstream immediately), but the behavior isn't+easily spotted. If you encounter your program hanging check to see that your+cyclical splines aren't receiving an input that is bigger than they expect.++### A very easy fix+There is a very simple fix for this scenario - produce exactly one duplicate+output just before recursing:++```haskell+let dv :: Monad m => SplineT Float (V2 Float) m ()+ dv = do tween_ easeInExpo 10 (V2 100 10) 0.25+ tween_ easeInExpo (V2 100 10) 100 0.25+ tween_ easeInExpo 100 (V2 10 100) 0.25+ vec <- tween easeInExpo (V2 10 100) 10 0.25+ step vec -- <----------------------------\+ dv -- |+ v :: Monad m => VarT m Float (V2 Float) -- |+ v = (deltaTime ~> outputStream dv 0) -- |+(vec, v1) <- runVarT v 0.5 -- will produce 'vec' ---/+```++The downside is that this is not mathematically accurate - the delta will be+completely consumed and the stream will output the last position even though+the delta was not necessarily an amount great enough to warrant that output.
app/Main.hs view
@@ -2,7 +2,7 @@ import Control.Varying import Control.Applicative-import Text.Printf+import Control.Concurrent (forkIO, killThread) import Data.Functor.Identity import Data.Time.Clock @@ -20,7 +20,7 @@ tweenx :: (Applicative m, Monad m) => SplineT Float Float m Float tweenx = do -- Tween from 0 to 100 over 1 second- x <- tween easeOutExpo 0 100 1+ x <- tween easeOutExpo 0 50 1 -- Chain another tween back to the starting position _ <- tween easeOutExpo x 0 1 -- Loop forever@@ -30,16 +30,16 @@ -- ends. tweeny :: (Applicative m, Monad m) => SplineT Float Float m Float tweeny = do- y <- tween easeOutQuad 0 100 1- _ <- tween easeOutQuad y 0 1+ y <- tween easeOutExpo 50 0 1+ _ <- tween easeOutExpo y 50 1 tweeny -- Our time signal counts input delta time samples.-time :: Monad m => VarT m Delta Float+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 :: Monad m => VarT m Delta Point+backAndForth :: (Applicative m, 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@@ -58,14 +58,30 @@ main :: IO () main = do putStrLn "An example of value streams using the varying library."- putStrLn "Enter a newline to continue, quit with ctrl+c"+ putStrLn "Enter a newline to continue, and then a newline to quit" _ <- getLine- utc0 <- getCurrentTime - loop backAndForth utc0- where loop v utc1 = do utc2 <- getCurrentTime- let dt = realToFrac $ diffUTCTime utc2 utc1- (point, vNext) <- runVarT v $ Delta dt- printf "\nPoint %03.1f %03.1f" (px point) (py point)- loop vNext utc2+ 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 fixed time step.+ 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+ --threadDelay 10+ loop vNext t1
bench/Main.hs view
@@ -1,12 +1,10 @@ import Control.Varying+import Control.Monad import Criterion.Main-import Debug.Trace main :: IO () main = do- let v :: Var Int Int- v = var (+1)- run v a = fst <$> runVarT v a+ let run v a = 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@@ -16,9 +14,19 @@ , bench "64" $ nf (run $ chain 64) 0 , bench "128" $ nf (run $ chain 128) 0 ]+ , bgroup "SplineT"+ [ bench "runSplineT" $+ nf (run $ outputStream spline 0) 0+ ] ] return () chain :: Int -> Var Int Int chain n = seq x x where x = foldl (~>) (var (+1)) $ take (n - 1) $ cycle [var (+1)]++spline :: Spline Float Float ()+spline = do+ void $ tween easeInExpo 0 100 1+ void $ tween easeOutExpo 100 0 1+ spline
changelog.md view
@@ -13,5 +13,10 @@ 0.4.0.0 - Var and Spline are now parameterized with Identity, removed mix, changed the behavior of race, added untilEvent variants, added tests -0.5.0.0 - changed stepMany to remove Monoid requirement, added raceMany, added +0.5.0.0 - changed stepMany to remove Monoid requirement, added raceMany, added anyE, more tests and SplineT obeys Applicative and Monad laws++0.5.0.1 - removed time as dependency++0.5.0.2 - separated tweening time and value, added runSplineE, builds on all GHC+ since 7.6
src/Control/Varying/Core.hs view
@@ -124,10 +124,10 @@ -- | Run the stream over the input values, gathering the output values in a -- list.-scanVar :: (Applicative m, Monad m) => VarT m a b -> [a] -> m [b]-scanVar v = liftM snd . foldM f (v,[])- where f (v', outs) a = do (b, v'') <- runVarT v' a- return (v'', outs ++ [b])+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 --------------------------------------------------------------------------------@@ -150,7 +150,7 @@ -------------------------------------------------------------------------------- -- | Accumulates input values using a folding function and yields -- that accumulated value each sample.-accumulate :: Monad m => (c -> b -> c) -> c -> VarT m b c+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')@@ -160,7 +160,7 @@ -- themselves for values. For example: -- -- > let v = 1 + delay 0 v in testVar_ v-delay :: Monad m => b -> VarT m a b -> VarT m a b+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'')@@ -173,10 +173,10 @@ -- The "left plug" does the same thing in the opposite direction. This allows -- you to write value streams that read naturally. ---------------------------------------------------------------------------------(~>) :: Monad m => VarT m a b -> VarT m b c -> VarT m a c+(~>) :: (Monad m, Applicative m) => VarT m a b -> VarT m b c -> VarT m a c (~>) = (>>>) -(<~) :: Monad m => VarT m b c -> VarT m a b -> VarT m a c+(<~) :: (Monad m, Applicative m) => VarT m b c -> VarT m a b -> VarT m a c (<~) = (<<<) -------------------------------------------------------------------------------- -- Typeclass instances@@ -282,11 +282,10 @@ -- input. It's a kind of Mealy machine (an automaton) with effects. Using -- 'runVarT' with an input value of type 'a' yields a "step", which is a value -- of type 'b' and a new 'VarT' for yielding the next value.-data VarT m a b where- Done :: b -> VarT m a b- -- ^ Given a value, return a computation that yields a constant value- -- forever. You can also do this with the function 'done'.- VarT :: (a -> m (b, VarT m a 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.+data VarT m a b = Done b+ -- ^ Given a value, return a computation that yields a constant value+ -- forever. You can also do this with the function 'done'.+ | VarT (a -> m (b, VarT m a b))+ -- ^ Given an input value, return a computation that effectfully+ -- produces an output value and a new stream for producing the next+ -- sample.
src/Control/Varying/Event.hs view
@@ -174,7 +174,7 @@ -- | 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 :: Monad m => [VarT m a (Event b)] -> VarT m a (Event b)+anyE :: (Applicative m, Monad m) => [VarT m a (Event b)] -> VarT m a (Event b) anyE [] = never anyE vs = VarT $ \a -> do outs <- mapM (`runVarT` a) vs
src/Control/Varying/Spline.hs view
@@ -19,12 +19,17 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} module Control.Varying.Spline ( -- * Spline Spline, -- * Spline Transformer SplineT(..),+ -- * Running and streaming runSplineT,+ runSplineE, scanSpline, outputStream, resultStream,@@ -60,23 +65,35 @@ -- 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.-data SplineT a b m c where- Pass :: c -> SplineT a b m c- SplineT :: VarT m a (b, Event c) -> SplineT a b m c+data SplineT a b m c = Pass c+ | SplineT (VarT m a (b, Event c)) -- | Convert a spline into a stream of output value and eventual result value -- tuples. Requires a default output value in case none are produced.-runSplineT :: Monad m => SplineT a b m c -> b -> VarT m a (b, Event c)+runSplineT :: (Applicative m, Monad m) => SplineT a b m c -> b -> VarT m a (b, Event c)+--runSplineT (SplineT v) _ = VarT $ runVarT v >=> \case+-- ((b,NoEvent), v1) -> return ((b,NoEvent), runSplineT (SplineT v1) b)+-- ((b,Event c), _) -> return ((b, Event c), runSplineT (Pass c) b) runSplineT (Pass c) b = pure (b, Event c) runSplineT (SplineT v) _ = VarT $ \a -> do (o@(b,ec), v1) <- runVarT v a- let s = case ec of- NoEvent -> SplineT v1- Event c -> Pass c+ let !s = case ec of+ NoEvent -> SplineT v1+ Event c -> Pass c return (o, runSplineT s b) +-- | Run a spline without converting it into a stream. Produces either an output+-- value on the left or the result value on the right.+runSplineE :: Monad m => SplineT a b m c -> a -> m (Either b c, SplineT a b m c)+runSplineE (Pass c) _ = return (Right c, Pass c)+runSplineE (SplineT v) a = do+ ((b, ev), v1) <- runVarT v a+ return $ case ev of+ NoEvent -> (Left b, SplineT v1)+ Event c -> (Right c, Pass c)+ -- | A spline is a functor by applying the function to the result.-instance Monad m => Functor (SplineT a b m) where+instance (Applicative m, Monad m) => Functor (SplineT a b m) where fmap f (Pass c) = Pass $ f c fmap f (SplineT v) = SplineT (((f <$>) <$>) <$> v) @@ -84,7 +101,7 @@ -- 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 Monad m => Applicative (SplineT a b m) where+instance (Applicative m, Monad m) => Applicative (SplineT a b m) where pure = Pass (Pass f) <*> (Pass x) = Pass $ f x (Pass f) <*> (SplineT v) = f <$> SplineT v@@ -96,7 +113,7 @@ -- | A spline responds to bind by running until it produces an eventual value, -- then uses that value to run the next spline.-instance Monad m => Monad (SplineT a b m) where+instance (Applicative m, Monad m) => Monad (SplineT a b m) where return = Pass (Pass x) >>= f = f x (SplineT v) >>= f = SplineT $ VarT $ \a -> do@@ -105,20 +122,22 @@ NoEvent -> return ((b, NoEvent), runSplineT (SplineT v1 >>= f) b) Event c -> runVarT (runSplineT (f c) b) a +#if MIN_VERSION_base(4,8,0) -- | A spline is a transformer if its output type is a Monoid. instance Monoid b => MonadTrans (SplineT a b) where lift = effect mempty -- | 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 (Monoid b, Monad m, MonadIO m) => MonadIO (SplineT a b m) where+instance (Monoid b, Applicative m, Monad m, MonadIO m) => MonadIO (SplineT a b m) where liftIO = lift . liftIO+#endif -- | Run the spline over the input values, gathering the output and result -- values in a list. scanSpline :: (Applicative m, Monad m) => SplineT a b m c -> b -> [a] -> m [b]-scanSpline s b = scanVar (outputStream s b)+scanSpline s b = fmap fst <$> scanVar (outputStream s b) -- | A SplineT monad parameterized with Identity that takes input of type @a@, -- output of type @b@ and a result value of type @c@.@@ -134,7 +153,7 @@ resultStream s b = snd <$> runSplineT s b -- | Create a spline from an event stream.-fromEvent :: Monad m => VarT m a (Event b) -> SplineT a (Event b) m b+fromEvent :: (Applicative m, Monad m) => VarT m a (Event b) -> SplineT a (Event b) m b fromEvent ve = SplineT $ f <$> ve where f e = (e,e) @@ -257,7 +276,7 @@ mapOutput _ (Pass c) = Pass c -- | Map the input value of a spline.-adjustInput :: (Monad m)+adjustInput :: (Applicative m, Monad m) => VarT m a (a -> r) -> SplineT r b m c -> SplineT a b m c adjustInput vf (SplineT vx) = SplineT $ VarT $ \a -> do (f, vf1) <- runVarT vf a
src/Control/Varying/Tween.hs view
@@ -20,6 +20,7 @@ -- * Creating tweens -- $creation tween,+ tween_, constant, timeAsPercentageOf, -- * Interpolation functions@@ -60,68 +61,68 @@ -------------------------------------------------------------------------------- -- | Ease in quadratic.-easeInQuad :: Num t => Easing t-easeInQuad c t b = c * t*t + b+easeInQuad :: (Num t, Fractional t, Real f) => Easing t f+easeInQuad c t b = c * (realToFrac $ t*t) + b -- | Ease out quadratic.-easeOutQuad :: Num t => Easing t-easeOutQuad c t b = (-c) * (t * (t - 2)) + b+easeOutQuad :: (Num t, Fractional t, Real f) => Easing t f+easeOutQuad c t b = (-c) * (realToFrac $ t * (t - 2)) + b -- | Ease in cubic.-easeInCubic :: Num t => Easing t-easeInCubic c t b = c * t*t*t + b+easeInCubic :: (Num t, Fractional t, Real f) => Easing t f+easeInCubic c t b = c * (realToFrac $ t*t*t) + b -- | Ease out cubic.-easeOutCubic :: Num t => Easing t-easeOutCubic c t b = let t' = t - 1 in c * (t'*t'*t' + 1) + b+easeOutCubic :: (Num t, 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 => Int -> Easing t-easeInPow power c t b = c * (t^power) + b+easeInPow :: (Num t, 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 => Int -> Easing t+easeOutPow :: (Num t, Fractional t, Real f) => Int -> Easing t f easeOutPow power c t b =- let t' = t - 1+ let t' = realToFrac t - 1 c' = if power `mod` 2 == 1 then c else -c i = if power `mod` 2 == 1 then 1 else -1 in c' * ((t'^power) + i) + b -- | Ease in sinusoidal.-easeInSine :: Floating t => Easing t-easeInSine c t b = let cos' = cos (t * (pi / 2))+easeInSine :: (Floating t, Real f) => Easing t f+easeInSine c t b = let cos' = cos (realToFrac t * (pi / 2)) in -c * cos' + c + b -- | Ease out sinusoidal.-easeOutSine :: Floating t => Easing t-easeOutSine c t b = let cos' = cos (t * (pi / 2)) in c * cos' + b+easeOutSine :: (Floating t, Real f) => Easing t f+easeOutSine c t b = let cos' = cos (realToFrac t * (pi / 2)) in c * cos' + b -- | Ease in and out sinusoidal.-easeInOutSine :: Floating t => Easing t-easeInOutSine c t b = let cos' = cos (pi * t)+easeInOutSine :: (Floating t, Real f) => Easing t f+easeInOutSine c t b = let cos' = cos (pi * realToFrac t) in (-c / 2) * (cos' - 1) + b -- | Ease in exponential.-easeInExpo :: Floating t => Easing t-easeInExpo c t b = let e = 10 * (t - 1) in c * (2**e) + b+easeInExpo :: (Floating t, Real f) => Easing t f+easeInExpo c t b = let e = 10 * (realToFrac t - 1) in c * (2**e) + b -- | Ease out exponential.-easeOutExpo :: Floating t => Easing t-easeOutExpo c t b = let e = -10 * t in c * (-(2**e) + 1) + b+easeOutExpo :: (Floating t, Real f) => Easing t f+easeOutExpo c t b = let e = -10 * realToFrac t in c * (-(2**e) + 1) + b -- | Ease in circular.-easeInCirc :: Floating t => Easing t-easeInCirc c t b = let s = sqrt (1 - t*t) in -c * (s - 1) + b+easeInCirc :: (Floating t, Real f, Floating f) => Easing t f+easeInCirc c t b = let s = realToFrac $ sqrt (1 - t*t) in -c * (s - 1) + b -- | Ease out circular.-easeOutCirc :: Floating t => Easing t-easeOutCirc c t b = let t' = (t - 1)+easeOutCirc :: (Floating t, Real f) => Easing t f+easeOutCirc c t b = let t' = (realToFrac t - 1) s = sqrt (1 - t'*t') in c * s + b -- | Ease linear.-linear :: Num t => Easing t-linear c t b = c * t + b+linear :: (Floating t, Real f) => Easing t f+linear c t b = c * (realToFrac t) + b -------------------------------------------------------------------------------- -- $creation@@ -145,8 +146,8 @@ -- Keep in mind `tween` must be fed time deltas, not absolute time or -- duration. This is mentioned because the author has made that mistake -- more than once ;)-tween :: (Applicative m, Monad m, Fractional t, Ord t)- => Easing t -> t -> t -> t -> SplineT t t m t+tween :: (Applicative m, Monad m, Num t, Fractional f, Ord f)+ => Easing t f -> t -> t -> f -> SplineT f t m t tween f start end dur = let c = end - start b = start@@ -156,6 +157,15 @@ else (f c t b, NoEvent) in SplineT vt +-- | A version of 'tween' that discards the result. It is simply+--+-- @+-- tween f a b c >> return ()+-- @+--+tween_ :: (Applicative m, Monad m, Num t, Fractional f, Ord f)+ => Easing t f -> t -> t -> f -> SplineT f t m ()+tween_ f a b c = tween f a b c >> return () -- | Creates a tween that performs no interpolation over the duration. constant :: (Applicative m, Monad m, Num t, Ord t)@@ -186,9 +196,9 @@ -- 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 = t -> t -> t -> t+type Easing t f = t -> f -> t -> t -- | A linear interpolation between two values over some duration. -- A `Tween` takes three values - a start value, an end value and -- a duration.-type Tween m t = t -> t -> t -> VarT m t (Event t)+type Tween m t f = t -> t -> f -> VarT m f (Event t)
test/Main.hs view
@@ -2,6 +2,7 @@ import Test.Hspec hiding (after, before) import Test.QuickCheck+import Control.Applicative import Control.Varying import Data.Functor.Identity import Data.Time.Clock@@ -11,29 +12,34 @@ main = hspec $ do describe "before" $ do it "should produce events before a given step" $ do- let Identity scans = scanVar (1 ~> before 3) $ replicate 4 ()+ let varEv :: Var () (Event Int)+ varEv = 1 ~> before 3+ scans = fst $ runIdentity $ scanVar varEv $ replicate 4 () scans `shouldBe` [Event 1, Event 2, NoEvent, NoEvent] describe "after" $ do it "should produce events after a given step" $ do- let Identity scans = scanVar (1 ~> after 3) $ replicate 4 ()+ let varEv :: Var () (Event Int)+ varEv = 1 ~> after 3+ scans = fst $ runIdentity $ scanVar varEv $ replicate 4 () scans `shouldBe` [NoEvent, NoEvent, Event 3, Event 4] describe "anyE" $ do it "should produce on any event" $ do- let v1 = use 1 (1 ~> before 2)+ let v1,v2,v3 :: Var () (Event Int)+ v1 = use 1 (1 ~> before 2) v2 = use 2 (1 ~> after 3) v3 = always 3 v = anyE [v1,v2,v3]- Identity scans = scanVar v $ replicate 4 ()+ scans = fst $ runIdentity $ scanVar v $ replicate 4 () scans `shouldBe` [Event 1, Event 3, Event 2, Event 2] describe "timeAsPercentageOf" $ do it "should run past 1.0" $ do- let Identity scans = scanVar (timeAsPercentageOf 4)- [1,1,1,1,1 :: Float]+ let scans = fst $ runIdentity $ scanVar (timeAsPercentageOf 4)+ [1,1,1,1,1 :: Float] last scans `shouldSatisfy` (> 1) it "should progress by increments of the total" $ do- let Identity scans = scanVar (timeAsPercentageOf 4)- [1,1,1,1,1 :: Float]+ let scans = fst $ runIdentity $ scanVar (timeAsPercentageOf 4)+ [1,1,1,1,1 :: Float] scans `shouldBe` [0.25,0.5,0.75,1.0,1.25 :: Float] describe "tween" $@@ -119,9 +125,9 @@ case x of (Just "b", 2) -> step "True" _ -> step "False"- scans = scanSpline r "" $ replicate 3 ()+ Identity scans = scanSpline r "" $ replicate 3 () it "should end with the last value captured" $- unwords (concat scans) `shouldBe` "a b True"+ unwords scans `shouldBe` "a b True" describe "mapOutput" $ do let s :: Spline a Char ()@@ -150,7 +156,7 @@ let inc = 1 ~> accumulate (+) 0 sinc :: Spline a Int (Int, Int) sinc = inc `untilEvent` (1 ~> after 3)- go a = scanSpline a 0 [0..9]+ go a = runIdentity (scanSpline a 0 [0..9]) equal a b = go a `shouldBe` go b describe "spline's functor instance" $ do@@ -171,13 +177,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)+ 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)- w = pure 72 `_untilEvent` (use 3 $ 1 ~> after 1)+ 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)" $@@ -192,14 +198,14 @@ it "(right identity w/ const) m >>= return == m" $ equal (p >>= return) p it "(right identity) m >>= return == m" $ equal h hr it "(right identity w/ monadic results) m >>= return == m" $- (scanVar (runSplineT h 0) [0..9])- `shouldBe` scanVar (runSplineT hr 0) [0..9]+ runIdentity (scanSpline h 0 [0..9 :: Int])+ `shouldBe` runIdentity (scanSpline hr 0 [0..9 :: Int]) let f :: Int -> Spline a String Bool f x = do mapM_ (step . show) [0..x] return True it "(left identity) return a >>= f == f a" $- (scanVar (runSplineT (return 3 >>= f) "") [0..9])- `shouldBe` scanVar (runSplineT (f 3) "") [0..9]+ runIdentity (scanSpline (return 3 >>= f) "" [0..9 :: Int])+ `shouldBe` runIdentity (scanSpline (f 3) "" [0..9 :: Int]) let m :: Spline a String Int m = do step "hey" step "dude"@@ -210,5 +216,5 @@ g False = do step "dang" step "missed it" it "(associativity) (m >>= f) >>= g == m >>= (\\x -> f x >>= g)" $- (scanVar (runSplineT ((m >>= f) >>= g) "") [0..9])- `shouldBe` scanVar (runSplineT (m >>= (\x -> f x >>= g)) "") [0..9]+ runIdentity (scanSpline ((m >>= f) >>= g) "" [0..9 :: Int])+ `shouldBe` runIdentity (scanSpline (m >>= (\x -> f x >>= g)) "" [0..9 :: Int])
varying.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.5.0.0+version: 0.5.0.2 -- A short (one-line) description of the package. synopsis: FRP through value streams and monadic splines.@@ -75,9 +75,8 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base >=4.7 && <4.9,- time >=1.5 && <1.6,- transformers >= 0.4 && <0.5+ build-depends: base >=4.6 && <5.0+ , transformers >=0.3 -- Directories containing source files. hs-source-dirs: src@@ -89,10 +88,10 @@ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -- Other library packages from which modules are imported.- build-depends: base >=4.7 && <4.9,- time >=1.5 && <1.6,- transformers >= 0.4 && <0.5,- varying+ build-depends: base >=4.6 && <5.0+ , transformers >=0.3+ , time >=1.4+ , varying -- Directories containing source files.@@ -108,8 +107,8 @@ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -- Other library packages from which modules are imported.- build-depends: base >=4.7 && <4.9- , time >=1.5 && <1.6+ build-depends: base >=4.6 && <5.0+ , time >=1.4 , transformers , varying , hspec@@ -129,8 +128,8 @@ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -- Other library packages from which modules are imported.- build-depends: base >=4.7 && <4.9- , time >=1.5 && <1.6+ build-depends: base >=4.6+ , time >=1.4 , transformers , varying , criterion