module FRP.NetWire.IO
(
execute,
executeEvery,
executeOnce
)
where
import Control.Exception.Control
import Control.Monad
import Control.Monad.IO.Control
import FRP.NetWire.Tools
import FRP.NetWire.Wire
execute :: MonadControlIO m => Wire m (m a) a
execute =
mkGen $ \_ c -> liftM (, execute) (try c)
executeEvery :: forall a m. MonadControlIO m => Wire m (Time, m a) a
executeEvery = executeEvery' True 0 (Left (inhibitEx "No result yet."))
where
executeEvery' :: Bool -> Time -> Output a -> Wire m (Time, m 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 _ -> return (mx', executeEvery' False nextT mx')
Right _ -> return (mx, executeEvery' False nextT mx)
else return (mx', executeEvery' False t mx')
executeOnce :: MonadControlIO m => Wire m (m a) a
executeOnce =
mkGen $ \_ c -> do
mx <- try c
return (mx, either (const executeOnce) constant mx)