{-| module for parallel computations. The paralellism is reached by forking threads with liftIO. When starting a thread and empty MVar is returned immediately. The MVar is filled on completing of the thread. Normal function can be lifted to threaded function operation on MVar of the parameters instead of the parameters themself. Thus it is possible to define dependencies of function on the return values of other functions and let the order of excecution evolove automatically, so a function is called as soon as all its parameters have been calculated. All functions considered in this module are understood to have an IO return type. This module is mainly used for paraller downloading from the web. -}
module Parallel where
import Control.Concurrent.MVar

{-| takes a function of return type IO which takes on parameter and an MVar containing at the same type as the parameter of the function and returns and IO action containing an MVar containing the same type as the tyoe contained in the IO Action returned by the function. This function retuns immediately and passed an empty MVar as return type. As soon as the MVar containing the same type as the parameter of the function is ready for reading the the function is executed in a new thread. As soon as the function return a value, the it is written into the returned MVar.  -}

(<$$>) :: MVar Int -> (a -> IO b) -> MVar a -> IO (MVar b)
(<$$>) vv f x
  = do var <- newEmptyMVar
       _ <- myFork vv (go var)
       return var
  where go v
          = do xx <- readMVar x
               result <- f xx
               putMVar v result

{-| takes a value and returns an IO action that contain a filled MVar conatining the value -}

base :: MVar Int -> a -> IO (MVar a)
base v x = ((ppure v) . return) x

{-| takes an IO action and return an MVar containing the and IO action the returns an MVar containing the same type as contained by the IO action passed to this function. The IO action passed as first parameter to this function is executed in a new thread. As soon as it finishes its result is written into the returned MVar -}

ppure :: MVar Int -> IO a -> IO (MVar a)
ppure vv x
  = do var <- newEmptyMVar
       _ <- myFork vv (go var)
       return var
  where go v
          = do result <- x
               putMVar v result

{-| alias to switch between forkOS and forkIO for testing -}

myFork :: MVar Int -> IO () -> IO ()
myFork _ x = x

{-| takes a function which takes a list and return an IO action as first parameter. It takes a list of MVar containing the same type as the type contained in the list as second parameter. It returnes an empty MVar immediately. As soon as all MVar in the list given as second parameter could be read, the function is started in a new thread. As soon as it finishes, the returend MVar is filled with the value returend by the function -}

liftList :: MVar Int -> ([a] -> IO b) -> [MVar a] -> IO (MVar b)
liftList vv f x
  = do var <- newEmptyMVar
       _ <- myFork vv (go var)
       return var
  where go v
          = do xx <- mapM readMVar x
               result <- f xx
               putMVar v result

{-| the same as liftList. Only difference is that the seconds parameter is not a list of MVars containing values but an MVar containing a list of MVars containing values. So an addinal step is made to read the out MVar -}

liftList2 ::
          MVar Int -> ([a] -> IO b) -> MVar [MVar a] -> IO (MVar b)
liftList2 vv f x
  = do var <- newEmptyMVar
       _ <- myFork vv (go var)
       return var
  where go v
          = do xxx <- readMVar x
               xx <- mapM readMVar xxx
               result <- f xx
               putMVar v result

{-| prefix version of the angle bracked dollar operator described above -}

liftA :: MVar Int -> (a -> IO b) -> MVar a -> IO (MVar b)
liftA v f x = (<$$>) v f x

{-| same as liftA. Just function must have exactly two parameter instead of only one -}

liftA2 ::
       MVar Int -> (a -> b -> IO c) -> MVar a -> MVar b -> IO (MVar c)
liftA2 vv f x y
  = do var <- newEmptyMVar
       _ <- myFork vv (go var)
       return var
  where go v
          = do xx <- readMVar x
               yy <- readMVar y
               result <- f xx yy
               putMVar v result

{-| same as liftA. Just function must have exactly three parameter instead of only one -}

liftA3 ::
       MVar Int ->
         (a -> b -> c -> IO d) -> MVar a -> MVar b -> MVar c -> IO (MVar d)
liftA3 vv f x y z
  = do var <- newEmptyMVar
       _ <- myFork vv (go var)
       return var
  where go v
          = do xx <- readMVar x
               yy <- readMVar y
               zz <- readMVar z
               result <- f xx yy zz
               putMVar v result