3 files changed, 147 insertions, 0 deletions
diff --git a/src/Hadrian/Builder/Ar.hs b/src/Hadrian/Builder/Ar.hs
new file mode 100644
index 0000000000..ad74653db0
--- /dev/null
+++ b/src/Hadrian/Builder/Ar.hs
@@ -0,0 +1,68 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Builder.Ar
+-- Copyright  : (c) Andrey Mokhov 2014-2017
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- Support for invoking the archiving utility @ar@. We take care not to exceed
+-- the limit on command line length, which differs across supported operating
+-- systems (see 'cmdLineLengthLimit'). We need to handle @ar@ in a special way
+-- because we sometimes archive __a lot__ of files (in the Cabal library, for
+-- example, command line length can reach 2MB!). To work around the limit on the
+-- command line length we pass the list of files to be archived via a temporary
+-- file (see 'runAr'), or alternatively, we split the argument list into chunks
+-- 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
+
+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@.
+data ArMode = Pack | Unpack deriving (Eq, Generic, Show)
+
+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 argumentes 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
+    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 =
+    forM_ (chunksOfSize cmdLineLengthLimit fileArgs) $ \argsChunk ->
+        unit . cmd [arPath] $ flagArgs ++ argsChunk
+  where
+    flagArgs = take arFlagsCount argList
+    fileArgs = drop arFlagsCount argList
diff --git a/src/Hadrian/Builder/Sphinx.hs b/src/Hadrian/Builder/Sphinx.hs
new file mode 100644
index 0000000000..44b522c4d3
--- /dev/null
+++ b/src/Hadrian/Builder/Sphinx.hs
@@ -0,0 +1,39 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Builder.Sphinx
+-- Copyright  : (c) Andrey Mokhov 2014-2017
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- Support for invoking the documentation utility Sphinx.
+-----------------------------------------------------------------------------
+module Hadrian.Builder.Sphinx (SphinxMode (..), args) where
+
+import Development.Shake
+import Development.Shake.Classes
+import GHC.Generics
+import Hadrian.Expression
+import Hadrian.Utilities
+
+-- | Sphinx can be used in three different modes to convert reStructuredText
+-- documents into HTML, LaTeX or Man pages.
+data SphinxMode = Html | Latex | Man deriving (Eq, Generic, Show)
+
+instance Binary   SphinxMode
+instance Hashable SphinxMode
+instance NFData   SphinxMode
+
+-- | Default command line arguments for invoking the archiving utility @tar@.
+args :: (ShakeValue c, ShakeValue b) => SphinxMode -> Args c b
+args mode = do
+    outPath <- getOutput
+    mconcat [ arg "-b", arg modeString
+            , arg "-d", arg $ outPath -/- (".doctrees-" ++ modeString)
+            , arg =<< getInput
+            , arg outPath ]
+  where
+    modeString = case mode of
+        Html  -> "html"
+        Latex -> "latex"
+        Man   -> "man"
diff --git a/src/Hadrian/Builder/Tar.hs b/src/Hadrian/Builder/Tar.hs
new file mode 100644
index 0000000000..d51e3c7bee
--- /dev/null
+++ b/src/Hadrian/Builder/Tar.hs
@@ -0,0 +1,40 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Builder.Tar
+-- Copyright  : (c) Andrey Mokhov 2014-2017
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- Support for invoking the archiving utility @tar@.
+-----------------------------------------------------------------------------
+module Hadrian.Builder.Tar (TarMode (..), args) where
+
+import Development.Shake
+import Development.Shake.Classes
+import GHC.Generics
+import Hadrian.Expression
+
+-- | Tar can be used to 'Create' an archive or 'Extract' from it.
+data TarMode = Create | Extract deriving (Eq, Generic, Show)
+
+instance Binary   TarMode
+instance Hashable TarMode
+instance NFData   TarMode
+
+-- | Default command line arguments for invoking the archiving utility @tar@.
+args :: (ShakeValue c, ShakeValue b) => TarMode -> Args c b
+args Create = mconcat
+    [ arg "-c"
+    , output "//*.gz"  ? arg "--gzip"
+    , output "//*.bz2" ? arg "--bzip2"
+    , output "//*.xz"  ? arg "--xz"
+    , arg "-f", arg =<< getOutput
+    , getInputs ]
+args Extract = mconcat
+    [ arg "-x"
+    , input "*.gz"  ? arg "--gzip"
+    , input "*.bz2" ? arg "--bzip2"
+    , input "*.xz"  ? arg "--xz"
+    , arg "-f", arg =<< getInput
+    , arg "-C", arg =<< getOutput ]