[commit: ghc] wip/nfs-locking: Move chunksOfSize to Settings/Builders/Ar.hs, add comments. (5e3f91f)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:46:52 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/5e3f91f9d050c91f8fd842b9548093c0d8d8e532/ghc
>---------------------------------------------------------------
commit 5e3f91f9d050c91f8fd842b9548093c0d8d8e532
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Sat Jan 9 16:57:49 2016 +0000
Move chunksOfSize to Settings/Builders/Ar.hs, add comments.
See #130. [skip ci]
>---------------------------------------------------------------
5e3f91f9d050c91f8fd842b9548093c0d8d8e532
src/Base.hs | 19 +++----------------
src/Settings/Builders/Ar.hs | 28 ++++++++++++++++++++++++----
2 files changed, 27 insertions(+), 20 deletions(-)
diff --git a/src/Base.hs b/src/Base.hs
index fb33907..65a2d1d 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -22,9 +22,9 @@ module Base (
putColoured, putOracle, putBuild, putSuccess, putError, renderBox,
-- * Miscellaneous utilities
- bimap, minusOrd, intersectOrd, replaceEq, quote, chunksOfSize,
- replaceSeparators, decodeModule, encodeModule, unifyPath, (-/-),
- versionToInt, removeFileIfExists, removeDirectoryIfExists
+ bimap, minusOrd, intersectOrd, replaceEq, quote, replaceSeparators,
+ decodeModule, encodeModule, unifyPath, (-/-), versionToInt,
+ removeFileIfExists, removeDirectoryIfExists
) where
import Control.Applicative
@@ -90,19 +90,6 @@ replaceSeparators = replaceWhen isPathSeparator
replaceWhen :: (a -> Bool) -> a -> [a] -> [a]
replaceWhen p to = map (\from -> if p from then to else from)
--- | @chunksOfSize size strings@ splits a given list of strings into chunks not
--- exceeding the given @size at .
-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
-
-- | Add quotes to a String
quote :: String -> String
quote s = "\"" ++ s ++ "\""
diff --git a/src/Settings/Builders/Ar.hs b/src/Settings/Builders/Ar.hs
index 18ce802..86f4310 100644
--- a/src/Settings/Builders/Ar.hs
+++ b/src/Settings/Builders/Ar.hs
@@ -5,6 +5,7 @@ import Expression
import Oracles
import Predicates (builder)
+-- | Default arguments for 'Ar' builder
arBuilderArgs :: Args
arBuilderArgs = builder Ar ? mconcat [ arg "q"
, arg =<< getOutput
@@ -15,10 +16,15 @@ arBuilderArgs = builder Ar ? mconcat [ arg "q"
arFlagsCount :: Int
arFlagsCount = 2
--- Ar needs to be invoked in a special way: we pass the list of files to be
--- archived via a temporary file as otherwise Ar (or rather Windows command
--- line) chokes up. Alternatively, we split argument list into chunks and call
--- ar multiple times (when passing files via a separate file is not supported).
+-- | 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).
arCmd :: FilePath -> [String] -> Action ()
arCmd path argList = do
arSupportsAtFile <- flag ArSupportsAtFile
@@ -38,3 +44,17 @@ useSuccessiveInvocations path flagArgs fileArgs = do
maxChunk <- cmdLineLengthLimit
forM_ (chunksOfSize maxChunk fileArgs) $ \argsChunk ->
unit . cmd [path] $ flagArgs ++ argsChunk
+
+-- | @chunksOfSize size strings@ splits a given list of strings into chunks not
+-- exceeding the given @size at .
+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
+
More information about the ghc-commits
mailing list