-- It uses
-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#static-pointers StaticPointers language extension> and
-- <https://hackage.haskell.org/package/distributed-closure distributed-closure> library
-- for serializing closures to run remotely.
-- <https://ocharles.org.uk/blog/guest-posts/2014-12-23-static-pointers.html This blog post>
-- is a good introduction for those.

-- In short, if you you need a @'Closure' a@:

--     * If @a@ is statically known (eg. a top level value, or if it does not
--   depend on anything on the scope), use @static@ keyword coming from
--   @StaticPointers@ extension.

--     * If @a@ is a runtime value, use 'cpure' to lift it to @Closure a@. It will ask
--   for a @('Closure' ('Dict' ('Serializable' a)))@. If there is @('Binary' a)@ and
--   @('Typeable' a)@ instances, you can just use @(static 'Dict')@ for that.

-- One important constraint when using this library is that it assumes the remote
-- environment is capable of executing the exact same binary. On most cases, this
-- requires your host environment to be Linux. In future I plan to provide a set
-- of scripts using Docker to overcome this limitation.

-- |
-- This module provides a common interface for offloading an IO action to remote executors.
module Control.Distributed.Fork
  ( fork,
    initDistributedFork,
    Backend,

    -- * Handle
    Handle,
    await,

    -- * ExecutorStatus
    pollHandle,
    ExecutorStatus (..),
    ExecutorPendingStatus (..),
    ExecutorFinalStatus (..),

    -- * Exceptions
    ExecutorFailedException (..),

    -- * Re-exports
    Serializable,
    Closure,
    cap,
    cpure,
    Dict (Dict),
  )
where

import Control.Distributed.Closure
import Control.Distributed.Fork.Internal
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Text (Text)

-- |
-- Asynchronously executes the given function using the 'Backend' and returns
-- an 'Handle'.

-- @
-- {-\# LANGUAGE StaticPointers #-}

-- import Control.Distributed.Fork
-- import Control.Distributed.Fork.Local

-- main :: IO ()
-- main = do
--   'initDistributedFork'
--   handle <- 'fork' 'Control.Distributed.Fork.Local.localProcessBackend' (static 'Dict') (static (return "Hello World!"))
--   await handle >>= putStrLn
-- @
fork ::
  MonadIO m =>
  Backend ->
  Closure (Dict (Serializable a)) ->
  Closure (IO a) ->
  m (Handle a)
fork :: Backend
-> Closure (Dict (Serializable a))
-> Closure (IO a)
-> m (Handle a)
fork Backend
b Closure (Dict (Serializable a))
d Closure (IO a)
c = IO (Handle a) -> m (Handle a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Handle a) -> m (Handle a)) -> IO (Handle a) -> m (Handle a)
forall a b. (a -> b) -> a -> b
$ Closure (Dict (Serializable a))
-> Closure (IO a) -> Backend -> IO (Handle a)
forall i.
Closure (Dict (Serializable i))
-> Closure (IO i) -> Backend -> IO (Handle i)
runBackend Closure (Dict (Serializable a))
d Closure (IO a)
c Backend
b

-- |
-- Blocks until the 'Handle' completes.

-- Can throw 'ExecutorFailedException'.
await :: (MonadIO m, MonadThrow m) => Handle a -> m a
await :: Handle a -> m a
await = IO (Either Text a) -> m (Either Text a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text a) -> m (Either Text a))
-> (Handle a -> IO (Either Text a))
-> Handle a
-> m (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle a -> IO (Either Text a)
forall a. Handle a -> IO (Either Text a)
tryAwait (Handle a -> m (Either Text a))
-> (Either Text a -> m a) -> Handle a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> m a) -> (a -> m a) -> Either Text a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ExecutorFailedException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ExecutorFailedException -> m a)
-> (Text -> ExecutorFailedException) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ExecutorFailedException
ExecutorFailedException) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

newtype ExecutorFailedException = ExecutorFailedException Text
  deriving (Int -> ExecutorFailedException -> ShowS
[ExecutorFailedException] -> ShowS
ExecutorFailedException -> String
(Int -> ExecutorFailedException -> ShowS)
-> (ExecutorFailedException -> String)
-> ([ExecutorFailedException] -> ShowS)
-> Show ExecutorFailedException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutorFailedException] -> ShowS
$cshowList :: [ExecutorFailedException] -> ShowS
show :: ExecutorFailedException -> String
$cshow :: ExecutorFailedException -> String
showsPrec :: Int -> ExecutorFailedException -> ShowS
$cshowsPrec :: Int -> ExecutorFailedException -> ShowS
Show, ExecutorFailedException -> ExecutorFailedException -> Bool
(ExecutorFailedException -> ExecutorFailedException -> Bool)
-> (ExecutorFailedException -> ExecutorFailedException -> Bool)
-> Eq ExecutorFailedException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutorFailedException -> ExecutorFailedException -> Bool
$c/= :: ExecutorFailedException -> ExecutorFailedException -> Bool
== :: ExecutorFailedException -> ExecutorFailedException -> Bool
$c== :: ExecutorFailedException -> ExecutorFailedException -> Bool
Eq)

instance Exception ExecutorFailedException