ramus (empty) → 0.0.1

raw patch · 13 files changed

+878/−0 lines, 13 filesdep +QuickCheckdep +basedep +criterionsetup-changed

Dependencies added: QuickCheck, base, criterion, hspec, quickcheck-io, ramus

Files

• LICENSE +25/−0
• README.md +43/−0
• Setup.hs +7/−0
• benchmark/Main.hs +6/−0
• library/Ramus/Channel.hs +17/−0
• library/Ramus/DOM.hs +62/−0
• library/Ramus/Signal.hs +185/−0
• library/Ramus/Time.hs +88/−0
• package.yaml +48/−0
• ramus.cabal +66/−0
• stack.yaml +75/−0
• test-suite/Main.hs +198/−0
• test-suite/SignalTester.hs +58/−0

@@ -0,0 +1,25 @@+The MIT License (MIT)
+=====================
+
+Copyright © `<year>` `<copyright holders>`
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the “Software”), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,43 @@+# Ramus
+
+Ramus is a lightweight FRP-like library heavily inspired by the Elm Signal implementation,
+in fact, it's a direct port of the [purescript-signal](https://github.com/bodil/purescript-signal) library,
+in Haskell.
+Where possible and sensible, it tries to maintain API equivalence with Elm.
+
+See [the Elm documentation](http://elm-lang.org:1234/guide/reactivity#signals) for details on usage and principles.
+
+## Haskell Usage Patterns
+
+Haskell depends on `IO` to manage side effects, where Elm's runtime generally manages them for you.
+`ramus` provides the `Signal.runSignal` function for running effectful signals.
+
+```haskell
+module Main where
+
+import Signal
+
+hello :: Signal String
+hello = constant "Hello Joe!"
+
+helloEffect :: Signal (IO ())
+helloEffect = hello ~> print
+
+main :: IO ()
+main = runSignal helloEffect
+```
+
+This simple example takes a constant signal which contains the string `"Hello Joe!"`
+and maps it over the `print` function, which has the type `(Show a) => a -> IO()`, thus taking the `String`
+content of the signal and turning it into an effect which logs the provided string to the user's console.
+
+This gives us a `Signal (IO ())`. We use `runSignal` to take the signal of effects and run each effect
+in turn—in our case, just the one effect which prints `"Hello Joe!"` to the console.
+
+## API Documentation
+
+* TODO: Add to hackage
+
+## Usage Examples
+
+* TODO

@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't
+-- need to change it. The Cabal documentation has more information about this
+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.
+import qualified Distribution.Simple
+
+main :: IO ()
+main = Distribution.Simple.defaultMain

@@ -0,0 +1,6 @@+-- You can benchmark your code quickly and effectively with Criterion. See its
+-- website for help: <http://www.serpentine.com/criterion/>.
+import Criterion.Main
+
+main :: IO ()
+main = defaultMain [bench "const" (whnf const ())]

@@ -0,0 +1,17 @@+module Ramus.Channel where
+
+import Ramus.Signal
+
+newtype Channel a = Channel (Signal a)
+
+-- |Creates a channel, which allows you to feed arbitrary values into a signal.
+channel :: a -> IO (Channel a)
+channel = return . Channel . make
+
+-- |Sends a value to a given channel.
+send :: Channel a -> a -> IO ()
+send (Channel c) = set c
+
+-- |Takes a channel and returns a signal of the values sent to it.
+subscribe :: Channel a -> Signal a
+subscribe (Channel c) = c

@@ -0,0 +1,62 @@+module Ramus.DOM where
+
+import Ramus.Signal
+import Ramus.Time
+
+data CoordinatePair = CoordinatePair { x :: Int, y :: Int }
+data DimensionPair  = DimensionPair { w :: Int, h :: Int }
+
+-- |Creates a signal which will be `true` when the key matching the given key
+-- |code is pressed, and `false` when it's released.
+keyPressed :: Int -> IO (Signal Bool)
+keyPressed = undefined
+
+-- |Creates a signal which will be `true` when the given mouse button is
+-- |pressed, and `false` when it's released.
+mouseButton :: Int -> IO (Signal Bool)
+mouseButton = undefined
+
+data Touch = Touch
+  { id :: String
+  , screenX :: Int
+  , screenY :: Int
+
+  , clientX :: Int
+  , clientY :: Int
+
+  , pageX :: Int
+  , pageY :: Int
+
+  , radiusX :: Int
+  , radiusY :: Int
+
+  , rotationAngle :: Float
+  , force :: Float
+  }
+
+-- |A signal containing the current state of the touch device, as described by
+-- |the `Touch` record type.
+touch :: IO (Signal [Touch])
+touch = undefined
+
+-- |A signal which will be `true` when at least one finger is touching the
+-- |touch device, and `false` otherwise.
+tap :: IO (Signal Bool)
+tap = do
+  touches <- touch
+  pure $ touches ~> \t -> case t of
+    [] -> False
+    _ -> True
+
+-- |A signal containing the current mouse position.
+mousePos :: IO (Signal CoordinatePair)
+mousePos = undefined
+
+-- |A signal which yields the current time, as determined by `now`, on every
+-- |animation frame (see [https://developer.mozilla.org/en-US/docs/Web/API/window/requestAnimationFrame]).
+animationFrame :: IO (Signal Time)
+animationFrame = undefined
+
+-- |A signal which contains the document window's current width and height.
+windowDimensions :: IO (Signal DimensionPair)
+windowDimensions = undefined constant

@@ -0,0 +1,185 @@+module Ramus.Signal where
+
+import Prelude hiding (filter)
+
+import Control.Applicative ()
+import Control.Monad (unless, when)
+import Data.Functor ()
+import Data.Semigroup
+import Data.Foldable
+import Data.Maybe
+import Data.IORef
+import System.IO.Unsafe
+
+data Signal a = Signal
+  { get :: a
+  , set :: a -> IO ()
+  , subscribe :: (a -> IO ()) -> IO ()
+  }
+
+unsafeRef :: a -> IORef a
+unsafeRef = unsafePerformIO . newIORef
+
+unsafeRead :: IORef a -> a
+unsafeRead = unsafePerformIO . readIORef
+
+make :: a -> Signal a
+make initial = unsafePerformIO $ do
+  subs <- newIORef [] :: IO (IORef [a -> IO()])
+  val  <- newIORef initial
+  let _get = unsafeRead val
+  let _set newval = do
+        writeIORef val newval
+        forM_ (unsafeRead subs) $ \sub ->
+          sub newval
+  let _subscribe sub = do
+        currentSubs <- readIORef subs
+        _val <- readIORef val
+        writeIORef subs $ currentSubs <> [sub]
+        sub _val
+  return Signal
+    { get = _get
+    , set = _set
+    , subscribe = _subscribe
+    }
+         
+
+
+
+
+-- |Creates a signal with a constant value.
+constant :: a -> Signal a
+constant = make
+
+-- |Merge two signals, returning a new signal which will yield a value
+-- |whenever either of the input signals yield. Its initial value will be
+-- |that of the first signal.
+merge :: Signal a -> Signal a -> Signal a
+merge sig1 sig2 = unsafePerformIO $ do
+  let out = constant $ get sig1
+  sig2 `subscribe` set out
+  sig1 `subscribe` set out
+  return out
+
+-- |Merge all signals inside a `Foldable`, returning a `Maybe` which will
+-- |either contain the resulting signal, or `Nothing` if the `Foldable`
+-- |was empty.
+mergeMany :: (Functor f, Foldable f) => f (Signal a) -> Maybe (Signal a)
+mergeMany sigs = foldl mergeMaybe Nothing (Just <$> sigs)
+  where mergeMaybe a Nothing = a
+        mergeMaybe Nothing a = a
+        mergeMaybe (Just a) (Just b) = Just (merge a b)
+
+-- |Creates a past dependent signal. The function argument takes the value of
+-- |the input signal, and the previous value of the output signal, to produce
+-- |the new value of the output signal.
+foldp :: (a -> b -> b) -> b -> Signal a -> Signal b
+foldp fun seed sig = unsafePerformIO $ do
+  acc <- newIORef seed
+  let out = make seed
+  sig `subscribe` \val -> do
+    acc' <- readIORef acc
+    writeIORef acc $ fun val acc'
+    acc'' <- readIORef acc
+    out `set` acc''
+  return out
+
+-- |Creates a signal which yields the current value of the second signal every
+-- |time the first signal yields.
+sampleOn :: Signal a -> Signal b -> Signal b
+sampleOn = undefined
+
+-- |Create a signal which only yields values which aren't equal to the previous
+-- |value of the input signal.
+dropRepeats :: (Eq a) => Signal a -> Signal a
+dropRepeats sig = unsafePerformIO $ do
+  let val = get sig
+  let out = make val
+  sig `subscribe` \newval ->
+    unless (val == newval) (out `set` val)
+  return out
+
+-- |Given a signal of effects with no return value, run each effect as it
+-- |comes in.
+runSignal :: Signal (IO ()) -> IO ()
+runSignal sig = do
+  sig `subscribe` \val -> val
+
+
+-- |Takes a signal of effects of `a`, and produces an effect which returns a
+-- |signal which will take each effect produced by the input signal, run it,
+-- |and yield its returned value.
+unwrap :: Signal (IO a) -> IO (Signal a)
+unwrap = undefined
+
+-- |Takes a signal and filters out yielded values for which the provided
+-- |predicate function returns `false`.
+filter :: (a -> Bool) -> a -> Signal a -> Signal a
+filter fn seed sig = unsafePerformIO $ do
+  let out = make (if fn (get sig) then get sig else seed)
+  sig `subscribe` \val ->
+    when (fn val) (out `set` val)
+  return out
+
+-- |Map a signal over a function which returns a `Maybe`, yielding only the
+-- |values inside `Just`s, dropping the `Nothing`s.
+filterMap :: (a -> Maybe b) -> b -> Signal a -> Signal b
+filterMap f def sig = fromMaybe def <$> filter isJust (Just def) (f <$> sig)
+
+{-}
+-- |Turns a signal of arrays of items into a signal of each item inside
+-- |each array, in order.
+-- |
+-- |Like `flatten`, but faster.
+flattenArray :: Show a => Signal [a] -> a -> Signal a
+flattenArray sig seed = unsafePerformIO $ do
+  firstRef <- newIORef (Just $ get sig)
+  seedRef <- newIORef seed
+  first <- readIORef firstRef
+  print $ "Read first:" ++ show first
+  case first of
+    Just x -> writeIORef seedRef (head x)
+    Nothing -> writeIORef firstRef Nothing
+  seed <- readIORef seedRef
+  let out = make seed
+  let sset x = do
+          print $ "Feeding value: " ++ show x
+          set out x
+  let feed items = mapM_ sset items
+  sig `subscribe` \val -> do
+    first <- readIORef firstRef
+    case first of
+      Nothing -> feed val
+      Just x -> do
+        feed $ tail x
+        writeIORef firstRef Nothing
+  return out
+
+-- |Turns a signal of collections of items into a signal of each item inside
+-- |each collection, in order.
+flatten :: (Functor f, Foldable f, Show a) => Signal (f a) -> a -> Signal a
+flatten sig = flattenArray (sig ~> fold . fmap (: []) )
+-}
+
+infixl 4 ~>
+(~>) :: Signal a -> (a -> b) -> Signal b
+sig ~> f = fmap f sig
+
+instance Functor Signal where
+  fmap fun sig = unsafePerformIO $ do
+    let out = make $ fun $ get sig
+    sig `subscribe` \val -> out `set` fun val
+    return out
+
+instance Applicative Signal where
+  pure = constant
+  fun <*> sig = unsafePerformIO $ do
+    let f = get fun
+    let out = make $ f (get sig)
+    let produce = const $ out `set` f (get sig)
+    fun `subscribe` produce
+    sig `subscribe` produce
+    return out
+
+instance Semigroup (Signal a) where
+  (<>) = merge

@@ -0,0 +1,88 @@+module Ramus.Time where
+
+import Prelude hiding (filter)
+import Ramus.Signal
+import Control.Concurrent
+import Data.IORef
+import System.IO.Unsafe
+
+type Time = Float
+
+millisecond :: Time
+millisecond = 1.0
+
+second :: Time
+second = 1000.0
+
+-- |Creates a signal which yields the current time (according to `now`) every
+-- |given number of milliseconds.
+every :: Time -> Signal Time
+every = undefined
+
+-- |Returns the number of milliseconds since an arbitrary, but constant, time
+-- |in the past.
+now :: IO Time
+now = undefined
+
+-- |Takes a signal and delays its yielded values by a given number of
+-- |milliseconds.
+delay :: Time -> Signal a -> Signal a
+delay t sig = unsafePerformIO $ do
+  let out = make $ get sig
+  first <- newIORef True
+  sig `subscribe` \val -> do
+    first' <- readIORef first
+    if first'
+      then writeIORef first False
+      else do
+        threadDelay (round $ t * 1000)
+        out `set` val
+      
+  return out
+
+-- |Takes a signal and a time value, and creates a signal which yields `True`
+-- |when the input signal yields, then goes back to `False` after the given
+-- |number of milliseconds have elapsed, unless the input signal yields again
+-- |in the interim.
+since :: Time -> Signal a -> Signal Bool
+since t sig = unsafePerformIO $ do
+  let out = make False
+  firstRef <- newIORef True
+  timerRef <- newIORef Nothing
+  let tick = do
+          out `set` False
+          writeIORef timerRef Nothing
+  sig `subscribe` \val -> do
+    first <- readIORef firstRef
+    if first
+      then writeIORef firstRef False
+      else do
+        timer <- readIORef timerRef
+        case timer of
+          Nothing -> do
+            out `set` True
+            tim <- forkIO $ do
+              threadDelay (round $ t * 1000)
+              tick
+            writeIORef timerRef $ Just tim           
+
+          Just tim -> do
+            killThread tim
+            tim' <- forkIO $ do
+              threadDelay (round $ t * 1000)
+              tick
+            writeIORef timerRef $ Just tim'
+  return out
+
+
+-- |Takes a signal and a time value, and creates a signal which waits to yield
+-- |the next result until the specified amount of time has elapsed. It then
+-- |yields only the newest value from that period. New events during the debounce
+-- |period reset the delay.
+debounce :: Time -> Signal a -> Signal a
+debounce t s =
+  let leading = whenChangeTo False $ since t s
+  in sampleOn leading s
+  where
+    whenEqual value = filter (value ==) value
+    whenChangeTo value input = whenEqual value $ dropRepeats input

@@ -0,0 +1,48 @@+# This YAML file describes your package. Stack will automatically generate a
+# Cabal file when you run `stack build`. See the hpack website for help with
+# this file: <https://github.com/sol/hpack>.
+benchmarks:
+  ramus-benchmarks:
+    dependencies:
+    - base == 4.*
+    - ramus
+    - criterion
+    ghc-options:
+    - -rtsopts
+    - -threaded
+    - -with-rtsopts=-N
+    main: Main.hs
+    source-dirs: benchmark
+category: Other
+description: Ramus is a direct port of purescript-signal into Haskell, offering the Elm signal system for Haskell.
+extra-source-files:
+- CHANGELOG.md
+- LICENSE.md
+- package.yaml
+- README.md
+- stack.yaml
+ghc-options: -Wall
+github: NickSeagull/ramus
+library:
+  dependencies:
+  - base == 4.*
+  source-dirs: library
+license: MIT
+maintainer: Nikita Tchayka
+name: ramus
+synopsis: Elm signal system for Haskell
+tests:
+  ramus-test-suite:
+    dependencies:
+    - base == 4.*
+    - ramus
+    - hspec
+    - QuickCheck
+    - quickcheck-io
+    ghc-options:
+    - -rtsopts
+    - -threaded
+    - -with-rtsopts=-N
+    main: Main.hs
+    source-dirs: test-suite
+version: '0.0.1'

@@ -0,0 +1,66 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           ramus+version:        0.0.1+synopsis:       Elm signal system for Haskell+description:    Ramus is a direct port of purescript-signal into Haskell, offering the Elm signal system for Haskell.+category:       Other+homepage:       https://github.com/NickSeagull/ramus#readme+bug-reports:    https://github.com/NickSeagull/ramus/issues+maintainer:     Nikita Tchayka+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    package.yaml+    README.md+    stack.yaml++source-repository head+  type: git+  location: https://github.com/NickSeagull/ramus++library+  hs-source-dirs:+      library+  ghc-options: -Wall+  build-depends:+      base == 4.*+  exposed-modules:+      Ramus.Channel+      Ramus.DOM+      Ramus.Signal+      Ramus.Time+  default-language: Haskell2010++test-suite ramus-test-suite+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test-suite+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base == 4.*+    , ramus+    , hspec+    , QuickCheck+    , quickcheck-io+  other-modules:+      SignalTester+  default-language: Haskell2010++benchmark ramus-benchmarks+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      benchmark+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base == 4.*+    , ramus+    , criterion+  default-language: Haskell2010

@@ -0,0 +1,75 @@+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# http://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-7.14
+compiler: ghcjs-0.2.1.9007014_ghc-8.0.1
+compiler-check: match-exact
+
+setup-info: 
+  ghcjs: 
+    source: 
+      ghcjs-0.2.1.9007014_ghc-8.0.1: 
+         url: http://ghcjs.tolysz.org/ghc-8.0-2016-12-25-lts-7.14-9007014.tar.gz
+         sha1: 0d2ebe0931b29adca7cb9d9b9f77d60095bfb864
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- '.'
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.3"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

@@ -0,0 +1,198 @@+{-# LANGUAGE TypeOperators #-}
+
+import Prelude hiding (filter)
+
+import Test.Hspec
+import Test.QuickCheck
+import Test.QuickCheck.Function
+import Test.QuickCheck.IO ()
+import Data.Semigroup
+import Data.Maybe
+import Ramus.Signal
+import Ramus.Channel as Channel
+import Ramus.Time
+import SignalTester
+
+type A = Int
+type B = Int
+type C = Int
+type (~>) a b = Fun a b
+
+main :: IO ()
+main = hspec $ parallel $ do
+
+    describe "The Signal tester" $ 
+        it "can check if a Signal contains the values or not" $
+            constant "Foo" `shouldYield` ["Foo"] 
+
+    describe "A Signal" $ do
+
+        it "can contain an IO action, and is able to run it after" $
+            runSignal $ constant (return ())
+
+        it "is a functor, it satisfies the identity law" $ 
+            property functorIdentity
+
+        it "is a functor, it satisfies the composition law" $ 
+            property functorComposition
+
+        it "is an applicative, it satisifies the identity law" $ 
+            property applicativeIdentity
+
+        it "is an applicative, it satisifies the homomorphism law" $ 
+            property applicativeHomomorphism
+
+        it "is an applicative, it satisifies the composition law" $ 
+            property applicativeComposition
+
+        it "is an applicative, it satisifies the interchange law" $ 
+            property applicativeInterchange
+
+        it "is able to merge with another signal, yielding in order" $
+            property semigroupMerge
+    
+        it "is able to merge with multiple signals, yielding in order" $
+            property semigroupMergeMany
+
+        it "is able to map a function over each value that will be yielded" $
+            property mapFunctionsProperty
+
+        it "is able to drop repeated values in a sequence" $
+            property dropRepeatsProperty
+        
+        it "can reduce values with foldp" $
+            foldp (+) 0 (tick 1 1 [1, 2, 3, 4, 5])
+            `shouldYield` [1, 3, 6, 10, 15]
+
+        it "is able to filter out values with filter" $
+            filter (< 5) 0 (tick 1 1 [5, 3, 8, 4])
+            `shouldYield` [0, 3, 4]
+
+        it "is able to filter Maybe values with filterMap" $
+            filterMap (\n -> if n < 5 then Just n else Nothing)
+                 0 (tick 1 1 [5, 3, 8, 4]) 
+                 `shouldYield` [0, 3, 4]
+
+        {- Leaves the first value off always}
+        it "is able to flatten the values" $
+            flatten (tick 1 1 [[1, 2], [3, 4], [], [5, 6, 7]]) 0
+            `shouldYield` [1, 2, 3, 4, 5, 6, 7]
+        -}
+
+        it "is able to sum values with foldp" $
+            foldp (+) 0 (tick 1 1 [1, 2, 3, 4, 5])
+            `shouldYield` [1, 3, 6, 10, 15]
+
+        it "can be delayed, but yields the same results" $
+            delay 40.0 (tick 1 1 [1, 2, 3, 4, 5])
+            `shouldYield` [1, 2, 3, 4, 5]
+
+        it "yields true only once for multiple yields with since" $
+            since 10.0 (tick 1 1 [1, 2, 3])
+            `shouldYield` [False, True, False]
+
+
+    describe "A Channel" $ do
+
+        it "'s subscriptions yield when we send to it" $ do
+            chan <- Channel.channel 1
+            runSignal $ tick 1 1 [2, 3, 4] ~> Channel.send chan
+            Channel.subscribe chan `shouldYield` [2, 3, 4]
+
+
+functorIdentity :: A
+                -> IO ()
+functorIdentity x = 
+    (id <$> constant x)
+    `shouldYield` [x]
+
+
+functorComposition :: A ~> B
+                   -> B ~> C
+                   -> A
+                   -> IO ()
+functorComposition _F _G x = 
+    (f <$> g <$> constant x)
+    `shouldYield` [f (g x)]
+  where 
+    f = apply _F
+    g = apply _G
+
+
+applicativeIdentity :: A
+                    -> IO ()
+applicativeIdentity x =
+    (pure id <*> pure x)
+    `shouldYield` [x]
+
+
+applicativeHomomorphism :: A ~> B
+                        -> A
+                        -> IO ()
+applicativeHomomorphism _F x =
+    (pure f <*> pure x)
+    `shouldYield` [f x]
+  where f = apply _F
+
+
+applicativeComposition :: B ~> C
+                       -> A ~> B
+                       -> A
+                       -> IO ()
+applicativeComposition _F _G x =
+    (pure (.) <*> apf <*> apg <*> apx)
+    `shouldYield` [(f . g) x]
+  where
+    f = apply _F
+    g = apply _G
+    apf = pure f
+    apg = pure g
+    apx = pure x
+
+
+applicativeInterchange :: A
+                       -> A ~> B
+                       -> IO ()
+applicativeInterchange y _U = 
+    (pure ($ y) <*> apu)
+    `shouldYield` [u y]
+  where
+    u = apply _U
+    apu = pure u
+
+
+semigroupMerge :: A
+               -> A
+               -> IO ()
+semigroupMerge x y =
+    (constant x <> constant y)
+    `shouldYield` [x]
+
+
+semigroupMergeMany :: A
+                   -> [A]
+                   -> IO ()
+semigroupMergeMany x xs =
+    fromMaybe (constant 1337) (mergeMany testSignals)
+    `shouldYield` [x]
+  where
+    testSignals = constant <$> (x:xs)
+
+
+mapFunctionsProperty :: [A]
+                     -> A ~> B
+                     -> Property
+mapFunctionsProperty lst _F =
+    length lst > 1 ==> 
+    (f <$> tick 1 1 lst ) `shouldYield` (f <$> lst)
+  where
+    f = apply _F
+
+
+dropRepeatsProperty :: [A]
+                    -> Property
+dropRepeatsProperty lst =
+    length lst > 1 ==>
+    dropRepeats (tick 1 1 duplicated) `shouldYield` lst
+  where
+    duplicated = concatMap (\ x -> [x, x]) lst

@@ -0,0 +1,58 @@+module SignalTester
+    ( shouldYield
+    , tick
+    )
+where
+
+import Ramus.Signal
+import Data.IORef
+import Control.Monad (unless)
+import System.IO.Unsafe
+import Control.Concurrent
+
+shouldYield :: (Eq a, Show a)
+              => Signal a
+              -> [a]
+              -> IO ()
+shouldYield sig vals = do
+    remaining <- newIORef vals
+    let getNext val = do
+            nextValues <- readIORef remaining
+            case nextValues of
+                (x : xs) ->
+                    if x /= val
+                        then error $ "Expected " ++ show x ++ " but got " ++ show val
+                        else case xs of
+                            [] -> return ()
+                            _ -> writeIORef remaining xs
+                [] -> error "Unexpected emptiness"
+    runSignal $ sig ~> getNext
+
+tick :: Show a
+     => Int
+     -> Int
+     -> [a]
+     -> Signal a
+tick initial interval values = unsafePerformIO $ do
+    vals <- newIORef values
+    valsShift <- shift vals
+    let out = constant valsShift
+    let pop = do
+            shifted <- shift vals
+            out `set` valsShift
+            v <- readIORef vals
+            unless (null v) (setTimeout interval pop)
+    unless (null values) (setTimeout initial pop)
+    return out
+
+shift :: Show a => IORef [a] -> IO a
+shift ref = do
+    (x:xs) <- readIORef ref
+    writeIORef ref xs
+    return x
+
+
+setTimeout :: Int -> IO () -> IO ()
+setTimeout ms action = do
+    threadDelay (ms * 1000)
+    action