diff --git a/sodium.cabal b/sodium.cabal --- a/sodium.cabal +++ b/sodium.cabal @@ -1,5 +1,5 @@ name: sodium -version: 0.6 +version: 0.6.0.1 synopsis: Sodium Reactive Programming (FRP) System description: A general purpose Reactive Programming (FRP) system. This is part of a project to @@ -26,7 +26,8 @@ 0.5.0.0 Improved tests cases + add Freecell example, API tweaks; 0.5.0.1 Internal improvements; 0.5.0.2 Fix multiple memory leaks; - 0.6 Minor API changes, particular with accum. + 0.6 Minor API changes, particular with accum; + 0.6.0.1 ghc-7.8 compatibility. license: BSD3 license-file: LICENSE author: Stephen Blackheath @@ -127,6 +128,6 @@ hs-source-dirs: src exposed-modules: FRP.Sodium, FRP.Sodium.Internal, FRP.Sodium.Context other-modules: FRP.Sodium.Plain - build-depends: base >= 4.3.0.0 && < 4.7.0.0, + build-depends: base >= 4.3.0.0 && < 4.8.0.0, containers >= 0.4.0.0 && < 0.6.0.0, mtl >= 2.0.0.0 && < 2.2.0.0 diff --git a/src/FRP/Sodium.hs b/src/FRP/Sodium.hs --- a/src/FRP/Sodium.hs +++ b/src/FRP/Sodium.hs @@ -15,12 +15,12 @@ -- -- * Applicative on 'behaviour', e.g. @let bsum = (+) \<$\> ba \<*\> bb@ -- --- * Applicative 'pure' is used to give a constant 'Behavior'. +-- * Applicative 'Control.Applicative.pure' is used to give a constant 'Behavior'. -- -- * Recursive do (using the DoRec language extension) to make state loops with the @rec@ keyword. -- -- Here's an example of recursive do to write state-keeping loops. Note that --- all 'hold's are delayed, so 'attachWith' will capture the /old/ value of the state /s/. +-- all 'hold's are delayed, so 'snapshotWith' will capture the /old/ value of the state /s/. -- -- > {-# LANGUAGE DoRec #-} -- > -- | Accumulate state changes given in the input event. @@ -54,6 +54,7 @@ execute, sample, coalesce, + once, -- * Derived FRP functions mergeWith, filterE, @@ -62,8 +63,7 @@ collectE, collect, accum, - count, - once + count ) where import FRP.Sodium.Plain diff --git a/src/FRP/Sodium/Internal.hs b/src/FRP/Sodium/Internal.hs --- a/src/FRP/Sodium/Internal.hs +++ b/src/FRP/Sodium/Internal.hs @@ -3,7 +3,6 @@ module FRP.Sodium.Internal ( C.Event(..), listenTrans, - listenValueTrans, schedulePrioritized, scheduleLast, Listen(..), diff --git a/src/FRP/Sodium/Plain.hs b/src/FRP/Sodium/Plain.hs --- a/src/FRP/Sodium/Plain.hs +++ b/src/FRP/Sodium/Plain.hs @@ -47,6 +47,14 @@ evaluate a MV.putMVar mv a +-- Note: the second parameter is a dummy, make it depend +-- on the last function parameter of the caller to make +-- sure that the IORef is freshly created every time + +{-# NOINLINE unsafeNewIORef #-} +unsafeNewIORef :: a -> b -> IORef a +unsafeNewIORef v dummy = unsafePerformIO (newIORef v) + -- | Phantom type for use with 'R.Context' type class. data Plain @@ -172,7 +180,14 @@ -- | Listen for firings of this event. The returned @IO ()@ is an IO action -- that unregisters the listener. This is the observer pattern. -- --- To listen to a 'Behavior' use @listen (values b) handler@ +-- To listen to a 'Behavior' use @listen (values b) handler@ or +-- @listen (changes b) handler@ +-- +-- NOTE: The callback is called with the transaction held, so you cannot +-- use 'sync' inside a listener. You can delegate to another thread and have +-- that start the new transaction. If you want to do more processing in +-- the same transction, then you can use 'FRP.Sodium.Internal.listenTrans' +-- but this is discouraged unless you really need to write a new primitive. listen :: Event a -> (a -> IO ()) -> Reactive (IO ()) listen ev handle = listenTrans ev (ioReactive . handle) @@ -180,7 +195,7 @@ never :: Event a never = Event { getListenRaw = return $ Listen $ \_ _ _ -> return (return ()), - evCacheRef = unsafePerformIO $ newIORef Nothing + evCacheRef = unsafeNewIORef Nothing undefined } -- | Merge two streams of events of the same type. @@ -193,7 +208,7 @@ merge :: Event a -> Event a -> Event a merge ea eb = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing eb gl = do l1 <- getListen ea l2 <- getListen eb @@ -208,7 +223,7 @@ filterJust :: Event (Maybe a) -> Event a filterJust ema = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing ema gl = do (l', push, nodeRef) <- ioReactive newEventImpl l <- getListen ema @@ -256,7 +271,7 @@ snapshotWith :: (a -> b -> c) -> Event a -> Behavior b -> Event c snapshotWith f ea bb = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing bb gl = do (l, push, nodeRef) <- ioReactive newEventImpl sample' <- ioReactive $ unSample_ $ behSample $ bb @@ -273,7 +288,7 @@ switchE :: Behavior (Event a) -> Event a switchE bea = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing bea gl = do (l, push, nodeRef) <- ioReactive newEventImpl unlisten2Ref <- ioReactive $ newIORef Nothing @@ -308,7 +323,7 @@ execute :: Event (Reactive a) -> Event a execute ev = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing ev gl = do (l', push, nodeRef) <- ioReactive newEventImpl l <- getListen ev @@ -329,7 +344,7 @@ coalesce :: (a -> a -> a) -> Event a -> Event a coalesce combine e = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing e gl = do l1 <- getListen e (l, push, nodeRef) <- ioReactive newEventImpl @@ -349,7 +364,7 @@ once :: Event a -> Event a once e = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing e gl = do l1 <- getListen e (l, push, nodeRef) <- ioReactive newEventImpl @@ -665,7 +680,7 @@ instance Functor (R.Event Plain) where f `fmap` e = Event getListen' cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing e getListen' = do return $ Listen $ \mNodeRef suppressEarlierFirings handle -> do l <- getListen e @@ -782,15 +797,10 @@ ioReactive $ writeIORef aRef Nothing handle a --- | Variant of 'listenValue' that allows you to initiate more activity in the current --- transaction. Useful for implementing new primitives. -listenValueTrans :: Behavior a -> (a -> Reactive ()) -> Reactive (IO ()) -listenValueTrans ba = listenValueRaw ba Nothing False - eventify :: (Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ())) -> Event a eventify listen = Event gl cacheRef where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing listen gl = do (l, push, nodeRef) <- ioReactive newEventImpl unlistener <- unlistenize $ listen (Just nodeRef) False push @@ -800,7 +810,7 @@ pure = constant Behavior u1 s1 <*> Behavior u2 s2 = Behavior u s where - cacheRef = unsafePerformIO $ newIORef Nothing + cacheRef = unsafeNewIORef Nothing s2 u = Event gl cacheRef gl = do fRef <- ioReactive $ newIORef =<< unSample s1