Commit 6cfea785 authored by simonmar's avatar simonmar
Browse files

First cut at 'setup build'

parent 18227a1b
{-# OPTIONS -cpp -DDEBUG #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Build
......@@ -43,19 +44,53 @@ module Distribution.Simple.Build (
build
) where
import Distribution.Setup
import Distribution.Package
import Distribution.Simple.Configure(LocalBuildInfo)
import Distribution.Simple.Utils(setupMessage)
import Distribution.Simple.Configure
import Distribution.Simple.Utils
import System.IO
import System.Exit
import System.Cmd (rawSystem)
import Control.Monad
-- -----------------------------------------------------------------------------
-- Build the library
build :: PackageDescription -> LocalBuildInfo -> IO ()
build pkg_descr lbi = do
setupMessage "Configuring" pkg_descr
exitWith (ExitFailure 1)
setupMessage "Building" pkg_descr
when (compilerFlavor (compiler lbi) /= GHC) $
die ("only building with GHC is implemented")
-- first, build the modules
let args = constructGHCCmdLine pkg_descr lbi
rawSystemExit (compilerPath (compiler lbi)) args
-- now, build the library
let objs = map (++objsuffix) (allModules pkg_descr)
lib = mkLibName (library pkg_descr)
rawSystemPathExit "ar" (["q", lib] ++ objs)
constructGHCCmdLine :: PackageDescription -> LocalBuildInfo -> [String]
constructGHCCmdLine pkg_descr lbi =
[
"--make",
"-package-name", showPackageId (package pkg_descr)
]
++ extensionsToGHCFlag (extensions pkg_descr)
++ [ opt | (GHC,opts) <- options pkg_descr, opt <- opts ]
++ allModules pkg_descr
extensionsToGHCFlag _ = [] -- ToDo
#ifdef mingw32_TARGET_OS
objsuffix = ".obj"
#else
objsuffix = ".o"
#endif
-- construct ghc --make command line
-- run it
-- build a library
mkLibName lib = "lib" ++ lib ++ ".a"
-- ToDo: includes, includeDirs
......@@ -50,7 +50,7 @@ module Distribution.Simple.Configure (writePersistBuildConfig,
import Distribution.Setup(ConfigFlags,CompilerFlavor(..), Compiler(..))
import Distribution.Package(PackageDescription(..))
import Distribution.Simple.Utils (splitFilenameDir, die, split, setupMessage)
import Distribution.Simple.Utils
import System.IO hiding (catch)
import System.Exit
......@@ -65,9 +65,11 @@ import HUnit
#endif
-- |Data cached after configuration step.
data LocalBuildInfo = LocalBuildInfo {prefix :: String,
compiler :: Compiler}
deriving (Show, Read, Eq)
data LocalBuildInfo = LocalBuildInfo {
prefix :: String,
compiler :: Compiler
}
deriving (Show, Read, Eq)
emptyLocalBuildInfo :: LocalBuildInfo
emptyLocalBuildInfo = undefined
......@@ -146,7 +148,14 @@ defaultCompilerFlavor =
#endif
findCompiler :: CompilerFlavor -> IO FilePath
findCompiler flavor = findBinary (compilerBinaryName flavor)
findCompiler flavor = do
let prog = compilerBinaryName flavor
message $ "searching for " ++ prog ++ " in path."
res <- findBinary prog
case res of
Nothing -> die ("Cannot find compiler for " ++ prog)
Just path -> do message ("found " ++ prog ++ " at "++ path)
return path
-- ToDo: check that compiler works? check compiler version?
compilerBinaryName GHC = "ghc"
......@@ -169,29 +178,6 @@ guessPkgToolFromHCPath flavor path
message $ "found package tool in " ++ pkgtool
return pkgtool
findBinary :: String -> IO FilePath
findBinary binary = do
path <- getEnv "PATH"
message $ "searching for " ++ binary ++ " in path."
search (parsePath path)
where
search :: [FilePath] -> IO FilePath
search [] = die ("Cannot find compiler for " ++ binary)
search (d:ds) = do
let path = d ++ '/':binary
b <- doesFileExist path
if b then do message ("found " ++ binary ++ " at "++ path); return path
else search ds
parsePath :: String -> [FilePath]
parsePath path = split pathSep path
where
#ifdef mingw32_TARGET_OS
pathSep = ';'
#else
pathSep = ':'
#endif
message s = putStrLn $ "configure: " ++ s
-- -----------------------------------------------------------------------------
......
......@@ -48,12 +48,19 @@ module Distribution.Simple.Utils (
isPathSeparator,
setupMessage,
die,
findBinary,
rawSystemPath,
rawSystemExit,
rawSystemPathExit,
) where
import Distribution.Package
import System.IO
import System.Exit
import System.Cmd
import System.Environment
import System.Directory
-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext")
splitFilenameDir :: String -> (String,String)
......@@ -90,3 +97,57 @@ setupMessage msg pkg_descr =
die :: String -> IO a
die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
-- ToDo: add cacheing?
findBinary :: String -> IO (Maybe FilePath)
findBinary binary = do
path <- getEnv "PATH"
search (parsePath path)
where
search :: [FilePath] -> IO (Maybe FilePath)
search [] = return Nothing
search (d:ds) = do
let path = d ++ '/':binary
b <- doesFileExist path
if b then return (Just path)
else search ds
parsePath :: String -> [FilePath]
parsePath path = split pathSep path
where
#ifdef mingw32_TARGET_OS
pathSep = ';'
#else
pathSep = ':'
#endif
-- -----------------------------------------------------------------------------
-- rawSystem variants
rawSystemPath :: String -> [String] -> IO ExitCode
rawSystemPath prog args = do
r <- findBinary prog
case r of
Nothing -> die ("Cannot find: " ++ prog)
Just path -> rawSystem path args
maybeExit :: IO ExitCode -> IO ()
maybeExit cmd = do
res <- cmd
if res /= ExitSuccess
then exitWith res
else return ()
-- Exit with the same exitcode if the subcommand fails
rawSystemExit :: FilePath -> [String] -> IO ()
rawSystemExit path args = do
putStrLn (path ++ concat (map (' ':) args))
--ToDo: make command display conditional on -v flag?
maybeExit $ rawSystem path args
-- Exit with the same exitcode if the subcommand fails
rawSystemPathExit :: String -> [String] -> IO ()
rawSystemPathExit prog args = do
putStrLn (prog ++ concat (map (' ':) args))
--ToDo: make command display conditional on -v flag?
maybeExit $ rawSystemPath prog args
......@@ -10,6 +10,8 @@
* later todo
** writePersistBuildConfig robustify + diagnostics
** elaborate command-line help text
** configure should check for 'ar' args + properties (see fptools/aclocal.m4)
** most commands should accept a -v flag to show command lines?
* Testing
** error cases for parsing command-line args
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment