AsyncRattus 0.2.0.2 → 0.2.1

raw patch · 4 files changed

+270/−68 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• AsyncRattus.cabal +1/−1
• CHANGELOG.md +4/−0
• src/AsyncRattus/Signal.hs +160/−4
• src/AsyncRattus/Strict.hs +105/−63

@@ -1,6 +1,6 @@ cabal-version:       1.18 name:                AsyncRattus-version:             0.2.0.2+version:             0.2.1 category:            FRP synopsis:            An asynchronous modal FRP language description:

@@ -1,3 +1,7 @@+# 0.2.1++- More signal combinators+ # 0.2.0.2  - Fix strictness/stable checker: It now recognises `Word8/16/32/64` and

@@ -5,12 +5,14 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedLists #-}   -- | Programming with signals.  module AsyncRattus.Signal-  ( map+  ( Sig(..)+  , map   , mkInputSig   , getInputSig   , filterMap@@ -23,7 +25,11 @@   , switch   , switchS   , switchAwait+  , switchR   , interleave+  , mapInterleave+  , interleaveAll+  , update   , mkSig   , mkBoxSig   , current@@ -32,11 +38,19 @@   , scan   , scanAwait   , scanMap-  , Sig(..)+  , jump+  , jumping+  , stop   , zipWith   , zipWith3   , zip+  , parallelWith+  , parallelWithAwait+  , parallel+  , parallelAwait   , cond+  , buffer+  , bufferAwait   , integral   , derivative   )@@ -186,6 +200,33 @@ scanMap f p acc (a ::: as) =  unbox p acc' ::: delay (scanMap f p acc' (adv as))   where acc' = unbox f acc a +-- | @jump (box f) xs@ first behaves like @xs@, but as soon as @f x =+-- Just xs'@ for a (current or future) value @x@ of @xs@, it behaves+-- like @xs'@.++jump :: Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a+jump f (x ::: xs) = case unbox f x of+                        Just' xs' -> xs'+                        Nothing' -> x ::: delay (jump f (adv xs))+++-- | Similar to 'jump', but it can jump repeatedly. That is, @jumping+-- (box f) xs@ first behaves like @xs@, but every time @f x = Just+-- xs'@ for a (current or future) value @x@ of @jumping (box f) xs@,+-- it behaves like @xs'@.++jumping :: Box (a -> Maybe' (Sig a)) -> Sig a -> Sig a+jumping f (x ::: xs) = case unbox f x of+                         Just' (x' ::: xs') -> x' ::: delay (jumping f (adv xs'))+                         Nothing'           -> x  ::: delay (jumping f (adv xs))++-- | Stops as soon as the the predicate becomes true for the current+-- value. That is, @stop (box p) xs@ first behaves as @xs@, but as+-- soon as @f x = True@ for some (current or future) value @x@ of+-- @xs@, then it behaves as @const x@.+stop :: Box (a -> Bool) -> Sig a ->  Sig a+stop p = jump (box (\ x -> if unbox p x then Just' (const x) else Nothing'))+ -- | This function allows to switch from one signal to another one -- dynamically. The signal defined by @switch xs ys@ first behaves -- like @xs@, but as soon as @ys@ produces a new value, @switch xs ys@@@ -194,9 +235,9 @@ -- Example: -- -- >           xs: 1 2 3 4 5   6 7 8   9--- >           ys:         1 2   3 4 5 6+-- >           ys:       1 2   3 4 5 6 -- >--- > switch xs ys: 1 2 3 1 2 4   3 4 5 6+-- > switch xs ys: 1 2 3 1 2   3 4 5 6 switch :: Sig a -> O (Sig a) -> Sig a switch (x ::: xs) d = x ::: delay (case select xs d of                                      Fst   xs'  d'  -> switch xs' d'@@ -219,6 +260,19 @@                                   Snd  _    d'  -> d'                                   Both _    d'  -> d') +-- | Variant of 'switchS' that repeatedly switches. The output signal+-- @switch xs ys@ first behaves like @xs@, but whenever @ys@ produces+-- a value @f@, the signal switches to @f v@ where @v@ is the previous+-- value of the output signal. +--+-- 'switchS' can be considered a special case of 'switchR' that only+-- makes a single switch. That is we have the following:+--+-- > switchS xs ys = switchR (delay (const (adv xs))) ys+switchR :: Stable a => Sig a -> O (Sig (a -> Sig a)) -> Sig a+switchR sig steps = switchS sig+      (delay (let step ::: steps' = adv steps in \ x -> switchR (step x) steps'))+ -- | This function interleaves two signals producing a new value @v@ -- whenever either input stream produces a new value @v@. In case the -- input signals produce a new value simultaneously, the function@@ -238,6 +292,37 @@                               Both (x ::: xs') (y ::: ys') -> unbox f x y ::: interleave f xs' ys')  +-- | This is the composition of 'mapAwait' and 'interleave'. That is,+-- +-- > mapInterleave f g xs ys = mapAwait f (interleave xs ys)+mapInterleave :: Box (a -> a) -> Box (a -> a -> a) -> O (Sig a) -> O (Sig a) -> O (Sig a)+mapInterleave g f xs ys = delay (case select xs ys of+                              Fst (x ::: xs') ys' -> unbox g x ::: mapInterleave g f xs' ys'+                              Snd xs' (y ::: ys') -> unbox g y ::: mapInterleave g f xs' ys'+                              Both (x ::: xs') (y ::: ys') -> unbox g (unbox f x y) ::: mapInterleave g f xs' ys')+++{-# ANN interleaveAll AllowRecursion #-}+interleaveAll :: Box (a -> a -> a) -> List (O (Sig a)) -> O (Sig a)+interleaveAll _ Nil = error "interleaveAll: List must be nonempty"+interleaveAll _ [s] = s+interleaveAll f (x :! xs) = interleave f x (interleaveAll f xs)+++-- | Takes two signals and updates the first signal using the+-- functions produced by the second signal:+--+-- Law:+--+-- > (xs `update` fs) `update` gs = (xs `update` (interleave (box (.)) gs fs))+update :: (Stable a) => Sig a -> O (Sig (a -> a)) -> Sig a+update (x ::: xs) fs = x ::: delay +    (case select xs fs of+      Fst xs' ys' -> update xs' ys'+      Snd xs' (f ::: fs') -> update (f x ::: xs') fs'+      Both (x' ::: xs') (f ::: fs') -> update (f x' ::: xs') fs')++ -- | This function is a variant of combines the values of two signals -- using the function argument. @zipWith f xs ys@ produces a new value -- @unbox f x y@ whenever @xs@ or @ys@ produce a new value, where @x@@@ -277,6 +362,77 @@ -- > zip = zipWith (box (:*)) zip :: (Stable a, Stable b) => Sig a -> Sig b -> Sig (a:*b) zip = zipWith (box (:*))++++-- | This is a variant of 'zipWith', but the values passed to the+-- function may not exist if the corresponding source signal has not+-- ticked.+-- +-- Example:+--+-- >                            xs:  1            2          3          +-- >                            ys:  1                       0            5+-- >+-- > parallelWith (box (:*)) xs ys:  (J 1 :* J 1) (J 2 :* N) (J 3 :* J 0) (N :* J 5)++parallelWith :: Box (Maybe' a -> Maybe' b -> c) -> Sig a -> Sig b -> Sig c+parallelWith f (x ::: xs) (y ::: ys) = +   unbox f (Just' x) (Just' y) ::: parallelWithAwait f xs ys++-- | This is a variant of `parallelWith` for delayed signals.+--+-- Example:+--+-- >                       xs:    2          3          +-- >                       ys:               0            5+-- >+-- > paralle (box (:*)) xs ys:    (J 2 :* N) (J 3 :* J 0) (N :* J 5)+parallelWithAwait :: Box (Maybe' a -> Maybe' b -> c) -> O (Sig a) -> O (Sig b) -> O (Sig c)+parallelWithAwait f xs ys = delay (+  case select xs ys of+     Fst (x ::: xs')   ys'        -> unbox f (Just' x)  (Nothing') ::: parallelWithAwait f xs' ys'+     Snd xs'          (y ::: ys') -> unbox f (Nothing') (Just' y)  ::: parallelWithAwait f xs' ys'+     Both (x ::: xs') (y ::: ys') -> unbox f (Just' x)  (Just' y)  ::: parallelWithAwait f xs' ys')++-- | This is a variant of 'zip', but the signal of pairs only contain+-- values if the corresponding source signal ticked.+-- +-- Example:+--+-- >             xs:  1            2          3          +-- >             ys:  1                       0            5+-- >+-- > parallel xs ys:  (J 1 :* J 1) (J 2 :* N) (J 3 :* J 0) (N :* J 5)++parallel :: Sig a -> Sig b -> Sig (Maybe' a :* Maybe' b)+parallel (x ::: xs) (y ::: ys) = +   (Just' x :* Just' y) ::: parallelAwait xs ys++-- | This is a variant of `parallel` for delayed signals.+--+-- Example:+--+-- >             xs:    2          3          +-- >             ys:               0            5+-- >+-- > parallel xs ys:    (J 2 :* N) (J 3 :* J 0) (N :* J 5)++parallelAwait :: O (Sig a) -> O (Sig b) -> O (Sig (Maybe' a :* Maybe' b))+parallelAwait xs ys = delay (+  case select xs ys of+     Fst (x ::: xs')   ys'        -> (Just' x  :* Nothing') ::: parallelAwait xs' ys'+     Snd xs'          (y ::: ys') -> (Nothing' :* Just' y)  ::: parallelAwait xs' ys'+     Both (x ::: xs') (y ::: ys') -> (Just' x  :* Just' y)  ::: parallelAwait xs' ys')++-- Buffer takes an initial value and a signal as input and returns a signal that+-- is always one tick behind the input signal.+buffer :: Stable a => a -> Sig a -> Sig a+buffer x (y ::: ys) = x ::: delay (buffer y (adv ys))++-- Like buffer but works for delayed signals+bufferAwait :: Stable a => a -> O (Sig a) -> O (Sig a)+bufferAwait x xs = delay (buffer x (adv xs))  -- | Sampling interval (in microseconds) for the 'integral' and -- 'derivative' functions.

@@ -3,7 +3,9 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TemplateHaskell #-} + -- | This module contains strict versions of some standard data -- structures. @@ -12,20 +14,28 @@ module AsyncRattus.Strict   ( List(..),     singleton,-    fromList,-    toList,+    IsList(..),     init',     reverse',+    union',+    unionBy',+    nub',+    nubBy',+    filter',+    delete',+    deleteBy',     (+++),     listToMaybe',     map',     zip',     zipWith',     mapMaybe',+    concatMap',     (:*)(..),     Maybe'(..),     maybe',     fromMaybe',+    isJust',     fst',     snd',     curry',@@ -34,24 +44,75 @@  import Prelude hiding (map) import Data.VectorSpace+import GHC.Exts (IsList(..))  infixr 2 :*+-- | Strict pair type.+data a :* b = !a :* !b++-- | First projection function.+fst' :: (a :* b) -> a+fst' (a:*_) = a++-- | Second projection function.+snd' :: (a :* b) -> b+snd' (_:*b) = b++curry' :: ((a :* b) -> c) -> a -> b -> c+curry' f x y = f (x :* y)++uncurry' :: (a -> b -> c) -> (a :* b) -> c+uncurry' f (x :* y) = f x y+++instance Functor ((:*) a) where+  fmap f (x:*y) = (x :* f y)+  +instance (Show a, Show b) => Show (a:*b) where+  show (a :* b) = "(" ++ show a ++ " :* " ++ show b ++ ")"++instance (Eq a, Eq b) => Eq (a :* b) where+  (x1 :* y1) == (x2 :* y2) = x1 == x2 && y1 == y2+++instance (VectorSpace v a, VectorSpace w a, Floating a, Eq a) => VectorSpace (v :* w) a where+  zeroVector = zeroVector :* zeroVector++  a *^ (x :* y) = (a *^ x) :* (a *^ y)++  (x :* y) ^/ a = (x ^/ a) :* (y ^/ a)++  negateVector (x :* y) = (negateVector x) :* (negateVector y)++  (x1 :* y1) ^+^ (x2 :* y2) = (x1 ^+^ x2) :* (y1 ^+^ y2)++  (x1 :* y1) ^-^ (x2 :* y2) = (x1 ^-^ x2) :* (y1 ^-^ y2)++  (x1 :* y1) `dot` (x2 :* y2) = (x1 `dot` x2) + (y1 `dot` y2)+ infixr 8 :!  -- | Strict list type. data List a = Nil | !a :! !(List a) + singleton :: a -> List a singleton x = x :! Nil -fromList :: [a] -> List a-fromList [] = Nil-fromList (x : xs) = x :! fromList xs+instance Traversable List where+  traverse _ Nil = pure Nil+  traverse f (x :! xs) = (:!) <$> (f x) <*> (traverse f xs) -toList :: List a -> [a]-toList Nil = []-toList (x :! xs) = x : toList xs+instance IsList (List a) where+  type Item (List a) = a +  fromList [] = Nil+  fromList (x : xs) = x :! fromList xs++  toList Nil = []+  toList (x :! xs) = x : toList xs++ -- | Remove the last element from a list if there is one, otherwise -- return 'Nil'. init' :: List a -> List a@@ -82,6 +143,10 @@ map' _ Nil = Nil map' f (x :! xs) = f x :! map' f xs +concatMap' :: (a -> List b) -> List a -> List b+concatMap' _ Nil = Nil+concatMap' f (x :! xs) = f x +++ concatMap' f xs+ zip' :: List a -> List b -> List (a :* b) zip' Nil _ = Nil zip' _ Nil = Nil@@ -105,6 +170,37 @@   Nothing' -> rs   Just' r  -> r:!rs +isJust' :: Maybe' a -> Bool+isJust' (Just' _) = True+isJust' Nothing' = False++union' :: (Eq a) => List a -> List a -> List a+union' = unionBy' (==)++unionBy' :: (a -> a -> Bool) -> List a -> List a -> List a+unionBy' eq xs ys =  xs +++ foldl (flip (deleteBy' eq)) (nubBy' eq ys) xs++delete' :: (Eq a) => a -> List a -> List a+delete' =  deleteBy' (==)++deleteBy' :: (a -> a -> Bool) -> a -> List a -> List a+deleteBy' _  _ Nil        = Nil+deleteBy' eq x (y :! ys)    = if x `eq` y then ys else y :! deleteBy' eq x ys+++nub' :: (Eq a) => List a -> List a+nub' =  nubBy' (==)++nubBy' :: (a -> a -> Bool) -> List a -> List a+nubBy' _ Nil             =  Nil+nubBy' eq (x:!xs)         =  x :! nubBy' eq (filter' (\ y -> not (eq x y)) xs)++filter' :: (a -> Bool) -> List a -> List a+filter' _ Nil    = Nil+filter' pred (x :! xs)+  | pred x         = x :! filter' pred xs+  | otherwise      = filter' pred xs+ instance Foldable List where      foldMap f = run where@@ -137,16 +233,7 @@   show (x :! xs) = show x ++ " :! " ++ show xs  -- | Strict variant of 'Maybe'.-data Maybe' a = Just' !a | Nothing'--instance Eq a => Eq (Maybe' a) where-  Nothing' == Nothing' = True-  Just' x == Just' y = x == y-  _ == _ = False--instance Show a => Show (Maybe' a) where-  show Nothing' = "Nothing'"-  show (Just' x) = "Just' " ++ show x+data Maybe' a = Just' !a | Nothing' deriving (Show, Eq, Ord)  -- | takes a default value, a function, and a 'Maybe'' value.  If the -- 'Maybe'' value is 'Nothing'', the function returns the default@@ -159,48 +246,3 @@ fromMaybe' :: a -> Maybe' a -> a fromMaybe' _ (Just' x) = x fromMaybe' d Nothing' = d---- | Strict pair type.-data a :* b = !a :* !b---- | First projection function.-fst' :: (a :* b) -> a-fst' (a:*_) = a---- | Second projection function.-snd' :: (a :* b) -> b-snd' (_:*b) = b--curry' :: ((a :* b) -> c) -> a -> b -> c-curry' f x y = f (x :* y)--uncurry' :: (a -> b -> c) -> (a :* b) -> c-uncurry' f (x :* y) = f x y---instance Functor ((:*) a) where-  fmap f (x:*y) = (x :* f y)-  -instance (Show a, Show b) => Show (a:*b) where-  show (a :* b) = "(" ++ show a ++ " :* " ++ show b ++ ")"--instance (Eq a, Eq b) => Eq (a :* b) where-  (x1 :* y1) == (x2 :* y2) = x1 == x2 && y1 == y2---instance (VectorSpace v a, VectorSpace w a, Floating a, Eq a) => VectorSpace (v :* w) a where-  zeroVector = zeroVector :* zeroVector--  a *^ (x :* y) = (a *^ x) :* (a *^ y)--  (x :* y) ^/ a = (x ^/ a) :* (y ^/ a)--  negateVector (x :* y) = (negateVector x) :* (negateVector y)--  (x1 :* y1) ^+^ (x2 :* y2) = (x1 ^+^ x2) :* (y1 ^+^ y2)--  (x1 :* y1) ^-^ (x2 :* y2) = (x1 ^-^ x2) :* (y1 ^-^ y2)--  (x1 :* y1) `dot` (x2 :* y2) = (x1 `dot` x2) + (y1 `dot` y2)--