ramus 0.1.0 → 0.1.1

raw patch · 9 files changed

+91/−45 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• library/Ramus/Channel.hs +1/−0
• library/Ramus/DOM.hs +2/−6
• library/Ramus/Internal.hs +38/−0
• library/Ramus/Signal.hs +44/−37
• library/Ramus/Time.hs +1/−0
• package.yaml +1/−1
• ramus.cabal +2/−1
• test-suite/Main.hs +1/−0
• test-suite/SignalTester.hs +1/−0

@@ -1,6 +1,7 @@ module Ramus.Channel where
 
 import Ramus.Signal
+import Ramus.Internal
 
 newtype Channel a = Channel (Signal a)
 

@@ -1,4 +1,4 @@-module Ramus.DOM where
+module Ramus.DOM () where
 
 import Ramus.Signal
 import Ramus.Time
@@ -42,11 +42,7 @@ -- |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
+tap = undefined
 
 -- |A signal containing the current mouse position.
 mousePos :: IO (Signal CoordinatePair)

@@ -0,0 +1,38 @@+module Ramus.Internal where
+
+import Data.IORef
+import System.IO.Unsafe
+import Control.Monad
+import Data.Monoid
+
+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
+    }

@@ -1,7 +1,23 @@-module Ramus.Signal where
+module Ramus.Signal 
+  ( Signal ()
+  , constant
+  , merge
+  , mergeMany
+  , foldp
+  , sampleOn
+  , dropRepeats
+  , runSignal
+  -- , unwrap
+  , filter
+  , filterMap
+  -- , flatten
+  -- , flattenArray
+  , 
+  ) where
 
 import Prelude hiding (filter)
 
+import Ramus.Internal
 import Control.Applicative ()
 import Control.Monad (unless, when)
 import Data.Functor ()
@@ -11,42 +27,7 @@ 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
@@ -162,9 +143,23 @@ -}
 
 infixl 4 ~>
+-- | Flipped map operator
 (~>) :: Signal a -> (a -> b) -> Signal b
-sig ~> f = fmap f sig
+(~>) = flip fmap 
 
+infixl 4 <~
+-- | map operator
+(<~) :: (a -> b) -> Signal a -> Signal b
+(<~) = fmap
+
+infixl 4 ~~
+-- | Signal application.
+-- | Note that it is a double tilde, differing from 
+-- | purescript-signal, as a single tilde is used
+-- | in Haskell for lazy evaluation.
+(~~) :: Signal (a -> b) -> Signal a -> Signal b
+(~~) = (<*>)
+
 instance Functor Signal where
   fmap fun sig = unsafePerformIO $ do
     let out = make $ fun $ get sig
@@ -183,3 +178,15 @@ 
 instance Semigroup (Signal a) where
   (<>) = merge
+
+map2 :: (a -> b -> c) -> Signal a -> Signal b -> Signal c
+map2 f a b = f <~ a ~~ b
+
+map3 :: (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d
+map3 f a b c = f <~ a ~~ b ~~ c
+
+map4 :: (a -> b -> c -> d -> e) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e
+map4 f a b c d = f <~ a ~~ b ~~ c ~~ d
+
+map5 :: (a -> b -> c -> d -> e -> f) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f
+map5 f a b c d e = f <~ a ~~ b ~~ c ~~ d ~~ e

@@ -2,6 +2,7 @@ 
 import Prelude hiding (filter)
 import Ramus.Signal
+import Ramus.Internal
 import Control.Concurrent
 import Data.IORef
 import System.IO.Unsafe

@@ -45,4 +45,4 @@     - -with-rtsopts=-N
     main: Main.hs
     source-dirs: test-suite
-version: '0.1.0'
+version: '0.1.1'

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           ramus-version:        0.1.0+version:        0.1.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@@ -33,6 +33,7 @@   exposed-modules:       Ramus.Channel       Ramus.DOM+      Ramus.Internal       Ramus.Signal       Ramus.Time   default-language: Haskell2010

@@ -11,6 +11,7 @@ import Ramus.Signal
 import Ramus.Channel as Channel
 import Ramus.Time
+import Ramus.Internal
 import SignalTester
 
 type A = Int

@@ -5,6 +5,7 @@ where
 
 import Ramus.Signal
+import Ramus.Internal
 import Data.IORef
 import Control.Monad (unless)
 import System.IO.Unsafe