import Control.Parallel

data Task a = Idle | Make a
type TaskList a = [a]
type Results a = [a]
type TaskGroups a = [TaskList a]
type WorkerList a = [Worker a]
type Worker a = [Task a]




runTasks :: TaskList a -> Results a
runTasks [] = []
runTasks (x:[]) = x: []
runTasks (x:y:[]) = y `par` x: y: []
runTasks (x:y:ys) = y `par` x: y: runTasks ys



groupTasks :: WorkerList a -> TaskGroups a
groupTasks [] = []
groupTasks xs
    | allWorkersIdle xs = []
    | otherwise =
        concatMap extractTask xs: groupTasks (map removeTask xs)


extractTask :: Worker a -> [a]
extractTask [] = []
extractTask (Idle:_) = []
extractTask (Make a:_) = [a]


removeTask :: Worker a -> Worker a
removeTask = drop 1


allWorkersIdle :: WorkerList a -> Bool
allWorkersIdle = all null . map extractTask






worker1 :: Worker Integer
worker1 = map Make [ sum [1..n*1000000] | n <- [1..5] ]


worker2 :: Worker Integer
worker2 = map Make [ sum [1..n*100000] | n <- [1..4] ]


worker3 :: Worker Integer
worker3 = map Make [ sum [1..n*1000000] | n <- [1..3] ]


worker4 :: Worker Integer
worker4 = map Make [ sum [1..n*300000] | n <- [1..5] ]


worker5 :: Worker Integer
worker5 = [Idle] ++ map Make [ sum [1..n*400000] | n <- [1..4] ]


tasks :: TaskGroups Integer
tasks = groupTasks [worker1, worker2, worker3, worker4, worker5]



workshop :: (Show a, Num a, Show b, Num b) => ([a] -> b) -> [[a]] -> IO ()
workshop func a = mapM_ doWork $ zip [1..length a] a
    where
        doWork (x, y) = do
            putStrLn $ "Doing task " ++ show x ++ "."
            putStrLn $ "There are " ++ show (length y) ++ " workers for this task."
            putStrLn "Waiting for all workers..."
            print $ func $ runTasks y
            putStrLn $ "Task " ++ show x ++ " done."

main = workshop sum tasks