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

3
import Settings.Builders.Common
4

5 6 7
arBuilderArgs :: Args
arBuilderArgs = builder Ar ? mconcat [ arg "q"
                                     , arg =<< getOutput
Andrey Mokhov's avatar
Andrey Mokhov committed
8
                                     , getInputs ]
9

10 11
-- This count includes arg "q" and arg file parameters in arBuilderArgs.
-- Update this value appropriately when changing arBuilderArgs.
12 13 14
arFlagsCount :: Int
arFlagsCount = 2

15 16 17 18 19 20 21 22 23
-- | 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).
24 25 26 27 28 29 30
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
31
    else useSuccessiveInvocations path flagArgs fileArgs
32 33 34 35 36 37

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

38 39
useSuccessiveInvocations :: FilePath -> [String] -> [String] -> Action ()
useSuccessiveInvocations path flagArgs fileArgs = do
40 41 42
    maxChunk <- cmdLineLengthLimit
    forM_ (chunksOfSize maxChunk fileArgs) $ \argsChunk ->
        unit . cmd [path] $ flagArgs ++ argsChunk
43 44

-- | @chunksOfSize size strings@ splits a given list of strings into chunks not
45
-- exceeding the given @size@. If that is impossible, it uses singleton chunks.
46
chunksOfSize :: Int -> [String] -> [[String]]
47 48
chunksOfSize n = repeatedly f
    where f xs = splitAt (max 1 $ length $ takeWhile (<= n) $ scanl1 (+) $ map length xs) xs