Async.hs

{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language ExistentialQuantification #-}
{-# language ScopedTypeVariables #-}

module Eve.Internal.Async
  ( dispatchActionAsync
  , asyncActionProvider
  ) where

import Eve.Internal.Actions
import Eve.Internal.AppState
import Eve.Internal.States

import Control.Concurrent
import Control.Monad
import Control.Monad.State
import Control.Lens
import Data.Typeable

-- | Dispatch an action which is generated by some IO. Note that state of the application may have changed
-- between calling 'dispatchActionAsync' and running the resulting 'Action'
dispatchActionAsync
  :: (MonadIO m, HasStates base, Typeable m, Typeable base) => IO (AppT base m ()) -> ActionT base zoomed m ()
dispatchActionAsync asyncAction = liftApp $ do
  mQueue <- use asyncQueue
  case mQueue of
    Nothing -> return ()
    Just queue -> liftIO . void . forkIO $ asyncAction >>= writeChan queue

-- | This allows long-running IO processes to provide 'Action's to the application asyncronously.
--
-- Don't let the type signature confuse you; it's much simpler than it seems.
--
-- Let's break it down:
--
-- When you call 'asyncActionProvider' you pass it a function which accepts a @dispatch@ function as an argument
-- and then calls it with various 'Action's within the resulting 'IO'.
--
-- Note that this function calls forkIO internally, so there's no need to do that yourself.
asyncActionProvider :: (MonadIO m, HasStates base, Typeable m, Typeable base) => ((AppT base m () -> IO ()) -> IO ()) -> ActionT base zoomed m ()
asyncActionProvider provider = liftApp $ do
  mQueue <- use asyncQueue
  case mQueue of
    Nothing -> return ()
    Just queue -> liftIO . void . forkIO $ provider (writeChan queue)  where