-- | The parallel functions in this module all use the same underlying behaviour.  You supply a list
-- of tasks that you wish performed, either in the @IO@ monad or some other @MonadIO m => m@ monad.
-- This library starts up a limited number of threads (by default, one per capability, i.e. one per
-- available processor/core) and then executes the given work queue across the threads.  This is better
-- than simply starting all the jobs in parallel and waiting, because in the case where you have
-- thousands or millions of jobs, but only say 16 cores, you do not want the overheads of switching
-- between all those contending threads.
--
-- The default behaviour of these functions is to put useful progress reports onto stderr while
-- it is running (number of tasks completed, estimate of final completion time).
-- The library is aimed at millions of jobs taking several hours to complete; hence built-in output
-- is very useful for you, while you wait.  You can customise this behaviour by using the primed
-- version of each of these functions and supplying a customised options record.
--
-- The only difference between the functions @parallelList@, @parallelVec@ and @parallelIOVec@ is the type of the results returned.  The 
-- closest to the underlying behaviour is @parallelIOVec'@; the other functions are simply convenience wrappers that freeze/convert
-- the IOVector into a Vector or list.
--
-- /Note/: make sure you compile your program with the @-threaded -with-rtsopts=-N@ options (e.g. in the ghc-options field in your
-- cabal file), or else you will not get any parallel execution in your program!
module Control.Concurrent.ParallelTasks (
  -- * The main parallel processing functions.
  parallelList, parallelVec, parallelIOVec,
  -- * The configurable versions of the functions.
  -- | These versions can take place in a monad other than IO, and can configure other options (such as killing off long-running tasks).
  -- See the documentation for 'ParTaskOpts'.
  parallelList', parallelVec', parallelIOVec',
  -- * The options available to configure the functions.
  SimpleParTaskOpts(..), ParTaskOpts(..), defaultParTaskOpts) where

import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.Vector as V (Vector, toList, unsafeFreeze)
import qualified Data.Vector.Mutable as V (IOVector)

import Control.Concurrent.ParallelTasks.Base (SimpleParTaskOpts(..), ParTaskOpts(..), defaultExtendedParTaskOpts, defaultParTaskOpts, parallelTasks)

-- | As 'parallelList', but returns the results in a mutable IOVector.
--
-- Defined as @parallelIOVec' defaultParTaskOpts@
parallelIOVec :: [IO a] -> IO (V.IOVector a)
parallelIOVec = parallelIOVec' defaultParTaskOpts
parallelIOVec' :: MonadIO m => ParTaskOpts m a -> [m a] -> m (V.IOVector a)
parallelIOVec' o = parallelTasks (defaultExtendedParTaskOpts o)

-- | As 'parallelList', but returns the results in an immutable Vector.
--
-- Defined as @parallelVec' defaultParTaskOpts@
parallelVec :: [IO a] -> IO (V.Vector a)
parallelVec = parallelVec' defaultParTaskOpts
parallelVec' :: MonadIO m => ParTaskOpts m a -> [m a] -> m (V.Vector a)
parallelVec' o t = parallelIOVec' o t >>= liftIO . V.unsafeFreeze

-- | Runs the list of tasks in parallel (a few at a time), and returns the results in a list (with the corresponding order to the input list, i.e. the first task produces the first result in the list.)  See the module description for more details.
--
-- Defined as: @parallelList' defaultParTaskOpts@
parallelList :: [IO a] -> IO [a]
parallelList = parallelList' defaultParTaskOpts
parallelList' :: MonadIO m => ParTaskOpts m a -> [m a] -> m [a]
parallelList' o t = V.toList `liftM` parallelVec' o t