module FRP.Ordrea
(
SignalGen
, Behavior, Event, Discrete
, ExternalEvent
, newExternalEvent, triggerExternalEvent
, generatorE, filterE, stepClockE, dropStepE, eventFromList
, scanE, mapAccumE, mapAccumEM
, accumE, scanAccumE, scanAccumEM
, mapMaybeE, justE, flattenE, expandE, externalE
, takeWhileE, delayE
, withPrevE, dropE, dropWhileE, takeE
, partitionEithersE, leftsE, rightsE
, joinDD, joinDE, joinDB
, start, externalB, joinB, delayB, behaviorFromList, networkToList
, networkToListGC
, scanD, changesD, preservesD, delayD
, stepperD
, eventToBehavior, behaviorToEvent, applyBE
, discreteToBehavior
, TimeFunction(..), (<@>), (<@)
, OrderingViolation (..)
) where
import Control.Applicative
import FRP.Ordrea.Base
import UnitTest
stepperD :: a -> Event a -> SignalGen (Discrete a)
stepperD initial evt = scanD initial (const <$> evt)
withPrevE :: a -> Event a -> SignalGen (Event (a, a))
withPrevE initial evt = scanE (initial, err) $ upd <$> evt
where
upd new (old, _) = (new, old)
err = error "FRP.Ordrea.withPrevE: bug: prehistoric element"
dropE :: Int -> Event a -> SignalGen (Event a)
dropE n evt = justE <$> mapAccumE n (f <$> evt)
where
f occ 0 = (0, Just occ)
f _ k = (k', Nothing)
where !k' = k 1
dropWhileE :: (a -> Bool) -> Event a -> SignalGen (Event a)
dropWhileE p evt = justE <$> mapAccumE True (f <$> evt)
where
f occ True
| p occ = (True, Nothing)
f occ _ = (False, Just occ)
takeE :: Int -> Event a -> SignalGen (Event a)
takeE n evt = do
evtWithCount <- mapAccumE n (countdown <$> evt)
fmap snd <$> takeWhileE ((>0) . fst) evtWithCount
where
countdown occ k = (k', (k', occ))
where
!k' = k 1
partitionEithersE :: Event (Either a b) -> (Event a, Event b)
partitionEithersE evt = (leftsE evt, rightsE evt)
leftsE :: Event (Either a b) -> Event a
leftsE evt = mapMaybeE f evt
where
f (Left x) = Just x
f Right{} = Nothing
rightsE :: Event (Either a b) -> Event b
rightsE evt = mapMaybeE f evt
where
f (Right x) = Just x
f Left{} = Nothing
_unitTest = runTestTT $ test
[ test_withPrevE
, test_dropE
, test_dropWhileE
, test_takeE
]
test_withPrevE = do
r <- networkToList 3 $ do
evt <- withPrevE 0 =<< eventFromList [[1,2], [], [3 :: Int]]
return $ eventToBehavior evt
r @?= [[(1,0), (2,1)], [], [(3,2)]]
test_dropE = do
r <- networkToList 3 $ do
evt <- dropE 1 =<< eventFromList [[1,2], [], [3 :: Int]]
return $ eventToBehavior evt
r @?= [[2], [], [3]]
test_dropWhileE = do
r <- networkToList 3 $ do
evt <- dropWhileE (<=2)
=<< eventFromList [[1,2], [], [3,4 :: Int]]
return $ eventToBehavior evt
r @?= [[], [], [3,4]]
test_takeE = do
r <- networkToList 3 $ do
evt <- takeE 3
=<< eventFromList [[1,2], [], [3,4 :: Int]]
return $ eventToBehavior evt
r @?= [[1,2], [], [3]]