This commit is contained in:
Joey Hess 2014-10-09 15:35:19 -04:00
parent dd667844b6
commit b61c6bc2ff
18 changed files with 50 additions and 52 deletions

View file

@ -147,7 +147,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
let threads = if isJust cannotrun
then webappthread
else webappthread ++
[ watch $ commitThread
[ watch commitThread
#ifdef WITH_WEBAPP
#ifdef WITH_PAIRING
, assist $ pairListenerThread urlrenderer
@ -158,29 +158,29 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
, assist $ xmppReceivePackThread urlrenderer
#endif
#endif
, assist $ pushThread
, assist $ pushRetryThread
, assist $ mergeThread
, assist $ transferWatcherThread
, assist $ transferPollerThread
, assist $ transfererThread
, assist $ remoteControlThread
, assist $ daemonStatusThread
, assist pushThread
, assist pushRetryThread
, assist mergeThread
, assist transferWatcherThread
, assist transferPollerThread
, assist transfererThread
, assist remoteControlThread
, assist daemonStatusThread
, assist $ sanityCheckerDailyThread urlrenderer
, assist $ sanityCheckerHourlyThread
, assist sanityCheckerHourlyThread
, assist $ problemFixerThread urlrenderer
#ifdef WITH_CLIBS
, assist $ mountWatcherThread urlrenderer
#endif
, assist $ netWatcherThread
, assist netWatcherThread
, assist $ upgraderThread urlrenderer
, assist $ upgradeWatcherThread urlrenderer
, assist $ netWatcherFallbackThread
, assist netWatcherFallbackThread
, assist $ transferScannerThread urlrenderer
, assist $ cronnerThread urlrenderer
, assist $ configMonitorThread
, assist $ glacierThread
, watch $ watchThread
, assist configMonitorThread
, assist glacierThread
, watch watchThread
-- must come last so that all threads that wait
-- on it have already started waiting
, watch $ sanityCheckerStartupThread startdelay

View file

@ -6,7 +6,6 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module CmdLine (
dispatch,

View file

@ -177,14 +177,14 @@ ingest (Just source) = withTSDelta $ \delta -> do
(undo (keyFilename source) key)
maybe noop (genMetaData key (keyFilename source)) ms
liftIO $ nukeFile $ keyFilename source
return $ (Just key, mcache)
return (Just key, mcache)
goindirect _ _ _ = failure "failed to generate a key"
godirect (Just (key, _)) (Just cache) ms = do
addInodeCache key cache
maybe noop (genMetaData key (keyFilename source)) ms
finishIngestDirect key source
return $ (Just key, Just cache)
return (Just key, Just cache)
godirect _ _ _ = failure "failed to generate a key"
failure msg = do

View file

@ -30,7 +30,7 @@ start gcryptid = next $ next $ do
g <- gitRepo
gu <- Remote.GCrypt.getGCryptUUID True g
let newgu = genUUIDInNameSpace gCryptNameSpace gcryptid
if gu == Nothing || gu == Just newgu
if isNothing gu || gu == Just newgu
then if Git.repoIsLocalBare g
then do
void $ Remote.GCrypt.setupRepo gcryptid g

View file

@ -96,7 +96,7 @@ start mode (srcfile, destfile) =
handleexisting Nothing = noop
handleexisting (Just s)
| isDirectory s = notoverwriting "(is a directory)"
| otherwise = ifM (Annex.getState Annex.force) $
| otherwise = ifM (Annex.getState Annex.force)
( liftIO $ nukeFile destfile
, notoverwriting "(use --force to override)"
)

View file

@ -264,7 +264,7 @@ backend_usage = stat "backend usage" $ nojson $
where
calc x y = multiLine $
map (\(n, b) -> b ++ ": " ++ show n) $
reverse $ sort $ map swap $ M.toList $
sortBy (flip compare) $ map swap $ M.toList $
M.unionWith (+) x y
numcopies_stats :: Stat
@ -273,7 +273,7 @@ numcopies_stats = stat "numcopies stats" $ nojson $
where
calc = multiLine
. map (\(variance, count) -> show variance ++ ": " ++ show count)
. reverse . sortBy (comparing snd) . M.toList
. sortBy (flip (comparing snd)) . M.toList
cachedPresentData :: StatState KeyData
cachedPresentData = do

View file

@ -63,7 +63,7 @@ findExisting name = do
return $ headMaybe matches
newConfig :: String -> R.RemoteConfig
newConfig name = M.singleton nameKey name
newConfig = M.singleton nameKey
findByName :: String -> M.Map UUID R.RemoteConfig -> [(UUID, R.RemoteConfig)]
findByName n = filter (matching . snd) . M.toList

View file

@ -32,7 +32,7 @@ seek ps = do
ps
start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
start to from file key = startKey to from (Just file) key
start to from file = startKey to from (Just file)
startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
startKey to from afile key = do

View file

@ -34,7 +34,7 @@ seek ps = do
ps
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
start to from move file key = start' to from move (Just file) key
start to from move = start' to from move . Just
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
startKey to from move = start' to from move Nothing
@ -91,7 +91,7 @@ expectedPresent dest key = do
return $ dest `elem` remotes
toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
toPerform dest move key afile fastcheck isthere = do
toPerform dest move key afile fastcheck isthere =
case isthere of
Left err -> do
showNote err

View file

@ -51,7 +51,7 @@ start = do
-- No messages need to be received from the caller,
-- but when it closes the connection, notice and terminate.
let receiver = forever $ void $ getLine
let receiver = forever $ void getLine
void $ liftIO $ concurrently sender receiver
stop

View file

@ -22,16 +22,15 @@ seek = withWords start
start :: [String] -> CommandStart
start [] = startGet
start [s] = do
case readish s of
Nothing -> error $ "Bad number: " ++ s
Just n
| n > 0 -> startSet n
| n == 0 -> ifM (Annex.getState Annex.force)
( startSet n
, error "Setting numcopies to 0 is very unsafe. You will lose data! If you really want to do that, specify --force."
)
| otherwise -> error "Number cannot be negative!"
start [s] = case readish s of
Nothing -> error $ "Bad number: " ++ s
Just n
| n > 0 -> startSet n
| n == 0 -> ifM (Annex.getState Annex.force)
( startSet n
, error "Setting numcopies to 0 is very unsafe. You will lose data! If you really want to do that, specify --force."
)
| otherwise -> error "Number cannot be negative!"
start _ = error "Specify a single number."
startGet :: CommandStart
@ -39,9 +38,9 @@ startGet = next $ next $ do
Annex.setOutput QuietOutput
v <- getGlobalNumCopies
case v of
Just n -> liftIO $ putStrLn $ show $ fromNumCopies n
Just n -> liftIO $ print $ fromNumCopies n
Nothing -> do
liftIO $ putStrLn $ "global numcopies is not set"
liftIO $ putStrLn "global numcopies is not set"
old <- deprecatedNumCopies
case old of
Nothing -> liftIO $ putStrLn "(default is 1)"

View file

@ -59,7 +59,7 @@ startIndirect f = next $ do
next $ return True
startDirect :: [String] -> CommandStart
startDirect _ = next $ next $ preCommitDirect
startDirect _ = next $ next preCommitDirect
addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
addViewMetaData v f k = do

View file

@ -68,7 +68,7 @@ repairAnnexBranch modifiedbranches
)
)
where
okindex = Annex.Branch.withIndex $ inRepo $ Git.Repair.checkIndex
okindex = Annex.Branch.withIndex $ inRepo Git.Repair.checkIndex
commitindex = do
Annex.Branch.forceCommit "committing index after git repository repair"
liftIO $ putStrLn "Successfully recovered the git-annex branch using .git/annex/index"

View file

@ -19,7 +19,7 @@ def = [command "resolvemerge" paramNothing seek SectionPlumbing
"resolve merge conflicts"]
seek :: CommandSeek
seek ps = withNothing start ps
seek = withNothing start
start :: CommandStart
start = do

View file

@ -82,7 +82,7 @@ addExclude = addLimit . limitExclude
limitExclude :: MkLimit Annex
limitExclude glob = Right $ const $ return . not . matchGlobFile glob
matchGlobFile :: String -> (MatchInfo -> Bool)
matchGlobFile :: String -> MatchInfo -> Bool
matchGlobFile glob = go
where
cglob = compileGlob glob CaseSensative -- memoized

View file

@ -173,7 +173,7 @@ prop_logs_sane dummykey = and
, expect gotNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)
, expect gotChunkLog (getLogVariety $ chunkLogFile dummykey)
, expect gotOtherLog (getLogVariety $ metaDataLogFile dummykey)
, expect gotOtherLog (getLogVariety $ numcopiesLog)
, expect gotOtherLog (getLogVariety numcopiesLog)
]
where
expect = maybe False

View file

@ -103,12 +103,12 @@ byNameWithUUID = checkuuid <=< byName
where
checkuuid Nothing = return Nothing
checkuuid (Just r)
| uuid r == NoUUID =
| uuid r == NoUUID = error $
if remoteAnnexIgnore (gitconfig r)
then error $ noRemoteUUIDMsg r ++
then noRemoteUUIDMsg r ++
" (" ++ show (remoteConfig (repo r) "ignore") ++
" is set)"
else error $ noRemoteUUIDMsg r
else noRemoteUUIDMsg r
| otherwise = return $ Just r
byName' :: RemoteName -> Annex (Either String Remote)

10
Test.hs
View file

@ -957,7 +957,7 @@ test_nonannexed_file_conflict_resolution testenv = do
check False True
where
check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 ->
withtmpclonerepo testenv False $ \r2 -> do
withtmpclonerepo testenv False $ \r2 ->
whenM (isInDirect r1 <&&> isInDirect r2) $ do
indir testenv r1 $ do
disconnectOrigin
@ -1007,7 +1007,7 @@ test_nonannexed_symlink_conflict_resolution testenv = do
check False True
where
check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 ->
withtmpclonerepo testenv False $ \r2 -> do
withtmpclonerepo testenv False $ \r2 ->
whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1
<&&> isInDirect r1 <&&> isInDirect r2) $ do
indir testenv r1 $ do
@ -1094,9 +1094,9 @@ test_uncommitted_conflict_resolution testenv = do
- lost track of whether a file was a symlink.
-}
test_conflict_resolution_symlink_bit :: TestEnv -> Assertion
test_conflict_resolution_symlink_bit testenv = do
test_conflict_resolution_symlink_bit testenv =
withtmpclonerepo testenv False $ \r1 ->
withtmpclonerepo testenv False $ \r2 -> do
withtmpclonerepo testenv False $ \r2 ->
withtmpclonerepo testenv False $ \r3 -> do
indir testenv r1 $ do
writeFile conflictor "conflictor"
@ -1152,7 +1152,7 @@ test_uninit_inbranch testenv = intmpclonerepoInDirect testenv $ do
not <$> git_annex testenv "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"
test_upgrade :: TestEnv -> Assertion
test_upgrade testenv = intmpclonerepo testenv $ do
test_upgrade testenv = intmpclonerepo testenv $
git_annex testenv "upgrade" [] @? "upgrade from same version failed"
test_whereis :: TestEnv -> Assertion