module Reactive.Bacon.Property(changesP,
mapP,
combineP,
combineWithP,
combineWithLatestOfP,
constantP,
fromEventSource,
fromEventSourceWithStartValue,
newPushProperty)
where
import Reactive.Bacon.Core
import Reactive.Bacon.EventStream
import Reactive.Bacon.PushStream
import Control.Applicative
import Data.IORef
instance Functor Property where
fmap = mapP
instance Applicative Property where
(<*>) = applyP
pure = constantP
instance Show a => Show (Property a) where
show = const "Property"
instance Eq a => Eq (Property a) where
(==) = \x y -> False
instance (Show a, Eq a, Num a) => Num (Property a) where
(+) xs ys = (+) <$> xs <*> ys
(*) xs ys = (*) <$> xs <*> ys
abs = fmap abs
signum = fmap signum
fromInteger = pure . fromInteger
instance Observable Property where
(==>) p f = changesP p >>=! f
changesP :: PropertySource s => s a -> IO (EventStream a)
changesP s = wrap $EventStream $ addListener (toProperty s)
where addListener (Property addL) sink = addL $ propertySink sink
propertySink sink (Initial _) = return More
propertySink sink (Update x) = sink (Next x)
propertySink sink (EndUpdate) = sink End
fromEventSourceWithStartValue :: EventSource s => Maybe a -> s a -> IO (Property a)
fromEventSourceWithStartValue start src = do
currentRef <- newIORef start
return $Property (addListener' currentRef)
where addListener' currentRef sink = do
result <- pushCurrent currentRef sink
case result of
NoMore -> return $ return ()
More -> subscribe (obs src) (toEventSink $ sink)
pushCurrent currentRef sink = do
current <- readIORef currentRef
case current of
Just x -> sink (Initial x)
Nothing -> return $ More
toEventSink propertySink End = propertySink EndUpdate
toEventSink propertySink (Next x) = propertySink (Update x)
fromEventSource :: EventSource s => s a -> IO (Property a)
fromEventSource = fromEventSourceWithStartValue Nothing
filterP :: PropertySource s => (a -> Bool) -> s a -> Property a
filterP f = mapFilterP filter'
where filter' x |f x = Just x
| otherwise = Nothing
mapP :: PropertySource s => (a -> b) -> s a -> Property b
mapP f = mapFilterP (Just . f)
mapFilterP :: PropertySource s => (a -> Maybe b) -> s a -> Property b
mapFilterP f src = Property $ addListener' (toProperty src)
where addListener' (Property addL) sink = addL $ mapSink sink
mapSink sink EndUpdate = sink EndUpdate
mapSink sink (Initial x) = send sink Initial $ f x
mapSink sink (Update x) = send sink Update $ f x
send sink constructor Nothing = return More
send sink constructor (Just x) = sink (constructor x)
combineRaw :: PropertySource s1 => PropertySource s2 => s1 a -> s2 b -> Property (Either (a, Maybe b) (b, Maybe a))
combineRaw x y = Property addL
where addL sink = do
curX <- newIORef Nothing
curY <- newIORef Nothing
sinkRef <- newIORef sink
endCount <- newIORef 0
disposeX <- addPropertyListener (toProperty x) $ combineWith Left curX curY endCount sinkRef
disposeY <- addPropertyListener (toProperty y) $ combineWith Right curY curX endCount sinkRef
return (disposeX >> disposeY)
combineWith f this other endCountRef sinkRef EndUpdate = do
endCount <- readIORef endCountRef
case endCount of
0 -> writeIORef endCountRef 1 >> return NoMore
_ -> readIORef sinkRef >>= \sink -> sink EndUpdate >> return NoMore
combineWith f this other endCount sinkRef (Initial x) =
combineWith' f this other endCount sinkRef Update x
combineWith f this other endCount sinkRef (Update x) =
combineWith' f this other endCount sinkRef Update x
combineWith' f this other endCount sinkRef constructor x = do
writeIORef this $ Just x
otherVal <- readIORef other
sink <- readIORef sinkRef
result <- sink $ constructor $ f (x, otherVal)
case result of
NoMore -> writeIORef sinkRef nullSink >> return NoMore
More -> return More
nullSink _ = return NoMore
combineWithP :: PropertySource s1 => PropertySource s2 => (a -> b -> c) -> s1 a -> s2 b -> Property c
combineWithP f xs ys = mapFilterP mapP' $ combineRaw xs ys
where mapP' (Left (x, Just y)) = Just $f x y
mapP' (Right (y, Just x)) = Just $ f x y
mapP' _ = Nothing
combineP :: PropertySource s1 => PropertySource s2 => s1 a -> s2 b -> Property (a, b)
combineP = combineWithP (,)
combineWithLatestOfP :: PropertySource s1 => PropertySource s2 => (a -> b -> c) -> s1 a -> s2 b -> Property c
combineWithLatestOfP f xs ys = mapFilterP mapP' $ combineRaw ys xs
where mapP' (Right (x, Just y)) = Just $ f x y
mapP' _ = Nothing
applyP :: PropertySource s1 => PropertySource s2 => s1 (a -> b) -> s2 a -> Property b
applyP = combineWithP ($)
constantP :: a -> Property a
constantP value = Property $ \sink -> sink (Initial value) >> return (return ())
newPushProperty :: IO (Property a, (a -> IO ()))
newPushProperty = do (stream, pushEvent) <- newPushStream
property <- fromEventSource stream
return (property, pushEvent . Next)