GHCBuild.hs

module Language.Ruby.Hubris.GHCBuild (ghcBuild, defaultGHCOptions, GHCOptions(..)) where
import Config
import Debug.Trace
import DynFlags
import GHC
import GHC.Paths
import Outputable
import StringBuffer
import System.Process
import Control.Monad(forM_,guard)
import System.IO(hPutStr, hClose, openTempFile)
import System( exitWith, system)
import System.Exit
import Includes (extraIncludeDirs) -- this is generated by Cabal


newtype GHCOptions = GHCOptions { strict :: Bool }
defaultGHCOptions = GHCOptions { strict = True }
type Filename = String


withFile :: String -> IO String
withFile code = do (name, handle) <- openTempFile "/tmp" "hubris_XXXXX.hs"
                   hPutStr handle code
                   hClose handle
                   return name

ghcBuild :: Filename -> String -> String -> [Filename] -> [Filename] -> [String]-> IO (Maybe (ExitCode,String))
ghcBuild libFile immediateSource modName extra_sources c_sources args =
    do haskellSrcFile <- withFile immediateSource
       noisySystem ghc $ ["--make", "-shared", "-dynamic",  "-o",libFile,"-fPIC", "-L" ++ libdir,"-optl-Wl,-rpath," ++ libdir,
                             "-lHSrts-ghc" ++ Config.cProjectVersion, haskellSrcFile] ++
                             map ("-I"++) extraIncludeDirs
                             ++ extra_sources ++ c_sources ++ args

noisySystem :: String -> [String] -> IO (Maybe (ExitCode, String))
noisySystem cmd args = do putStrLn $ unwords (cmd:args)
                          (errCode, out, err) <- readProcessWithExitCode cmd args ""
                          return $ guard (errCode /= ExitSuccess) >> 
                            Just (errCode, unlines ["output: " ++ out, "error: " ++ err])