Simple implementation of parallel IO execution using Applicative

ApplicativeParallelIO.hs

{- | Parallel computation of IO using applicative style

Convert and IO to a Future using *Future*.

You can then use applicative style to combine functions over IO and get a result using 'runFuture'.

Have a look at '<$.>' and '<*.>' for shortcut to avoid wrapping your io with 'Future'.

Exemple:

> import Control.Concurrent (threadDelay)
> 
> fa :: IO String
> fa = do
>     threadDelay 2000000
>     return "hello"
> 
> fb :: IO Int
> fb = do
>     threadDelay 2000000
>     return 3
> 
> fc :: String -> Int -> String
> fc s i = replicate i s
> 
> -- | Compute fa and fb in parallel and apply fc
> fd :: IO String
> fd = runFuture $ fc <$.> fa <*.> fb
> 
> -- fd evaluate to "hellohellohello"
> 
> fe :: IO Int
> fe = runFuture $ length <$.> fa
> 
> -- fe evaluate to 5
-}

module ApplicativeParallelIO (
  Future(..),
  (<$.>),
  (<*.>)
  ) where

import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)

-- | Wrapper around IO
data Future a = Future {runFuture :: (IO a)}

instance Functor Future where
  fmap f (Future v) = Future $ do
    var <- newEmptyMVar
    _ <- forkIO $ do
      val <- v
      putMVar var (f val)
  
    takeMVar var

instance Applicative Future where
  pure v = Future $ return v

  (<*>) (Future f) (Future a) = Future $ do
    varf <- newEmptyMVar
    vara <- newEmptyMVar
    _ <- forkIO $ putMVar varf =<< f
    _ <- forkIO $ putMVar vara =<< a

    resf <- takeMVar varf
    resa <- takeMVar vara

    return $ (resf resa)

-- | Short for @f '<$>' Future@ io
(<$.>) :: (a -> b) -> IO a -> Future b
(<$.>) f io = f <$> Future io

-- | Short for @a '<*>' Future io@
(<*.>) :: Future (a -> b) -> IO a -> Future b
(<*.>) a io = a <*> Future io