Commit 498939a9 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Factor our common build actions into src/Rules/Actions.hs

parent fd3a1f89
......@@ -175,7 +175,7 @@ putError msg = do
-- | Render the given set of lines in a ASCII box
renderBox :: [String] -> String
renderBox ls =
unlines $ [begin] ++ map (bar++) ls ++ [end]
unlines ([begin] ++ map (bar++) ls) ++ end
where
(begin,bar,end)
| useUnicode = ( "╭──────────"
......
{-# LANGUAGE RecordWildCards #-}
module Rules.Actions (build, buildWithResources) where
module Rules.Actions (
build, buildWithResources, copyFile, createDirectory, moveDirectory,
fixFile, runConfigure, runMake, runBuilder
) where
import qualified System.Directory as IO
import Base
import Expression
import Oracles.ArgsHash
import Oracles.Config.Setting
import Settings
import Settings.Args
import Settings.Builders.Ar
......@@ -25,7 +31,14 @@ buildWithResources rs target = do
withResources rs $ do
unless verbose $ putInfo target
quietlyUnlessVerbose $ case builder of
Ar -> arCmd path argList
Ar -> do
output <- interpret target getOutput
if "//*.a" ?== output
then arCmd path argList
else do
input <- interpret target getInput
top <- setting GhcSourcePath
cmd [path] [Cwd output] "x" (top -/- input)
HsCpp -> captureStdout target path argList
GenApply -> captureStdout target path argList
......@@ -49,13 +62,62 @@ captureStdout target path argList = do
Stdout output <- cmd [path] argList
writeFileChanged file output
copyFile :: FilePath -> FilePath -> Action ()
copyFile source target = do
putBuild $ renderBox [ "Copy file"
, " input: " ++ source
, "=> output: " ++ target ]
copyFileChanged source target
createDirectory :: FilePath -> Action ()
createDirectory dir = do
putBuild $ "| Create directory " ++ dir
liftIO $ IO.createDirectoryIfMissing True dir
-- Note, the source directory is untracked
moveDirectory :: FilePath -> FilePath -> Action ()
moveDirectory source target = do
putBuild $ renderBox [ "Move directory"
, " input: " ++ source
, "=> output: " ++ target ]
liftIO $ IO.renameDirectory source target
-- Transform a given file by applying a function to its contents
fixFile :: FilePath -> (String -> String) -> Action ()
fixFile file f = do
putBuild $ "| Fix " ++ file
old <- liftIO $ readFile file
let new = f old
length new `seq` liftIO $ writeFile file new
runConfigure :: FilePath -> [CmdOption] -> [String] -> Action ()
runConfigure dir opts args = do
need [dir -/- "configure"]
putBuild $ "| Run configure in " ++ dir ++ "..."
quietly $ cmd Shell (EchoStdout False) [Cwd dir] "bash configure" opts args
runMake :: FilePath -> [String] -> Action ()
runMake dir args = do
need [dir -/- "Makefile"]
let note = if null args then "" else " (" ++ intercalate "," args ++ ")"
putBuild $ "| Run make" ++ note ++ " in " ++ dir ++ "..."
quietly $ cmd Shell (EchoStdout False) "make" ["-C", dir, "MAKEFLAGS="] args
runBuilder :: Builder -> [String] -> Action ()
runBuilder builder args = do
needBuilder laxDependencies builder
path <- builderPath builder
let note = if null args then "" else " (" ++ intercalate "," args ++ ")"
putBuild $ "| Run " ++ show builder ++ note
quietly $ cmd [path] args
-- Print out key information about the command being executed
putInfo :: Target.Target -> Action ()
putInfo (Target.Target {..}) = putBuild $ renderBox $
[ "Running " ++ show builder
putInfo (Target.Target {..}) = putBuild $ renderBox
[ "Run " ++ show builder
++ " (" ++ stageInfo
++ "package = " ++ pkgNameString package
++ wayInfo ++ "):"
++ wayInfo ++ ")"
, " input: " ++ digest inputs
, "=> output: " ++ digest outputs ]
where
......
......@@ -3,6 +3,7 @@ module Rules.Copy (installTargets, copyRules) where
import Base
import Expression
import GHC
import Rules.Actions
import Rules.Generate
import Rules.Libffi
import Settings.TargetDirectory
......@@ -20,16 +21,10 @@ copyRules = do
when (length ffiHPaths /= 1) $
putError $ "copyRules: exactly one ffi.h header expected"
++ "(found: " ++ show ffiHPaths ++ ")."
let ffiHPath = takeDirectory $ head ffiHPaths
copy ffih ffiHPath
copyFile (takeDirectory (head ffiHPaths) -/- takeFileName ffih) ffih
"inplace/lib/template-hsc.h" <~ pkgPath hsc2hs
"inplace/lib/platformConstants" <~ derivedConstantsPath
"inplace/lib/settings" <~ "."
where
file <~ dir = file %> \_ -> copy file dir
copy file dir = do
let source = dir -/- takeFileName file
copyFileChanged source file
putBuild $ "| Copy " ++ source ++ " -> " ++ file
file <~ dir = file %> \_ -> copyFile (dir -/- file) file
......@@ -118,10 +118,9 @@ buildPackageData rs target @ (PartialTarget stage pkg) = do
-- is replaced by libraries_deepseq_dist-install_VERSION = 1.4.0.0
-- Reason: Shake's built-in makefile parser doesn't recognise slashes
postProcessPackageData :: FilePath -> Action ()
postProcessPackageData file = do
contents <- fmap (filter ('$' `notElem`) . lines) . liftIO $ readFile file
length contents `seq` writeFileLines file $ map processLine contents
postProcessPackageData file = fixFile file fixPackageData
where
fixPackageData = unlines . map processLine . filter ('$' `notElem`) . lines
processLine line = replaceSeparators '_' prefix ++ suffix
where
processLine line = replaceSeparators '_' prefix ++ suffix
where
(prefix, suffix) = break (== '=') line
(prefix, suffix) = break (== '=') line
......@@ -59,7 +59,7 @@ buildWrapper :: PartialTarget -> Wrapper -> FilePath -> FilePath -> Action ()
buildWrapper target @ (PartialTarget stage pkg) wrapper wrapperPath binPath = do
contents <- interpretPartial target $ wrapper binPath
writeFileChanged wrapperPath contents
() <- cmd "chmod +x " [wrapperPath]
unit $ cmd "chmod +x " [wrapperPath]
putSuccess $ "| Successfully created wrapper for '" ++ pkgNameString pkg
++ "' (" ++ show stage ++ ")."
......
Markdown is supported
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