-- Window build checker
-- Written by Neil Mitchell

module Main where

import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import System.Cmd
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.Info
import System.IO


main = do
    hSetBuffering stdout NoBuffering
    xs <- getArgs
    if null xs then help else mapM_ action xs
    putStrLn "winbuild success"


help = putStr $ unlines
    ["GHC Windows Build Helper"
    ,""
    ,"Possible arguments:"
    ,"  " ++ unwords (map fst actions)
    ,""
    ,"Standard invokation:"
    ,"  runhaskell winbuild check   -- see if everything works"
    ,"  runhaskell winbuild fix     -- if the check failed"
    ,"  runhaskell winbuild all     -- do everything"
    ,"  all = check pull boot configure build bindist"
    ,""
    ]

actions = let (*) = (,) in
    ["help" * help
    ,"fix" * fix
    ,"check" * check
    ,"clean" * clean
    ,"pull" * pull
    ,"configure" * configure
    ,"build" * build
    ,"bindist" * bindist
    ,"boot" * boot
    ,"all" * allActions
    ]


action x = fromMaybe (error $ "Unknown command: " ++ x) $
           lookup x actions

allActions = check >> pull >> boot >> configure >> build -- >> bindist


pull = systemAnd "sh -c \"./darcs-all pull --all\""

clean = systemAnd "make clean"

boot = systemAnd "sh boot"

configure = systemAnd $ "sh configure --host=i386-unknown-mingw32"

build = systemAnd "make 2>&1 | tee make.log"

bindist = systemAnd "make binary-dist 2>&1 | tee make-bin-dist.log"


---------------------------------------------------------------------
-- CHECKING AND FIXING



mingwPath = any (==& "mingw") . splitDirectories

checkCygwin = output "sh --version" "cygwin"
checkGHC = output "ghc --version" "version 6.8.3"
checkGCC = findExecutable "gcc" >>= return . maybe False mingwPath
checkDarcs = output "sh -c \"darcs --exact-version\"" "darcs compiled"
checkBasic = ["haddock","happy","alex"]

-- Checks must be ordered, i.e. gcc after ghc, so that a ghc fix doesn't break a gcc one
checks :: [(String, IO Bool, IO (Maybe FilePath))]
checks = [prog "cygwin" checkCygwin $ error "Start a cygwin shell"
         ,prog "ghc" checkGHC ["c:/ghc/ghc-6.8.3/bin"]
         ,prog "gcc" checkGCC ["c:/mingw/bin"]
         ,prog "darcs" checkDarcs []
         ,("build.mk",checkBuildMk,fixBuildMk >> return Nothing)
         ,("cabal_deps",checkCabalDeps,fixCabalDeps >> return Nothing)
         ] ++
         map simp checkBasic
    where
        prog name test paths = (name, test, f paths)
            where f [] = error $ "Couldn't find any location for " ++ show name
                  f (x:xs) = do b <- hasExecutablePath x name; if b then return $ Just x else f xs

        simp x = prog x (hasExecutable x) ["c:/bin","c:/program files/haskell/bin"]


-- TODO: Should check for the mk/build.mk options properly set
-- TODO: Should check for the necessary package tweaks for cabal-install dependencies
check = do
    bad <- liftM (length . filter not) $ mapM f checks
    when (bad /= 0) $ do
        putStrLn $ show bad ++ " problems detected"
        exitFailure
    putStrLn "No obvious problems detected"
    where
        f (name,test,_) = do
            putStr $ "Checking " ++ name ++ "... "
            b <- test
            putStrLn $ if b then "success" else "FAILURE"
            return b


fix = do
    putStr "Computing fixes... "
    xs <- liftM catMaybes $ mapM f checks
    if null xs then putStrLn "no path changes needed"
     else putStrLn $ "please type:\nexport PATH=" ++ concatMap g xs ++ "$PATH"
    where
        f (name,test,fix) = ifM test (return Nothing) fix

        g x = "/cygdrive/" ++ filter (/= ':') x ++ ":"


---------------------------------------------------------------------
-- MORE ADVANCED CHECK/FIX

checkBuildMk = do
    src <- readFileSafe' "mk/build.mk"
    let opts = map (filter (not . isSpace)) $ lines src
    return $ all (`elem` opts) ["SplitObjs=NO","BuildFlavour=perf","BIN_DIST=1"]


fixBuildMk = do
    error "Can't current fix BuildMk (please fix)"


checkCabalDeps = do
    doesDirectoryExist "libraries/network"


fixCabalDeps = do
    error "Can't current fix CabalDeps (please fix)"


---------------------------------------------------------------------
-- HELPER FUNCTIONS


getExecutable :: String -> IO FilePath
getExecutable name = liftM (fromMaybe $ error $ "Can't find executable " ++ name) $ findExecutable name

hasExecutable :: String -> IO Bool
hasExecutable = liftM isJust . findExecutable

hasExecutablePath :: FilePath -> String -> IO Bool
hasExecutablePath path name = doesFileExist $ path </> name <.> "exe"


(==&) x y = map toLower x == map toLower y
(/=&) x y = not $ x ==& y

rep from to x = if x == from then to else x


systemAnd cmd = do
    putStrLn cmd
    res <- system cmd
    when (res /= ExitSuccess) $ do
        putStrLn "WINBUILD FAILURE"
        exitWith res


readFileDelete file = do
    b <- doesFileExist file
    if not b then return "" else do
        src <- readFile' file
        removeFile file
        return src


readFile' file = do
    h <- openFile file ReadMode
    src <- hGetContents h
    length src `seq` hClose h
    return src


readFileSafe' file = do
    b <- doesFileExist file
    if b then readFile' file else return ""
    


output cmd require = do
    res <- system $ cmd ++ " > winbuild.log"
    src <- readFileDelete "winbuild.log"
    return $ res == ExitSuccess && require `isSubstrOf` src


isSubstrOf find str = any (find `isPrefixOf`) (tails str)


ifM b yes no = do
    b <- b
    if b then yes else no

return_ x = x >> return ()