{-# LANGUAGE Safe #-}
{- |
This module implements something similar to
"Control.Concurrent.PooledIO.InOrder",
but since it is restricted to an 'Applicative' interface
we can implement it without 'unsafeInterleaveIO'.
-}
module Control.Concurrent.PooledIO.Final (
   T, run, runLimited, fork,
   ) where

import qualified Control.Concurrent.PooledIO.Monad as Pool
import Control.DeepSeq (NFData)

import Control.Monad (join)
import Control.Applicative (Applicative, pure, (<*>))
import Data.Functor.Compose (Compose(Compose))


newtype T a = Cons (Compose Pool.T IO a)

instance Functor T where
   fmap :: forall a b. (a -> b) -> T a -> T b
fmap a -> b
f (Cons Compose T IO a
m) = forall a. Compose T IO a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Compose T IO a
m

instance Applicative T where
   pure :: forall a. a -> T a
pure = forall a. Compose T IO a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Cons Compose T IO (a -> b)
f <*> :: forall a b. T (a -> b) -> T a -> T b
<*> Cons Compose T IO a
a = forall a. Compose T IO a -> T a
Cons forall a b. (a -> b) -> a -> b
$ Compose T IO (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Compose T IO a
a


{- |
This runs an action parallelly to the starting thread.
Since it is an Applicative Functor and not a Monad,
there are no data dependencies between the actions
and thus all actions in a 'T' can be run parallelly.
Only the 'IO' actions are parallelised
but not the combining function passed to 'liftA2' et.al.
That is, the main work must be done in the 'IO' actions
in order to benefit from parallelisation.
-}
fork :: (NFData a) => IO a -> T a
fork :: forall a. NFData a => IO a -> T a
fork = forall a. Compose T IO a -> T a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => IO a -> T (IO a)
Pool.fork

{- |
'runLimited' with a maximum of @numCapabilites@ threads.
-}
run :: T a -> IO a
run :: forall a. T a -> IO a
run = forall a b. (Int -> a -> IO b) -> a -> IO b
Pool.withNumCapabilities forall a. Int -> T a -> IO a
runLimited

{- |
@runLimited n@ runs several actions in a pool with at most @n@ threads.
-}
runLimited :: Int -> T a -> IO a
runLimited :: forall a. Int -> T a -> IO a
runLimited Int
maxThreads (Cons (Compose T (IO a)
m)) =
   forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a. Int -> T a -> IO a
Pool.runLimited Int
maxThreads T (IO a)
m