module FRP.NetWire.IO
(
execute,
executeEvery,
executeOnce
)
where
import Control.Exception
import FRP.NetWire.Tools
import FRP.NetWire.Wire
execute :: Wire (IO a) a
execute =
mkGen $ \_ c -> do
mx <- try c
case mx of
Left (_ :: SomeException) -> return (Nothing, execute)
Right x -> return (Just x, execute)
executeEvery :: forall a. Wire (DTime, IO a) a
executeEvery = executeEvery' True 0 Nothing
where
executeEvery' :: Bool -> Time -> Maybe a -> Wire (DTime, IO a) a
executeEvery' firstRun t' mx' =
mkGen $ \(wsDTime -> dt) (int, c) ->
let t = t' + dt in
if t >= int || firstRun
then do
let nextT = fmod t int
mx <- nextT `seq` try c
case mx of
Left (_ :: SomeException) -> return (mx', executeEvery' False nextT mx')
Right x ->
let mx = Just x
in mx `seq` return (mx, executeEvery' False nextT mx)
else return (mx', executeEvery' False t mx')
executeOnce :: Wire (IO a) a
executeOnce =
mkGen $ \_ c -> do
mx <- try c
case mx of
Left (_ :: SomeException) -> return (Nothing, executeOnce)
Right x -> return (Just x, constant x)