{-
File: monadpar.hs
Author: Max Levatich
-}

import System.Environment
import Control.Parallel
import Control.Parallel.Strategies hiding (parList)
import Control.Monad.Par

-- PRELIMINARIES:
-- `stack install monad-par` (for Control.Monad.Par)

-- Par monad paper:
-- https://simonmar.github.io/bib/papers/monad-par.pdf

fib :: Integer -> Integer
fib 0 = 0
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

parFib :: Integer -> Par Integer
parFib n = do
    -- i <- new
    -- j <- new
    -- fork $ put i ((fib (n - 1)))
    -- fork $ put j (fib (n - 2))
    i <- spawnP (fib (n - 1))
    j <- spawnP (fib (n - 2))

    a <- get i
    b <- get j
    return $ a + b

parFib2 :: Integer -> Par Integer
parFib2 0 = return 0
parFib2 1 = return 1
parFib2 n = do
    i <- spawn $ parFib2 (n - 1)
    j <-         parFib2 (n - 2)
    a <- get i
    return (a + j)

parFibStrat :: Integer -> Integer
parFibStrat 0 = 0
parFibStrat 1 = 1
parFibStrat n = par f1 (f1 + f2)
    where f1 = parFibStrat (n - 1)
          f2 = parFibStrat (n - 2)

main :: IO ()
main = do
    as <- getArgs
    case as of 
        [s] | n >= 0 -> print $ parFibStrat n where n = read s :: Integer
        _ -> putStrLn "one arg, must be integer >= 0"

-- Modeling dataflow:
--      a
--     / \
--    b   c
--     \ /
--      d
dependentAdd :: IVar Int
dependentAdd = runPar $ do
    a <- new
    b <- spawn $ do x <- get a
                    return (x + 1)
    c <- spawn $ do x <- get a
                    return (x + 2)
    d <- spawn $ do x <- get b
                    y <- get c
                    return (x + y)
    fork $ put a (1 + 2 :: Int)
    get d

-- What's going to happen? Assume (1 + 2) takes a long time for some reason
-- One spark is working on evaluating (1 + 2), second spark gets bored and starts working on a as well,
-- third spark gets bored and starts working on a, etc.
dependentAddEval :: Int
dependentAddEval = runEval $ do
    a <- rpar (1 + 2)
    b <- rpar (a + 1)
    c <- rpar (a + 2)
    d <- rpar (b + c)
    return d

parMapM :: NFData b => (a -> Par b) -> [a] -> Par [b]
parMapM f as = do
    ibs <- mapM (spawn . f) as
    mapM get ibs

-- Double put is a runtime error
-- Deadlock (e.g. get without a corresponding put) is a runtime error
-- Don't return an IVar! Undefined behavior