mirror of
https://github.com/augustss/MicroCabal.git
synced 2024-11-22 09:02:49 +03:00
Add flag for recursive builds.
This commit is contained in:
parent
dfddf7320d
commit
5b49dfb61b
8
TODO
8
TODO
@ -1,10 +1,6 @@
|
||||
* Remove the combineValue hack for VItem.
|
||||
Probably needs a different item type for free-text?
|
||||
Or make x-* fields be lists?
|
||||
|
||||
* Install data files, include files, etc.
|
||||
Add include dirs from installed packages to uses of it.
|
||||
|
||||
* Add flag to build recursively.
|
||||
|
||||
* Test (with ghc) with lots of packages.
|
||||
|
||||
* Cache compiler name&version
|
||||
|
@ -47,8 +47,7 @@ initDB env = do
|
||||
dir <- getGhcDir env
|
||||
b <- doesDirectoryExist dir
|
||||
when (not b) $ do
|
||||
when (verbose env > 0) $
|
||||
putStrLn $ "Creating GHC package db " ++ dir
|
||||
message env 0 $ "Creating GHC package db " ++ dir
|
||||
cmd env $ "ghc-pkg init " ++ dir
|
||||
|
||||
ghcExists :: Env -> PackageName -> IO Bool
|
||||
@ -98,8 +97,7 @@ ghcBuildExe env _ (Section _ name flds) = do
|
||||
stdArgs <- setupStdArgs env flds
|
||||
let args = unwords $ ["-O"] ++ stdArgs ++ ["-o", bin, "--make", mainIs'] ++
|
||||
[ ">/dev/null" | verbose env <= 0 ]
|
||||
when (verbose env >= 0) $
|
||||
putStrLn $ "Build executable " ++ bin ++ " with ghc"
|
||||
message env 0 $ "Building executable " ++ bin ++ " with ghc"
|
||||
cmd env $ "ghc " ++ args
|
||||
|
||||
findMainIs :: Env -> [FilePath] -> FilePath -> IO FilePath
|
||||
@ -131,8 +129,7 @@ ghcBuildLib env (Section _ _ glob) (Section _ name flds) = do
|
||||
(omdls ++ mdls) ++
|
||||
[ ">/dev/null" | verbose env <= 0 ]
|
||||
key = name ++ "-" ++ showVersion ver ++ "-mcabal"
|
||||
when (verbose env >= 0) $
|
||||
putStrLn $ "Build library " ++ name ++ " with ghc"
|
||||
message env 0 $ "Building library " ++ name ++ " with ghc"
|
||||
cmd env $ "ghc " ++ args
|
||||
|
||||
ghcInstallExe :: Env -> Section -> Section -> IO ()
|
||||
@ -191,5 +188,6 @@ ghcInstallLib env (Section _ _ glob) (Section _ name flds) = do
|
||||
]
|
||||
key = namever ++ "-mcabal"
|
||||
pkgFn = db </> key ++ ".conf"
|
||||
quiet = if verbose env > 0 then "" else " >/dev/null"
|
||||
writeFile pkgFn desc
|
||||
cmd env $ "ghc-pkg update --package-db=" ++ db ++ " " ++ pkgFn
|
||||
cmd env $ "ghc-pkg update --package-db=" ++ db ++ " " ++ pkgFn ++ quiet
|
||||
|
@ -12,6 +12,7 @@ data Env = Env {
|
||||
distDir :: FilePath, -- where to build, default is dist-mcabal
|
||||
verbose :: Int, -- how chatty, default is 0, -1=say nothing, 0=minimal messages, 1=debug info
|
||||
depth :: Int, -- nesting depth for recursive builds, default is 0
|
||||
recursive:: Bool, -- do recursive builds, default is False
|
||||
backend :: Backend -- which compiler to use, default is MHS
|
||||
}
|
||||
|
||||
@ -25,5 +26,5 @@ data Backend = Backend {
|
||||
}
|
||||
|
||||
message :: Env -> Int -> String -> IO ()
|
||||
message env level msg | verbose env >= level = putStrLn msg
|
||||
message env level msg | verbose env >= level = putStrLn $ replicate (2 * depth env) ' ' ++ msg
|
||||
| otherwise = return ()
|
||||
|
@ -41,12 +41,13 @@ setupEnv :: IO Env
|
||||
setupEnv = do
|
||||
home <- getEnv "HOME"
|
||||
let cdir = home </> ".mcabal"
|
||||
return Env{ cabalDir = cdir, distDir = "dist-mcabal", verbose = 0, depth = 0, backend = mhsBackend }
|
||||
return Env{ cabalDir = cdir, distDir = "dist-mcabal", verbose = 0, depth = 0, backend = mhsBackend, recursive = False }
|
||||
|
||||
decodeCommonArgs :: Env -> IO (Env, [String])
|
||||
decodeCommonArgs env = do
|
||||
let loop e ("-v" : as) = loop e{ verbose = verbose e + 1 } as
|
||||
loop e ("-q" : as) = loop e{ verbose = -1 } as
|
||||
loop e ("-r" : as) = loop e{ recursive = True } as
|
||||
loop e ("--ghc" : as) = loop e{ backend = ghcBackend } as
|
||||
loop e ("--mhs" : as) = loop e{ backend = mhsBackend } as
|
||||
loop e as = return (e, as)
|
||||
@ -200,6 +201,7 @@ findCabalFile _env = do
|
||||
cmdBuild :: Env -> [String] -> IO ()
|
||||
cmdBuild env [] = build env
|
||||
cmdBuild env [pkg] = do
|
||||
message env 0 $ "Build package " ++ pkg
|
||||
st <- getPackageInfo env pkg
|
||||
let dir = dirForPackage env st
|
||||
b <- doesDirectoryExist dir
|
||||
@ -241,7 +243,7 @@ build env = do
|
||||
|
||||
buildExe :: Env -> Section -> Section -> IO ()
|
||||
buildExe env glob sect@(Section _ name flds) = do
|
||||
putStrLn $ "Building executable " ++ name
|
||||
message env 0 $ "Building executable " ++ name
|
||||
createPathFile env sect
|
||||
let deps = getBuildDepends flds
|
||||
pkgs = [ p | (p, _, _) <- deps ]
|
||||
@ -250,7 +252,7 @@ buildExe env glob sect@(Section _ name flds) = do
|
||||
|
||||
buildLib :: Env -> Section -> Section -> IO ()
|
||||
buildLib env glob sect@(Section _ name flds) = do
|
||||
putStrLn $ "Building library " ++ name
|
||||
message env 0 $ "Building library " ++ name
|
||||
createPathFile env sect
|
||||
let pkgs = getBuildDependsPkg flds
|
||||
mapM_ (checkDep env) pkgs
|
||||
@ -261,7 +263,12 @@ checkDep env pkg = do
|
||||
let bend = backend env
|
||||
b <- doesPkgExist bend env pkg
|
||||
when (not b) $
|
||||
error $ "dependency not installed: " ++ pkg
|
||||
if recursive env then do
|
||||
let env' = env { depth = depth env + 1 }
|
||||
preserveCurrentDirectory $
|
||||
cmdInstall env' [pkg]
|
||||
else
|
||||
error $ "dependency not installed: " ++ pkg
|
||||
|
||||
-----------------------------------------
|
||||
|
||||
@ -287,13 +294,13 @@ install env = do
|
||||
|
||||
installExe :: Env -> Section -> Section -> IO ()
|
||||
installExe env glob sect@(Section _ name _) = do
|
||||
putStrLn $ "Installing executable " ++ name
|
||||
message env 0 $ "Installing executable " ++ name
|
||||
installDataFiles env glob sect
|
||||
installPkgExe (backend env) env glob sect
|
||||
|
||||
installLib :: Env -> Section -> Section -> IO ()
|
||||
installLib env glob sect@(Section _ name _) = do
|
||||
putStrLn $ "Installing library " ++ name
|
||||
message env 0 $ "Installing library " ++ name
|
||||
installDataFiles env glob sect
|
||||
installPkgLib (backend env) env glob sect
|
||||
|
||||
@ -318,6 +325,7 @@ cmdHelp _ _ = putStrLn "\
|
||||
\Flags:\n\
|
||||
\ -v be more verbose (can be repeated)\n\
|
||||
\ -q be quiet\n\
|
||||
\ -r do recursive installs for missing packages\n\
|
||||
\ --ghc compile using ghc\n\
|
||||
\ --mhs compile using mhs (default)\n\
|
||||
\\n\
|
||||
|
@ -6,6 +6,7 @@ module MicroCabal.Unix(
|
||||
rmrf,
|
||||
cp,
|
||||
copyFiles,
|
||||
preserveCurrentDirectory,
|
||||
(</>),
|
||||
) where
|
||||
import Control.Exception
|
||||
@ -88,6 +89,13 @@ copyFiles :: Env -> FilePath -> [FilePath] -> FilePath -> IO ()
|
||||
copyFiles env src fns tgt = do
|
||||
cmd env $ "cd " ++ src ++ "; tar cf - " ++ unwords fns ++ " | (cd " ++ tgt ++ "; tar xf - )"
|
||||
|
||||
preserveCurrentDirectory :: IO a -> IO a
|
||||
preserveCurrentDirectory io = do
|
||||
cwd <- getCurrentDirectory
|
||||
a <- io
|
||||
setCurrentDirectory cwd
|
||||
return a
|
||||
|
||||
-----
|
||||
|
||||
(</>) :: FilePath -> FilePath -> FilePath
|
||||
|
Loading…
Reference in New Issue
Block a user