diff options
| -rw-r--r-- | Assistant.hs | 30 | ||||
| -rw-r--r-- | CmdLine.hs | 1 | ||||
| -rw-r--r-- | Command/Add.hs | 4 | ||||
| -rw-r--r-- | Command/GCryptSetup.hs | 2 | ||||
| -rw-r--r-- | Command/Import.hs | 2 | ||||
| -rw-r--r-- | Command/Info.hs | 4 | ||||
| -rw-r--r-- | Command/InitRemote.hs | 2 | ||||
| -rw-r--r-- | Command/Mirror.hs | 2 | ||||
| -rw-r--r-- | Command/Move.hs | 4 | ||||
| -rw-r--r-- | Command/NotifyChanges.hs | 2 | ||||
| -rw-r--r-- | Command/NumCopies.hs | 23 | ||||
| -rw-r--r-- | Command/PreCommit.hs | 2 | ||||
| -rw-r--r-- | Command/Repair.hs | 2 | ||||
| -rw-r--r-- | Command/ResolveMerge.hs | 2 | ||||
| -rw-r--r-- | Limit.hs | 2 | ||||
| -rw-r--r-- | Logs.hs | 2 | ||||
| -rw-r--r-- | Remote.hs | 6 | ||||
| -rw-r--r-- | Test.hs | 10 |
18 files changed, 50 insertions, 52 deletions
diff --git a/Assistant.hs b/Assistant.hs index b7e2463fa0..2ba778d807 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -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 diff --git a/CmdLine.hs b/CmdLine.hs index 7df310f696..41968a091a 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -6,7 +6,6 @@ -} {-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} module CmdLine ( dispatch, diff --git a/Command/Add.hs b/Command/Add.hs index 1bc20d8194..286324c427 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -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 diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs index 2448467fdd..ae3dd29bda 100644 --- a/Command/GCryptSetup.hs +++ b/Command/GCryptSetup.hs @@ -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 diff --git a/Command/Import.hs b/Command/Import.hs index 02f44a5989..c8acbee047 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -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)" ) diff --git a/Command/Info.hs b/Command/Info.hs index 1bea17ab44..5d3c86ce6a 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -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 diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index dc54023ccb..2112c52f93 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -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 diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 4e9a85009a..a3bd85975f 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -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 diff --git a/Command/Move.hs b/Command/Move.hs index c3d641edd5..118f3b3a7d 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -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 diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs index d0df055515..8ec9888320 100644 --- a/Command/NotifyChanges.hs +++ b/Command/NotifyChanges.hs @@ -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 diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs index b7323ae357..52eb9dcc68 100644 --- a/Command/NumCopies.hs +++ b/Command/NumCopies.hs @@ -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)" diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 355e2766e7..9a07115cf5 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -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 diff --git a/Command/Repair.hs b/Command/Repair.hs index 56925d83da..3d70ca9cb7 100644 --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -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" diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index a50e2aa9d2..4425ffe460 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -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 @@ -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 @@ -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 @@ -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) @@ -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 |