--  Distributed Haskell: multithreading support
--
--  Author : Manuel M T Chakravarty
--	     Duncan Coutts
--  Created: 20 March 2000
--
--  Copyright (c) [2000..2003] Chakravarty & Coutts
--
--  This file is free software; you can redistribute it and\/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  Some thread utility functions
--
--  The form of the Fork-Join concurrency operator is taken from
--    Arrows for Errors: extending the error monad
--    http://www.coutts.uklinux.net/duncan/papers/ssafp02/
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98 + Concurrency
--
--  Fork-Join concurrency operators
--  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
--  The type of the operators allows them to be chained like so:
--   f &> x <&> y <&> z
--
--  This will fork threads to evaluate x, y and z in parallel and return
--  f applied to the results of x, y and z.
--
--- TODO ----------------------------------------------------------------------
--
--  * Try implementation not based on throwTo

module Control.Concurrent.ThreadUtils (
  (<&>), (&>), (&),

  -- re-exported
  --
  forkIO
) where

import Prelude     hiding (catch)
import Control.Concurrent  (myThreadId, newEmptyMVar, takeMVar, putMVar, forkIO)
import Control.Exception   (throwTo, catch)


infixl 2 <&>, &>, &

-- fork-join concurrency (EXPORTED)
--
-- * exception safe: when any of the two threads terminates on an exception,
--   it is guaranteed that the same exception is raised in the main thread
--
(<&>) ::  IO  (a -> b) -> IO  a -> IO  b
f <&> x  = do
   mainId  <- myThreadId
   xResVar <- newEmptyMVar
   forkIO $ (x >>= putMVar xResVar)
	    `catch` throwTo mainId	-- propagate exceptions
   fRes <- f
   xRes <- takeMVar xResVar
   return (fRes xRes)

-- companion opertator to <&> (EXPORTED)
--
(&>) :: (a -> b) -> (IO a -> IO b)
f &> x = return f <&> x


-- fork-join concurrency (compat) (EXPORTED)
--
-- * compatibility with previous version of the Ports libary.
--   Now a special case of the more general operator.
--
(&)   :: IO a -> IO b -> IO (a, b)
m & n  = (,) &> m <&> n