where indenting
This commit is contained in:
parent
6a0756d2fb
commit
2172cc586e
42 changed files with 1193 additions and 1209 deletions
|
@ -73,8 +73,7 @@ shaN shasize file filesize = do
|
|||
hClose h
|
||||
return output
|
||||
where
|
||||
p = (proc command args)
|
||||
{ std_out = CreatePipe }
|
||||
p = (proc command args) { std_out = CreatePipe }
|
||||
|
||||
shaCommand :: SHASize -> Integer -> Either (L.ByteString -> String) String
|
||||
shaCommand shasize filesize
|
||||
|
@ -87,9 +86,9 @@ shaCommand shasize filesize
|
|||
where
|
||||
use Nothing sha = Left $ showDigest . sha
|
||||
use (Just c) sha
|
||||
-- use builtin, but slower sha for small files
|
||||
-- benchmarking indicates it's faster up to
|
||||
-- and slightly beyond 50 kb files
|
||||
{- use builtin, but slower sha for small files
|
||||
- benchmarking indicates it's faster up to
|
||||
- and slightly beyond 50 kb files -}
|
||||
| filesize < 51200 = use Nothing sha
|
||||
| otherwise = Right c
|
||||
|
||||
|
|
|
@ -33,9 +33,9 @@ fromUrl url size = stubKey
|
|||
, keySize = size
|
||||
}
|
||||
where
|
||||
-- when it's not too long, use the url as the key name
|
||||
-- 256 is the absolute filename max, but use a shorter
|
||||
-- length because this is not the entire key filename.
|
||||
{- when it's not too long, use the url as the key name
|
||||
- 256 is the absolute filename max, but use a shorter
|
||||
- length because this is not the entire key filename. -}
|
||||
key
|
||||
| length url < 128 = url
|
||||
| otherwise = take 128 url ++ "-" ++ md5s (Str url)
|
||||
|
|
|
@ -46,8 +46,7 @@ tests =
|
|||
shaTestCases :: [(Int, String)] -> [TestCase]
|
||||
shaTestCases l = map make l
|
||||
where
|
||||
make (n, knowngood) =
|
||||
TestCase key $ maybeSelectCmd key $
|
||||
make (n, knowngood) = TestCase key $ maybeSelectCmd key $
|
||||
zip (shacmds n) (repeat check)
|
||||
where
|
||||
key = "sha" ++ show n
|
||||
|
|
|
@ -123,7 +123,7 @@ autoCopies file key vs a = Annex.getState Annex.auto >>= go
|
|||
go True = do
|
||||
numcopiesattr <- numCopies file
|
||||
needed <- getNumCopies numcopiesattr
|
||||
(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
|
||||
have <- trustExclude UnTrusted =<< Remote.keyLocations key
|
||||
if length have `vs` needed then a else stop
|
||||
|
||||
autoCopiesWith :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
|
||||
|
@ -134,7 +134,7 @@ autoCopiesWith file key vs a = do
|
|||
auto numcopiesattr False = a numcopiesattr
|
||||
auto numcopiesattr True = do
|
||||
needed <- getNumCopies numcopiesattr
|
||||
(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
|
||||
have <- trustExclude UnTrusted =<< Remote.keyLocations key
|
||||
if length have `vs` needed
|
||||
then a numcopiesattr
|
||||
else stop
|
||||
|
|
|
@ -166,7 +166,8 @@ options = Option.common ++
|
|||
"stop after the specified amount of time"
|
||||
] ++ Option.matcher
|
||||
where
|
||||
setnumcopies v = Annex.changeState $ \s -> s { Annex.forcenumcopies = readish v }
|
||||
setnumcopies v = Annex.changeState $
|
||||
\s -> s { Annex.forcenumcopies = readish v }
|
||||
setgitconfig :: String -> Annex ()
|
||||
setgitconfig v = do
|
||||
newg <- inRepo $ Git.Config.store v
|
||||
|
|
|
@ -45,9 +45,7 @@ cmds_notreadonly = concat
|
|||
cmds :: [Command]
|
||||
cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
|
||||
where
|
||||
adddirparam c = c
|
||||
{ cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c
|
||||
}
|
||||
adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
|
||||
|
||||
options :: [OptDescr (Annex ())]
|
||||
options = Option.common ++
|
||||
|
|
|
@ -144,8 +144,7 @@ runTransfer t file shouldretry a = do
|
|||
| otherwise = do
|
||||
f <- fromRepo $ gitAnnexTmpLocation (transferKey t)
|
||||
liftIO $ catchDefaultIO 0 $
|
||||
fromIntegral . fileSize
|
||||
<$> getFileStatus f
|
||||
fromIntegral . fileSize <$> getFileStatus f
|
||||
|
||||
{- Generates a callback that can be called as transfer progresses to update
|
||||
- the transfer info file. Also returns the file it'll be updating, and a
|
||||
|
@ -208,8 +207,7 @@ getTransfers = do
|
|||
filter running $ zip transfers infos
|
||||
where
|
||||
findfiles = liftIO . mapM dirContentsRecursive
|
||||
=<< mapM (fromRepo . transferDir)
|
||||
[Download, Upload]
|
||||
=<< mapM (fromRepo . transferDir) [Download, Upload]
|
||||
running (_, i) = isJust i
|
||||
|
||||
{- Gets failed transfers for a given remote UUID. -}
|
||||
|
@ -223,8 +221,7 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles
|
|||
(Just t, Just i) -> Just (t, i)
|
||||
_ -> Nothing
|
||||
findfiles = liftIO . mapM dirContentsRecursive
|
||||
=<< mapM (fromRepo . failedTransferDir u)
|
||||
[Download, Upload]
|
||||
=<< mapM (fromRepo . failedTransferDir u) [Download, Upload]
|
||||
|
||||
removeFailedTransfer :: Transfer -> Annex ()
|
||||
removeFailedTransfer t = do
|
||||
|
|
|
@ -88,9 +88,8 @@ trustMapLoad = do
|
|||
Annex.changeState $ \s -> s { Annex.trustmap = Just m }
|
||||
return m
|
||||
where
|
||||
configuredtrust r =
|
||||
maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$>
|
||||
maybe Nothing readTrustLevel
|
||||
configuredtrust r = maybe Nothing (\l -> Just (Types.Remote.uuid r, l))
|
||||
<$> maybe Nothing readTrustLevel
|
||||
<$> getTrustLevel (Types.Remote.repo r)
|
||||
|
||||
{- Does not include forcetrust or git config values, just those from the
|
||||
|
|
|
@ -36,8 +36,7 @@ readUnusedLog prefix = do
|
|||
, return M.empty
|
||||
)
|
||||
where
|
||||
parse line =
|
||||
case (readish tag, file2key rest) of
|
||||
parse line = case (readish tag, file2key rest) of
|
||||
(Just num, Just key) -> Just (num, key)
|
||||
_ -> Nothing
|
||||
where
|
||||
|
|
|
@ -167,7 +167,8 @@ checkPresent r bupr k
|
|||
where
|
||||
params =
|
||||
[ Params "show-ref --quiet --verify"
|
||||
, Param $ "refs/heads/" ++ bupRef k]
|
||||
, Param $ "refs/heads/" ++ bupRef k
|
||||
]
|
||||
|
||||
{- Store UUID in the annex.uuid setting of the bup repository. -}
|
||||
storeBupUUID :: UUID -> BupRepo -> Annex ()
|
||||
|
|
|
@ -57,7 +57,6 @@ gen r u c = do
|
|||
readonly = False,
|
||||
remotetype = remote
|
||||
}
|
||||
where
|
||||
|
||||
type ChunkSize = Maybe Int64
|
||||
|
||||
|
@ -109,14 +108,14 @@ withCheckedFiles check (Just _) d k a = go $ locations d k
|
|||
go [] = return False
|
||||
go (f:fs) = do
|
||||
let chunkcount = chunkCount f
|
||||
use <- check chunkcount
|
||||
if use
|
||||
then do
|
||||
ifM (check chunkcount)
|
||||
( do
|
||||
count <- readcount chunkcount
|
||||
let chunks = take count $ chunkStream f
|
||||
ifM (all id <$> mapM check chunks)
|
||||
( a chunks , return False )
|
||||
else go fs
|
||||
, go fs
|
||||
)
|
||||
readcount f = fromMaybe (error $ "cannot parse " ++ f)
|
||||
. (readish :: String -> Maybe Int)
|
||||
<$> readFile f
|
||||
|
|
|
@ -67,8 +67,7 @@ runHooks r starthook stophook a = do
|
|||
-- So, requiring idempotency is the right approach.
|
||||
run starthook
|
||||
|
||||
Annex.addCleanup (remoteid ++ "-stop-command") $
|
||||
runstop lck
|
||||
Annex.addCleanup (remoteid ++ "-stop-command") $ runstop lck
|
||||
runstop lck = do
|
||||
-- Drop any shared lock we have, and take an
|
||||
-- exclusive lock, without blocking. If the lock
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex remote access with ssh
|
||||
-
|
||||
- Copyright 2011.2012 Joey Hess <joey@kitenet.net>
|
||||
- Copyright 2011,2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
|
|
@ -65,8 +65,7 @@ hookSetup u c = do
|
|||
hookEnv :: Key -> Maybe FilePath -> IO (Maybe [(String, String)])
|
||||
hookEnv k f = Just <$> mergeenv (fileenv f ++ keyenv)
|
||||
where
|
||||
mergeenv l = M.toList .
|
||||
M.union (M.fromList l)
|
||||
mergeenv l = M.toList . M.union (M.fromList l)
|
||||
<$> M.fromList <$> getEnvironment
|
||||
env s v = ("ANNEX_" ++ s, v)
|
||||
keyenv = catMaybes
|
||||
|
@ -94,9 +93,7 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
|
|||
where
|
||||
run command = do
|
||||
showOutput -- make way for hook output
|
||||
ifM (liftIO $
|
||||
boolSystemEnv "sh" [Param "-c", Param command]
|
||||
=<< hookEnv k f)
|
||||
ifM (liftIO $ boolSystemEnv "sh" [Param "-c", Param command] =<< hookEnv k f)
|
||||
( a
|
||||
, do
|
||||
warning $ hook ++ " hook exited nonzero!"
|
||||
|
|
13
Remote/S3.hs
13
Remote/S3.hs
|
@ -102,19 +102,16 @@ s3Setup u c = handlehost $ M.lookup "host" c
|
|||
use archiveconfig
|
||||
where
|
||||
archiveconfig =
|
||||
-- hS3 does not pass through
|
||||
-- x-archive-* headers
|
||||
-- hS3 does not pass through x-archive-* headers
|
||||
M.mapKeys (replace "x-archive-" "x-amz-") $
|
||||
-- encryption does not make sense here
|
||||
M.insert "encryption" "none" $
|
||||
M.union c $
|
||||
-- special constraints on key names
|
||||
M.insert "mungekeys" "ia" $
|
||||
-- bucket created only when files
|
||||
-- are uploaded
|
||||
-- bucket created only when files are uploaded
|
||||
M.insert "x-amz-auto-make-bucket" "1" $
|
||||
-- no default bucket name; should
|
||||
-- be human-readable
|
||||
-- no default bucket name; should be human-readable
|
||||
M.delete "bucket" defaults
|
||||
|
||||
store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
|
||||
|
@ -303,8 +300,8 @@ s3GetCreds c u = maybe fromcache (return . Just) =<< liftIO getenv
|
|||
return $ Just (ak, sk)
|
||||
_ -> do error "bad s3creds"
|
||||
_ -> return Nothing
|
||||
decrypt s3creds cipher = lines <$>
|
||||
withDecryptedContent cipher
|
||||
decrypt s3creds cipher = lines
|
||||
<$> withDecryptedContent cipher
|
||||
(return $ L.pack $ fromB64 s3creds)
|
||||
(return . L.unpack)
|
||||
|
||||
|
|
5
Seek.hs
5
Seek.hs
|
@ -112,9 +112,8 @@ prepFiltered a fs = do
|
|||
matcher <- Limit.getMatcher
|
||||
map (process matcher) <$> fs
|
||||
where
|
||||
process matcher f = do
|
||||
ok <- matcher $ Annex.FileInfo f f
|
||||
if ok then a f else return Nothing
|
||||
process matcher f = ifM (matcher $ Annex.FileInfo f f)
|
||||
( a f , return Nothing )
|
||||
|
||||
notSymlink :: FilePath -> IO Bool
|
||||
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue