-- Recipe actions:
-- Download to foo.src in most cases, then extract to foo.txt, which can later be compiled to foo.hoo
module Main(main) where


import Control.Concurrent
import Control.Monad 
import Data.Maybe
import Local
import System.Directory 
import System.Mem (performGC)
import System.Random
import qualified Data.Map as Map



-- CmdLine is guaranteed to be a constructor of type Data
main :: IO ()
main = do
    setStdGen $ mkStdGen 50
    make () [] ["default"]
    putStrLn "Data generation complete"

{-
-- If I switch to the parallel-io library then it segfaults, due to GHC bug:
-- http://hackage.haskell.org/trac/ghc/ticket/4835 
withPool i f = f ()
extraWorkerWhileBlocked _ = id
parallel_ _ = sequence_
-}



data Status = Built | Building (MVar ())


make :: () -> [(Name,[Name])] -> [Name] -> IO ()
make opt rules xs = withPool 1 $ \pool -> do
    ref <- newMVar Map.empty
    fs ref pool [] xs
    where
        fs ref pool rec xs = parallel_ pool $ map (f ref pool rec) xs

        f ref pool rec x
            | otherwise = join $ modifyMVar ref $ \mp -> case Map.lookup x mp of
                Just Built -> return (mp, return ())
                Just (Building v) -> return $ (,) mp $ do
                    extraWorkerWhileBlocked pool $ readMVar v
                Nothing -> do
                    v <- newEmptyMVar
                    return $ (,) (Map.insert x (Building v) mp) $ do
                        build (fs ref pool $ x:rec) () rules x
                        modifyMVar_ ref $ \mp -> return $ Map.insert x Built mp
                        putMVar v ()


build :: ([Name] -> IO ()) -> () -> [(Name,[Name])] -> Name -> IO ()
build makeRec opt rules x = do
    outStrLn $ "Starting " ++ x
    case x of
        "default" -> makeRec ["package","platform"]
        "platform" -> makePlatform makeRec
        "package" -> return () -- makePackage
        _ -> makeDefault makeRec [] x
    outStrLn $ "Finished " ++ x




makePlatform :: ([Name] -> IO ()) -> IO ()
makePlatform make = make plat
    where plat = ["array","base","bytestring","containers","directory","extensible-exceptions","filepath","haskell2010","haskell98","old-locale"]

makeDefault :: ([Name] -> IO ()) -> [FilePath] -> Name -> IO ()
makeDefault make local name = do
    splat
    make $ fromJust $ lookup name depends
    splat


splat = do
    getDirectoryContents $ "C:/Windows"
    performGC


depends =
    [("array",["base"])
    ,("base",[])
    ,("haskell98",["base","directory","random","old-time","old-locale","process","array"])
    ,("directory",["base","old-time","filepath","unix"])
    ,("random",["base","time"])
    ,("time",["base","old-locale"])
    ,("old-locale",["base"])
    ,("filepath",["base"])
    ,("old-time",["base","old-locale"])
    ,("process",["unix","base","directory","filepath"])
    ,("unix",["base"])
    ,("bytestring",["base"])
    ,("extensible-exceptions",["base"])
    ,("containers",["base","array"])
    ,("haskell2010",["base","array"])
    ]



type Name = String


---------------------------------------------------------------------
-- ERROR MESSAGES


outStr, outStrLn :: String -> IO ()
outStr x = putStr x -- withMVar outputLock $ \_ -> do putStr x; hFlush stdout
outStrLn x = outStr $ x ++ "\n"