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

src/Base.hs

@@ -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 = ( "╭──────────"

src/Rules/Actions.hs

 {-# 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

src/Rules/Copy.hs

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

src/Rules/Data.hs

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

src/Rules/Program.hs

@@ -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 ++ ")."