module Main where

-- Don't look at these!
import Data.Time.Clock    (diffUTCTime, getCurrentTime)
import Data.IntMap        (IntMap)
import Data.List
import Data.Tuple         (swap)
import System.Environment (getArgs)
import System.Random      (StdGen, mkStdGen, getStdGen, randoms)
import qualified Data.IntMap.Strict as Map

import SparseGraph
import HeavyStuff

-- You can look here though.
import Control.Parallel  -- par and pseq (should be in base)
import Control.Monad.Par -- Par monad (monad-par on hackage)

--------------------------------------------------------------------------------
-- * Intro.
--------------------------------------------------------------------------------

mMap :: (a -> b) -> [a] -> [b]
mMap f [] = []
--mMap f (x:xs) = f x : mMap f xs
mMap f (x:xs) =
  let
    x' = f x
    xs' = mMap f xs
  in
    x' : xs'

mLength :: [a] -> Int
mLength [] = 0
mLength (_:xs) = 1 + mLength xs

mSum :: [Int] -> Int
mSum [] = 0
mSum (x:xs) = x + mSum xs































--------------------------------------------------------------------------------
-- * Smaller examples.
--------------------------------------------------------------------------------
-- par & pseq :: a -> b -> b

heavy :: Int
heavy = mEuler `par` (mFib `pseq` mEuler + mFib)

--------------------------------------------------------------------------------

todoFibs :: [Int]
todoFibs = [37,38,39,40]

todoEulers :: [Int]
todoEulers = [7600, 7600]

heavy2 :: Int
heavy2 = sum $ concat [pMap fib todoFibs, pMap euler todoEulers]

heavy3 :: Int
heavy3 = (force mEulers) `par` (force mFibs `pseq` sum mEulers + sum mFibs)

force :: [Int] -> ()
force [] = ()
force (x:xs) = x `pseq` force xs

pMap :: (a -> b) -> [a] -> [b]
pMap f [] = []
pMap f (x:xs) =
  let
    x'  = f x
    xs' = pMap f xs
  in
    x' `par` (xs' `pseq` (x' : xs'))

mSpawn :: NFData a => Par a -> Par (IVar a)
mSpawn a = do
  i <- new
  fork $ (do x <- a; put i x)
  return i

parMap :: NFData b => (a -> Par b) -> [a] -> Par [b]
parMap f xs = do
  is <- mapM (\x -> mSpawn (f x)) xs
  mapM get is

-- newtype Par a
-- instance Monad Par
-- runPar :: Par a -> a
-- fork   :: Par () -> Par ()

-- data IVar a
-- instance Eq (IVar a)
-- new :: Par (IVar a)
-- put :: NFData a => IVar a -> a -> Par ()
-- get :: IVar a -> Par a

apa :: Int
apa = runPar $ do
  i <- new
  j <- new
  fork $ put i (mFib)
  fork $ put j (mEuler)
  a <- get i
  b <- get j
  return (a + b)

--------------------------------------------------------------------------------
-- ** Main.

main = do
  start <- getCurrentTime
  pseq (heavy3) (return ())
  end   <- getCurrentTime
  putStrLn ("sum: "  ++ show apa)
  putStrLn ("time: " ++ show (end `diffUTCTime` start) ++ " seconds")

-- hint to self: don't scroll down yet!

















--------------------------------------------------------------------------------
-- * Bigger example.
--------------------------------------------------------------------------------

sSort :: [Int] -> [Int]
sSort [] = []
sSort (x:xs) = lt ++ x : gte
  where
    lt  = sSort [ y | y <- xs, y <  x]
    gte = sSort [ y | y <- xs, y >= x]

mSort :: Int -> [Int] -> [Int]
mSort d []     = []
mSort 0 xs     = sSort xs --let x = sSort xs in (force x) `pseq` x
mSort d (x:xs) = (force2 lt) `par` (force2 gte `pseq` (lt ++ x : gte))
  where
    lt  = mSort (d-1) [ y | y <- xs, y <  x]
    gte = mSort (d-1) [ y | y <- xs, y >= x]

--------------------------------------------------------------------------------
-- ** New Main.
{-
main = do
  start <- getCurrentTime
  input <- randomInts 5000000 `fmap` getStdGen
  let res = mSort 5 input
  pseq (force res) (return ())
  end   <- getCurrentTime
  --putStrLn ("sum: " ++ show res)
  putStrLn ("time: " ++ show (end `diffUTCTime` start) ++ " seconds")
-}
-- makes some random numbers.
randomInts :: Int -> StdGen -> [Int]
randomInts k g = let result = take k (randoms g)
                  in force2 result `pseq` result

-- force the spine of a list to be evaluated.
force2 :: [a] -> ()
force2 xs = go xs `pseq` ()
  where
    go (_:xs) = go xs
    go []     = 1

-- hint to self: don't scroll down yet!

















--------------------------------------------------------------------------------
-- * Even bigger example.
--------------------------------------------------------------------------------
-- shortestPaths :: Graph -> Vertex -> Vertex -> Vertex -> Weight
-- shortestPaths g i j 0 = weight g i j
-- shortestPaths g i j k = min
--   ( shortestPaths g i j (k-1)
--   , shortestPaths g i k (k-1) + shortestPaths g k j (k-1))

-- type Vertex = Int
-- type Weight = Int
-- type Graph  = Vertex -> (Vertex -> Weight)
--------------------------------------------------------------------------------

shortestPaths :: [Vertex] -> Graph -> Graph
shortestPaths vs g = foldl' update g vs            -- <1>
 where
  update :: Graph -> Vertex -> Graph               -- <2>
  update g k = Map.mapWithKey (\v jmap -> shortmap v jmap) g
   where
     shortmap :: Vertex -> IntMap Weight -> IntMap Weight
     shortmap i jmap = foldr shortest Map.empty vs -- <3>
        where shortest j m =
                case (old,new) of                  -- <6>
                   (Nothing, Nothing) -> m
                   (Nothing, Just w ) -> Map.insert j w m
                   (Just w,  Nothing) -> Map.insert j w m
                   (Just w1, Just w2) -> Map.insert j (min w1 w2) m
                where
                  old = Map.lookup j jmap          -- <4>
                  new = do w1 <- weight g i k      -- <5>
                           w2 <- weight g k j
                           return (w1+w2)

--------------------------------------------------------------------------------
{-
main :: IO ()
main = do
  let h = 1000
  let n = 800
  let g = mkStdGen 9999
  let (mat,vs) = randomGraph g h 100 n
  let check = checksum (shortestPaths vs mat)
  start <- getCurrentTime
  pseq (check) (return ())
  end   <- getCurrentTime
  putStrLn ("checksum: "  ++ show check)
  putStrLn ("time: " ++ show (end `diffUTCTime` start) ++ " seconds")
-}
--------------------------------------------------------------------------------
-- newtype Par a
-- instance Monad Par
-- runPar :: Par a -> a
-- fork   :: Par () -> Par ()

-- data IVar a
-- instance Eq (IVar a)
-- new :: Par (IVar a)
-- put :: NFData a => IVar a -> a -> Par ()
-- get :: IVar a -> Par a
--------------------------------------------------------------------------------


































--------------------------------------------------------------------------------
-- Solutions, in case I forget them.

-- Par
{-
  f `par` (f + e)           Bad! Spark has no time to finish since main thread will start on f immediately.
  f `par` (e + f)           Very Bad! Haskell migth re-write the expression and put us back to square one.
  f `par` (e `pseq` e + f)  Better!
-}

-- Par lists
{-
  f `par` (e `pseq` e + f) -- Bad! We only evaluate to the first list constructor, not its elements.
  (force f) `par` ((force e) `pseq` sum e + sum f) -- Better!
-}

-- Graphs
{-
mapWithKey      ::            (Key -> a ->   b) -> IntMap a ->    IntMap b
traverseWithKey :: Monad t => (Key -> a -> m b) -> IntMap a -> m (IntMap b) 

update g k = runPar $ do
  m <- Map.traverseWithKey (\i jmap -> spawn (return (shortmap i jmap))) g
  traverse get m
-}