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

Ben Gamari's avatar
Ben Gamari committed
3
import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
4 5
import Oracles.Config.Flag
import Oracles.Config.Setting
6
import Predicate
7

8 9 10 11
arBuilderArgs :: Args
arBuilderArgs = builder Ar ? mconcat [ arg "q"
                                     , arg =<< getOutput
                                     , append =<< getInputs ]
12

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

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

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

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

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