Ar.hs 2.41 KB
Newer Older
1
module Settings.Builders.Ar (arBuilderArgs, arCmd) where
2

Ben Gamari's avatar
Ben Gamari committed
3
import Base
4
import Expression
5
import Oracles
6
import Predicates (builder)
7

8
-- | Default arguments for 'Ar' builder
9 10 11 12
arBuilderArgs :: Args
arBuilderArgs = builder Ar ? mconcat [ arg "q"
                                     , arg =<< getOutput
                                     , append =<< getInputs ]
13

14 15
-- This count includes arg "q" and arg file parameters in arBuilderArgs.
-- Update this value appropriately when changing arBuilderArgs.
16 17 18
arFlagsCount :: Int
arFlagsCount = 2

19 20 21 22 23 24 25 26 27
-- | Invoke 'Ar' builder given a path to it and a list of arguments. Take care
-- not to exceed the limit on command line length, which differs across
-- supported operating systems (see 'cmdLineLengthLimit'). 'Ar' needs to be
-- handled in a special way because we sometimes need to archive __a lot__ of
-- files (in Cabal package, 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, or alternatively, we split argument list
-- into chunks and call 'Ar' multiple times (when passing arguments via a
-- temporary file is not supported).
28 29 30 31 32 33 34
arCmd :: FilePath -> [String] -> Action ()
arCmd path argList = do
    arSupportsAtFile <- flag ArSupportsAtFile
    let flagArgs = take arFlagsCount argList
        fileArgs = drop arFlagsCount argList
    if arSupportsAtFile
    then useAtFile path flagArgs fileArgs
35
    else useSuccessiveInvocations path flagArgs fileArgs
36 37 38 39 40 41

useAtFile :: FilePath -> [String] -> [String] -> Action ()
useAtFile path flagArgs fileArgs = withTempFile $ \tmp -> do
    writeFile' tmp $ unwords fileArgs
    cmd [path] flagArgs ('@' : tmp)

42 43
useSuccessiveInvocations :: FilePath -> [String] -> [String] -> Action ()
useSuccessiveInvocations path flagArgs fileArgs = do
44 45 46
    maxChunk <- cmdLineLengthLimit
    forM_ (chunksOfSize maxChunk fileArgs) $ \argsChunk ->
        unit . cmd [path] $ flagArgs ++ argsChunk
47 48 49 50 51 52 53 54 55 56 57 58 59 60

-- | @chunksOfSize size strings@ splits a given list of strings into chunks not
-- exceeding the given @size@.
chunksOfSize :: Int -> [String] -> [[String]]
chunksOfSize _    [] = []
chunksOfSize size strings = reverse chunk : chunksOfSize size rest
  where
    (chunk, rest) = go [] 0 strings
    go res _         []     = (res, [])
    go res chunkSize (s:ss) =
        if newSize > size then (res, s:ss) else go (s:res) newSize ss
      where
        newSize = chunkSize + length s