Add flag for recursive builds.

This commit is contained in:
Lennart Augustsson 2024-07-23 12:19:00 +02:00
parent dfddf7320d
commit 5b49dfb61b
5 changed files with 31 additions and 20 deletions

8
TODO
View File

@ -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

View File

@ -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

View File

@ -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 ()

View File

@ -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,6 +263,11 @@ checkDep env pkg = do
let bend = backend env
b <- doesPkgExist bend env pkg
when (not b) $
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\

View File

@ -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