hadrian: Refactor handling of ar flags

Previously the setup was quite fragile as it had to assume which
arguments were file arguments and which were flags.

5 files changed, 37 insertions, 31 deletions

diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 560402f1a0..e181615d13 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -101,6 +101,7 @@ executable hadrian
                        , Settings.Builders.Happy
                        , Settings.Builders.Hsc2Hs
                        , Settings.Builders.HsCpp
+                       , Settings.Builders.Ar
                        , Settings.Builders.Ld
                        , Settings.Builders.Make
                        , Settings.Builders.MergeObjects
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
index 6d95ca5573..e29bf4316c 100644
--- a/hadrian/src/Builder.hs
+++ b/hadrian/src/Builder.hs
@@ -311,8 +311,8 @@ instance H.Builder Builder where
             case builder of
                 Ar Pack _ -> do
                     useTempFile <- flag ArSupportsAtFile
-                    if useTempFile then runAr                path buildArgs
-                                   else runArWithoutTempFile path buildArgs
+                    if useTempFile then runAr                path buildArgs buildInputs
+                                   else runArWithoutTempFile path buildArgs buildInputs
 
                 Ar Unpack _ -> cmd' [Cwd output] [path] buildArgs
 
diff --git a/hadrian/src/Hadrian/Builder/Ar.hs b/hadrian/src/Hadrian/Builder/Ar.hs
index 7086f6d48c..332929a6fa 100644
--- a/hadrian/src/Hadrian/Builder/Ar.hs
+++ b/hadrian/src/Hadrian/Builder/Ar.hs
@@ -16,13 +16,12 @@
 -- and call @ar@ multiple times, e.g. when passing arguments via a temporary
 -- file is not supported (see 'runArWithoutTempFile').
 -----------------------------------------------------------------------------
-module Hadrian.Builder.Ar (ArMode (..), args, runAr, runArWithoutTempFile) where
+module Hadrian.Builder.Ar (ArMode (..), runAr, runArWithoutTempFile) where
 
 import Control.Monad
 import Development.Shake
 import Development.Shake.Classes
 import GHC.Generics
-import Hadrian.Expression
 import Hadrian.Utilities
 
 -- | We support packing and unpacking archives with @ar@.
@@ -32,37 +31,26 @@ instance Binary   ArMode
 instance Hashable ArMode
 instance NFData   ArMode
 
--- NOTE: Make sure to appropriately update 'arFlagsCount' when changing 'args'.
--- | Default command line arguments for invoking the archiving utility @ar@.
-args :: (ShakeValue c, ShakeValue b) => ArMode -> Args c b
-args Pack   = mconcat [ arg "q", arg =<< getOutput, getInputs ]
-args Unpack = mconcat [ arg "x", arg =<< getInput ]
-
--- This count includes "q" and the output file arguments in 'args'. This is
--- only relevant for the 'Pack' @ar@ mode.
-arFlagsCount :: Int
-arFlagsCount = 2
-
 -- | Invoke @ar@ given a path to it and a list of arguments. The list of files
--- to be archived is passed via a temporary file. Passing arguments via a
--- temporary file is not supported by some versions of @ar@, in which case you
--- should use 'runArWithoutTempFile' instead.
-runAr :: FilePath -> [String] -> Action ()
-runAr arPath argList = withTempFile $ \tmp -> do
+-- to be archived is passed via a temporary response file. Passing arguments
+-- via a response file is not supported by some versions of @ar@, in which
+-- case you should use 'runArWithoutTempFile' instead.
+runAr :: FilePath    -- ^ path to @ar@
+      -> [String]    -- ^ other arguments
+      -> [FilePath]  -- ^ input file paths
+      -> Action ()
+runAr arPath flagArgs fileArgs = withTempFile $ \tmp -> do
     writeFile' tmp $ unwords fileArgs
     cmd [arPath] flagArgs ('@' : tmp)
-  where
-    flagArgs = take arFlagsCount argList
-    fileArgs = drop arFlagsCount argList
 
 -- | Invoke @ar@ given a path to it and a list of arguments. Note that @ar@
 -- will be called multiple times if the list of files to be archived is too
 -- long and doesn't fit into the command line length limit. This function is
 -- typically much slower than 'runAr'.
-runArWithoutTempFile :: FilePath -> [String] -> Action ()
-runArWithoutTempFile arPath argList =
+runArWithoutTempFile :: FilePath    -- ^ path to @ar@
+                     -> [String]    -- ^ other arguments
+                     -> [FilePath]  -- ^ input file paths
+                     -> Action ()
+runArWithoutTempFile arPath flagArgs fileArgs =
     forM_ (chunksOfSize cmdLineLengthLimit fileArgs) $ \argsChunk ->
         unit . cmd [arPath] $ flagArgs ++ argsChunk
-  where
-    flagArgs = take arFlagsCount argList
-    fileArgs = drop arFlagsCount argList
diff --git a/hadrian/src/Settings/Builders/Ar.hs b/hadrian/src/Settings/Builders/Ar.hs
new file mode 100644
index 0000000000..a4b08d6358
--- /dev/null
+++ b/hadrian/src/Settings/Builders/Ar.hs
@@ -0,0 +1,18 @@
+module Settings.Builders.Ar (arBuilderArgs) where
+
+import Settings.Builders.Common
+
+-- | Note that we do *not* emit arguments for the input paths here since we may
+-- want to place these in a response file. This is handled in
+-- 'Hadrian.Builder.Ar.runAr'.
+arBuilderArgs :: Args
+arBuilderArgs = mconcat
+    [ builder (Ar Pack) ? mconcat
+      [ arg "q"
+      , arg =<< getOutput
+      ]
+    , builder (Ar Unpack) ? mconcat
+      [ arg "x"
+      , arg =<< getInput
+      ]
+    ]
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 441f009107..81e27ed785 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -13,7 +13,6 @@ module Settings.Default (
     defaultFlavour, defaultBignumBackend
     ) where
 
-import qualified Hadrian.Builder.Ar
 import qualified Hadrian.Builder.Sphinx
 import qualified Hadrian.Builder.Tar
 import Hadrian.Haskell.Cabal.Type
@@ -36,6 +35,7 @@ import Settings.Builders.Haddock
 import Settings.Builders.Happy
 import Settings.Builders.Hsc2Hs
 import Settings.Builders.HsCpp
+import Settings.Builders.Ar
 import Settings.Builders.Ld
 import Settings.Builders.Make
 import Settings.Builders.MergeObjects
@@ -267,6 +267,7 @@ defaultBuilderArgs = mconcat
     , hsc2hsBuilderArgs
     , hsCppBuilderArgs
     , ldBuilderArgs
+    , arBuilderArgs
     , makeBuilderArgs
     , mergeObjectsBuilderArgs
     , runTestBuilderArgs
@@ -274,8 +275,6 @@ defaultBuilderArgs = mconcat
     , xelatexBuilderArgs
     , win32TarballsArgs
     -- Generic builders from the Hadrian library:
-    , builder (Ar Pack         ) ? Hadrian.Builder.Ar.args Pack
-    , builder (Ar Unpack       ) ? Hadrian.Builder.Ar.args Unpack
     , builder (Sphinx HtmlMode ) ? Hadrian.Builder.Sphinx.args HtmlMode
     , builder (Sphinx LatexMode) ? Hadrian.Builder.Sphinx.args LatexMode
     , builder (Sphinx ManMode  ) ? Hadrian.Builder.Sphinx.args ManMode