-- |
-- Module:     FRP.NetWire.IO
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Access the rest of the universe.

module FRP.NetWire.IO
    ( -- * IO Actions
      execute,
      executeEvery,
      executeOnce
    )
    where

import Control.Exception
import FRP.NetWire.Tools
import FRP.NetWire.Wire


-- | Execute the IO action in the input signal at every instant.
--
-- Note: If the action throws an exception, then this wire inhibits the
-- signal.

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)


-- | Executes the IO action in the right input signal periodically
-- keeping its most recent result value.

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')


-- | Executes the IO action in the input signal and inhibits, until it
-- succeeds without an exception.  Keeps the result forever.

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)