sodium 0.9.0.0 → 0.10.0.0
raw patch · 14 files changed
+64/−66 lines, 14 files
Files
- examples/games/freecell.hs +7/−7
- examples/games/poodle.hs +2/−2
- examples/tests/memory-test-1.hs +1/−1
- examples/tests/memory-test-2.hs +1/−1
- examples/tests/memory-test-6.hs +1/−1
- examples/tests/memory-test-6a.hs +1/−1
- examples/tests/memory-test-7.hs +1/−1
- examples/tests/memory-test-8.hs +2/−2
- examples/tests/memory-test-8a.hs +1/−1
- examples/tests/unit-tests.hs +5/−17
- sodium.cabal +4/−2
- src/FRP/Sodium.hs +12/−6
- src/FRP/Sodium/Context.hs +10/−13
- src/FRP/Sodium/Plain.hs +16/−11
examples/games/freecell.hs view
@@ -125,8 +125,8 @@ positions = iterate (\(x, y) -> (x, y-overlapY)) orig rec cards <- hold initCards (eRemoveCards `merge` eAddCards)- let eAddCards = snapshotWith (\newCards cards -> cards ++ newCards) eDrop cards- eMouseSelection = filterJust $ snapshotWith (\mev cards ->+ let eAddCards = snapshot (\newCards cards -> cards ++ newCards) eDrop cards+ eMouseSelection = filterJust $ snapshot (\mev cards -> case mev of MouseDown pt@(x, y) | x >= origX - cardWidth && x <= origX + cardWidth -> let n = length cards@@ -165,7 +165,7 @@ rect = (orig, cardSize) rec mCard <- hold Nothing $ eRemove `merge` (Just . head <$> eDrop)- let eMouseSelection = filterJust $ snapshotWith (\mev mCard ->+ let eMouseSelection = filterJust $ snapshot (\mev mCard -> case (mev, mCard) of (MouseDown pt, Just card) | pt `inside` rect -> Just (Nothing, Bunch (fst rect) pt [card] loc)@@ -192,13 +192,13 @@ (cardWidth, cardHeight) = cardSize wholeRect = (((xOf 0 + xOf 3) * 0.5, topRow), ((cardSpacingNarrow * 3 + cardWidth*2) * 0.5, cardHeight)) rec- let eDropModify = snapshotWith (\newCards slots ->+ let eDropModify = snapshot (\newCards slots -> let newCard@(Card _ suit) = head newCards ix = fromEnum suit in take ix slots ++ [Just newCard] ++ drop (ix+1) slots ) eDrop slots slots <- hold [Nothing, Nothing, Nothing, Nothing] (eDropModify `merge` eRemove)- let eMouseSelection = filterJust $ snapshotWith (\mev slots ->+ let eMouseSelection = filterJust $ snapshot (\mev slots -> case mev of MouseDown pt -> let isIn = map (pt `inside`) areas@@ -249,7 +249,7 @@ MouseDown pt -> pt rec dragging <- hold Nothing $ (const Nothing <$> eDrop) `merge` (Just <$> eStartDrag)- let eDrop = filterJust $ snapshotWith (\mev mDragging ->+ let eDrop = filterJust $ snapshot (\mev mDragging -> case (mev, mDragging) of -- If the mouse is released, and we are dragging... (MouseUp pt, Just dragging) -> Just (cardPos pt dragging, dragging)@@ -269,7 +269,7 @@ -- | Determine where dropped cards are routed to. dropper :: Event (Point, Bunch) -> Behavior [Destination] -> Event (Location, [Card]) dropper eDrop dests =- snapshotWith (\(pt, bunch) dests ->+ snapshot (\(pt, bunch) dests -> -- If none of the destinations will accept the dropped cards, then send them -- back where they originated from. let findDest [] = (buOrigin bunch, buCards bunch)
examples/games/poodle.hs view
@@ -44,7 +44,7 @@ tLast <- hold 0 eAppear interval <- peelList eAppear intervals let eTime = value time- eAppear = filterJust $ snapshotWith (\t (tLast, interval) ->+ eAppear = filterJust $ snapshot (\t (tLast, interval) -> if t >= tLast + interval then Just t else Nothing ) eTime ((,) <$> tLast <*> interval) return eAppear@@ -78,7 +78,7 @@ rec -- Destroy poodles that are clicked on- let eDestructions = filterJust $ snapshotWith (\mev poodles ->+ let eDestructions = filterJust $ snapshot (\mev poodles -> case mev of MouseDown clickPos -> listToMaybe [ Destroy iD | (iD, (rect, _)) <- poodles,
examples/tests/memory-test-1.hs view
@@ -11,7 +11,7 @@ t <- sync $ hold 0 et let etens = (`div` 10) <$> et tens <- sync $ hold 0 etens- let changeTens = filterJust $ snapshotWith (\new old ->+ let changeTens = filterJust $ snapshot (\new old -> if new /= old then Just new else Nothing) etens tens
examples/tests/memory-test-2.hs view
@@ -14,7 +14,7 @@ t <- sync $ hold 0 et let etens = (`div` 10) <$> et tens <- sync $ hold 0 etens- let changeTens = filterJust $ snapshotWith (\new old ->+ let changeTens = filterJust $ snapshot (\new old -> if new /= old then Just new else Nothing) etens tens
examples/tests/memory-test-6.hs view
@@ -11,7 +11,7 @@ flam :: Event () -> Reactive (Behavior Bool) flam e = do rec- let eToggle = snapshotWith (\() selected -> not selected) e selected+ let eToggle = snapshot (\() selected -> not selected) e selected selected <- hold False eToggle return selected
examples/tests/memory-test-6a.hs view
@@ -11,7 +11,7 @@ flam :: Event () -> Reactive (Event Bool) flam e = do rec- let eToggle = snapshotWith (\() selected -> not selected) e selected+ let eToggle = snapshot (\() selected -> not selected) e selected selected <- hold False eToggle return eToggle
examples/tests/memory-test-7.hs view
@@ -12,7 +12,7 @@ flam :: Event () -> Behavior Int -> Reactive (Behavior Int) flam e time = do- let eStart = snapshot e time+ let eStart = snapshot (flip const) e time -- Only allow eStart through when we're not already running hold 0 eStart
examples/tests/memory-test-8.hs view
@@ -27,14 +27,14 @@ -- -- ...get cleaned up when 'flam' is switched out. The issue is the -- GATE/HOLD cycle at the bottom left. - let eStart = snapshotWith (\() t -> Just t) e time+ let eStart = snapshot (\() t -> Just t) e time rec let notRunning = fmap (not . isJust) mRunning -- Only allow eStart through when we're not already running mRunning <- hold Nothing $ merge (eStart `gate` notRunning) eStop -- Stop it when it's been running for 5 ticks.- let eStop = filterJust $ snapshotWith (\t mRunning ->+ let eStop = filterJust $ snapshot (\t mRunning -> case mRunning of Just t0 | (t - t0) >= 5 -> Just Nothing _ -> Nothing
examples/tests/memory-test-8a.hs view
@@ -23,7 +23,7 @@ -- -- ...get cleaned up when 'flam' is switched out. The issue is the -- GATE/HOLD cycle at the bottom left. - let eStart = snapshotWith (\() t -> Just t) e time+ let eStart = snapshot (\() t -> Just t) e time rec -- Only allow eStart through when we're not already running mRunning <- hold Nothing $ eStart `gate` notRunning
examples/tests/unit-tests.hs view
@@ -204,7 +204,7 @@ (bi, pushi) <- sync $ newBehavior (9 :: Int) (bc, pushc) <- sync $ newBehavior 'a' outRef <- newIORef []- unlisten <- sync $ listen (flip snapshot bc . value $ bi) $ \a -> modifyIORef outRef (++ [a])+ unlisten <- sync $ listen (flip (snapshot (flip const)) bc . value $ bi) $ \a -> modifyIORef outRef (++ [a]) sync $ pushc 'b' sync $ pushi 2 sync $ pushc 'c'@@ -216,7 +216,7 @@ (bi, pushi) <- sync $ newBehavior (9 :: Int) (bc, pushc) <- sync $ newBehavior 'a' outRef <- newIORef []- unlisten <- sync $ listen (flip snapshot bc . doubleUp . value $ bi) $ \a -> modifyIORef outRef (++ [a])+ unlisten <- sync $ listen (flip (snapshot (flip const)) bc . doubleUp . value $ bi) $ \a -> modifyIORef outRef (++ [a]) sync $ pushc 'b' sync $ pushi 2 sync $ pushc 'c'@@ -300,7 +300,7 @@ (ea, pusha) <- sync newEvent (eb, pushb) <- sync newEvent bb <- sync $ hold 0 eb- let ec = snapshotWith (,) ea bb+ let ec = snapshot (,) ea bb outRef <- newIORef [] unlisten <- sync $ listen ec $ \c -> modifyIORef outRef (++ [c]) sync $ pusha 'A'@@ -314,7 +314,7 @@ holdIsDelayed = TestCase $ do (e, push) <- sync newEvent h <- sync $ hold (0 :: Int) e- let pair = snapshotWith (\a b -> show a ++ " " ++ show b) e h+ let pair = snapshot (\a b -> show a ++ " " ++ show b) e h outRef <- newIORef [] unlisten <- sync $ listen pair $ \a -> modifyIORef outRef (++ [a]) sync $ push 2@@ -322,18 +322,6 @@ unlisten assertEqual "holdIsDelayed" ["2 0", "3 2"] =<< readIORef outRef -count1 = TestCase $ do- (ea, push) <- sync newEvent- outRef <- newIORef []- unlisten <- sync $ do- count <- count ea- listen (updates count) $ \c -> modifyIORef outRef (++ [c])- sync $ push ()- sync $ push ()- sync $ push ()- unlisten- assertEqual "count1" [1,2,3] =<< readIORef outRef- collect1 = TestCase $ do (ea, push) <- sync newEvent outRef <- newIORef []@@ -554,7 +542,7 @@ behConstant, valueThenMap, valueTwiceThenMap, valueThenCoalesce, valueTwiceThenCoalesce, valueThenSnapshot, valueTwiceThenSnapshot, valueThenMerge, valueThenFilter, valueTwiceThenFilter, valueThenOnce, valueTwiceThenOnce, valueLateListen,- holdIsDelayed, appl1, snapshot1, count1, collect1, collect2, collectE1, collectE2, switchE1,+ holdIsDelayed, appl1, snapshot1, collect1, collect2, collectE1, collectE2, switchE1, switch1, once1, once2, cycle1, split1, split2 {-, mergeWith1, mergeWith2, mergeWith3, coalesce1-} ]
sodium.cabal view
@@ -1,5 +1,5 @@ name: sodium-version: 0.9.0.0+version: 0.10.0.0 synopsis: Sodium Reactive Programming (FRP) System description: A general purpose Reactive Programming (FRP) system. This is part of a project to@@ -44,7 +44,9 @@ . * 0.8.0.0 - Add executeIO primitive. .- * 0.9.0.0 - Rename changes() to updates(). Rename values() to value().+ * 0.9.0.0 - Rename changes to updates. Rename values to value.+ .+ * 0.9.1.0 - Add Monoid instance to Event - thanks Finlay Thompson. license: BSD3 license-file: LICENSE
src/FRP/Sodium.hs view
@@ -17,17 +17,21 @@ -- -- * Applicative 'Control.Applicative.pure' is used to give a constant 'Behavior'. --+-- * A Monoid instance on 'Event' where 'mempty' = 'never' and 'mappend' = 'merge'+-- -- * Recursive do (using the DoRec language extension) to make state loops with the @rec@ keyword. --+-- * Data.Traversable.'sequenceA' is useful to convert /[Behavior a]/ into /Behavior [a]/.+-- -- Here's an example of recursive do to write state-keeping loops. Note that--- all 'hold's are delayed, so 'snapshotWith' will capture the /old/ value of the state /s/.+-- all 'hold's are delayed, so 'snapshot' will capture the /old/ value of the state /s/. -- -- > {-# LANGUAGE DoRec #-} -- > -- | Accumulate state changes given in the input event. -- > accum :: Context r => a -> Event r (a -> a) -> Reactive r (Behavior r a) -- > accum z efa = do -- > rec--- > s <- hold z $ snapshotWith ($) efa s+-- > s <- hold z $ snapshot ($) efa s -- > return s module FRP.Sodium ( Plain,@@ -48,7 +52,7 @@ hold, updates, value,- snapshotWith,+ snapshot, switchE, switch, execute,@@ -59,16 +63,18 @@ -- * Derived FRP functions mergeWith, filterE,- snapshot, gate, collectE, collect, accum,- count, -- * Deprecated changes,- values+ values,+ snapshotWith,+ count ) where +import Data.Monoid+import Data.Traversable (sequenceA) import FRP.Sodium.Plain
src/FRP/Sodium/Context.hs view
@@ -5,6 +5,7 @@ import Control.Applicative import Control.Monad import Control.Monad.Fix+import Data.Monoid class ( Applicative (Reactive r),@@ -61,7 +62,7 @@ -- | Sample the behavior at the time of the event firing. Note that the 'current value' -- of the behavior that's sampled is the value as at the start of the transaction -- before any state changes of the current transaction are applied through 'hold's.- snapshotWith :: (a -> b -> c) -> Event r a -> Behavior r b -> Event r c+ snapshot :: (a -> b -> c) -> Event r a -> Behavior r b -> Event r c -- | Unwrap an event inside a behavior to give a time-varying event implementation. switchE :: Behavior r (Event r a) -> Event r a -- | Unwrap a behavior inside another behavior to give a time-varying behavior implementation.@@ -109,6 +110,10 @@ -- Caveat: See 'executeAsyncIO'. executeSyncIO :: Event r (IO a) -> Event r a +instance Context r => Monoid (Event r a) where+ mempty = never+ mappend = merge+ -- | A time-varying value, British spelling. type Behaviour r a = Behavior r a @@ -142,15 +147,11 @@ filterE :: Context r => (a -> Bool) -> Event r a -> Event r a filterE pred = filterJust . ((\a -> if pred a then Just a else Nothing) <$>) --- | Variant of snapshotWith that throws away the event's value and captures the behavior's.-snapshot :: Context r => Event r a -> Behavior r b -> Event r b-snapshot = snapshotWith (flip const)- -- | Let event occurrences through only when the behavior's value is True. -- Note that the behavior's value is as it was at the start of the transaction, -- that is, no state changes from the current transaction are taken into account. gate :: Context r => Event r a -> Behavior r Bool -> Event r a-gate ea = filterJust . snapshotWith (\a b -> if b then Just a else Nothing) ea+gate ea = filterJust . snapshot (\a b -> if b then Just a else Nothing) ea -- | Transform an event with a generalized state loop (a mealy machine). The function -- is passed the input and the old state and returns the new state and output value.@@ -158,7 +159,7 @@ collectE f z ea = do rec s <- hold z es- let ebs = snapshotWith f ea s+ let ebs = snapshot f ea s eb = fst <$> ebs es = snd <$> ebs return eb@@ -172,16 +173,12 @@ let (zb, zs') = f za zs rec bs <- hold (zb, zs') ebs- let ebs = snapshotWith f ea (snd <$> bs)+ let ebs = snapshot f ea (snd <$> bs) return (fst <$> bs) -- | Accumulate state changes given in the input event. accum :: Context r => a -> Event r (a -> a) -> Reactive r (Behavior r a) accum z efa = do rec- s <- hold z $ snapshotWith ($) efa s+ s <- hold z $ snapshot ($) efa s return s---- | Count event occurrences, giving a behavior that starts with 0 before the first occurrence.-count :: Context r => Event r a -> Reactive r (Behavior r Int)-count = accum 0 . (const (1+) <$>)
src/FRP/Sodium/Plain.hs view
@@ -118,7 +118,7 @@ hold = hold updates = updates value = value- snapshotWith = snapshotWith+ snapshot = snapshot switchE = switchE switch = switch execute = execute@@ -276,8 +276,8 @@ -- | Sample the behavior at the time of the event firing. Note that the 'current value' -- of the behavior that's sampled is the value as at the start of the transaction -- before any state changes of the current transaction are applied through 'hold's.-snapshotWith :: (a -> b -> c) -> Event a -> Behavior b -> Event c-snapshotWith f ea bb = sample' `seq` Event gl cacheRef (dep (ea, sample))+snapshot :: (a -> b -> c) -> Event a -> Behavior b -> Event c+snapshot f ea bb = sample' `seq` Event gl cacheRef (dep (ea, sample)) where cacheRef = unsafeNewIORef Nothing bb sample = sampleImpl bb@@ -436,10 +436,6 @@ filterE :: (a -> Bool) -> Event a -> Event a filterE = R.filterE --- | Variant of 'snapshotWith' that throws away the event's value and captures the behavior's.-snapshot :: Event a -> Behavior b -> Event b-snapshot = R.snapshot- -- | Let event occurrences through only when the behavior's value is True. -- Note that the behavior's value is as it was at the start of the transaction, -- that is, no state changes from the current transaction are taken into account.@@ -460,10 +456,6 @@ accum :: a -> Event (a -> a) -> Reactive (Behavior a) accum = R.accum --- | Count event occurrences, giving a behavior that starts with 0 before the first occurrence.-count :: Event a -> Reactive (Behavior Int)-count = R.count- class PriorityQueueable k where priorityOf :: k -> IO Int64 @@ -897,3 +889,16 @@ values :: Behavior a -> Event a {-# DEPRECATED values "renamed to 'value'" #-} values = value++-- | Sample the behavior at the time of the event firing. Note that the 'current value'+-- of the behavior that's sampled is the value as at the start of the transaction+-- before any state changes of the current transaction are applied through 'hold's.+snapshotWith :: (a -> b -> c) -> Event a -> Behavior b -> Event c+{-# DEPRECATED snapshotWith "renamed to 'snapshot'" #-}+snapshotWith = snapshot++-- | Count event occurrences, giving a behavior that starts with 0 before the first occurrence.+count :: Event a -> Reactive (Behavior Int)+{-# DEPRECATED count "removing it in the pursuit of minimalism, replace with: accum 0 (const (1+) <$> e)" #-}+count = accum 0 . (const (1+) <$>)+