diff options
| -rw-r--r-- | Annex/Branch.hs | 6 | ||||
| -rw-r--r-- | Annex/Content/Direct.hs | 3 | ||||
| -rw-r--r-- | Annex/Direct.hs | 2 | ||||
| -rw-r--r-- | Annex/FileMatcher.hs | 6 | ||||
| -rw-r--r-- | Annex/Ssh.hs | 2 | ||||
| -rw-r--r-- | Assistant.hs | 3 | ||||
| -rw-r--r-- | Assistant/Types/NamedThread.hs | 2 | ||||
| -rw-r--r-- | Assistant/Types/NetMessager.hs | 2 | ||||
| -rw-r--r-- | Backend.hs | 3 | ||||
| -rw-r--r-- | Creds.hs | 2 | ||||
| -rw-r--r-- | Crypto.hs | 2 | ||||
| -rw-r--r-- | Init.hs | 4 | ||||
| -rw-r--r-- | Limit.hs | 4 | ||||
| -rw-r--r-- | Logs/Group.hs | 4 | ||||
| -rw-r--r-- | Logs/Remote.hs | 2 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 20 | ||||
| -rw-r--r-- | Logs/Trust.hs | 2 | ||||
| -rw-r--r-- | Logs/Unused.hs | 2 | ||||
| -rw-r--r-- | Messages.hs | 4 | ||||
| -rw-r--r-- | Messages/JSON.hs | 5 | ||||
| -rw-r--r-- | Remote.hs | 2 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 2 | ||||
| -rw-r--r-- | Seek.hs | 2 | ||||
| -rw-r--r-- | Test.hs | 2 | ||||
| -rw-r--r-- | Types/GitConfig.hs | 4 | ||||
| -rw-r--r-- | Types/StandardGroups.hs | 8 |
26 files changed, 48 insertions, 52 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 4a36de66a..021cd3926 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -189,7 +189,7 @@ change file a = lockJournal $ a <$> getStale file >>= set file {- Records new content of a file into the journal -} set :: FilePath -> String -> Annex () -set file content = setJournalFile file content +set = setJournalFile {- Stages the journal, and commits staged changes to the branch. -} commit :: String -> Annex () @@ -197,7 +197,7 @@ commit message = whenM journalDirty $ lockJournal $ do cleanjournal <- stageJournal ref <- getBranch withIndex $ commitBranch ref message [fullname] - liftIO $ cleanjournal + liftIO cleanjournal {- Commits the staged changes in the index to the branch. - @@ -355,7 +355,7 @@ stageJournal = withIndex $ do Git.UpdateIndex.streamUpdateIndex g [genstream dir h fs] hashObjectStop h - return $ liftIO $ mapM_ removeFile $ map (dir </>) fs + return $ liftIO $ mapM_ (removeFile . (dir </>)) fs where genstream dir h fs streamer = forM_ fs $ \file -> do let path = dir </> file diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index bbf6e310d..25e257918 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -139,11 +139,10 @@ sameFileStatus :: Key -> FileStatus -> Annex Bool sameFileStatus key status = do old <- recordedInodeCache key let curr = toInodeCache status - r <- case (old, curr) of + case (old, curr) of (Just o, Just c) -> compareInodeCaches o c (Nothing, Nothing) -> return True _ -> return False - return r {- If the inodes have changed, only the size and mtime are compared. -} compareInodeCaches :: InodeCache -> InodeCache -> Annex Bool diff --git a/Annex/Direct.hs b/Annex/Direct.hs index a88a045e7..7836ceb96 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -122,7 +122,7 @@ mergeDirectCleanup :: FilePath -> Git.Ref -> Git.Ref -> Annex () mergeDirectCleanup d oldsha newsha = do (items, cleanup) <- inRepo $ DiffTree.diffTreeRecursive oldsha newsha forM_ items updated - void $ liftIO $ cleanup + void $ liftIO cleanup liftIO $ removeDirectoryRecursive d where updated item = do diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index c32402baf..220fea286 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -47,7 +47,7 @@ parsedToMatcher parsed = case partitionEithers parsed of parseToken :: MkLimit -> GroupMap -> String -> Either String (Token MatchFiles) parseToken checkpresent groupmap t - | any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t + | t `elem` tokens = Right $ token t | t == "present" = use checkpresent | otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $ M.fromList @@ -61,7 +61,7 @@ parseToken checkpresent groupmap t ] where (k, v) = separate (== '=') t - use a = Utility.Matcher.Operation <$> a v + use a = Operation <$> a v {- This is really dumb tokenization; there's no support for quoted values. - Open and close parens are always treated as standalone tokens; @@ -76,7 +76,7 @@ tokenizeMatcher = filter (not . null ) . concatMap splitparens . words largeFilesMatcher :: Annex FileMatcher largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig where - go Nothing = return $ matchAll + go Nothing = return matchAll go (Just expr) = do m <- groupMap u <- getUUID diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index a8bd1f7b6..0b8ce3b93 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -79,7 +79,7 @@ sshCacheDir gettmpdir = liftIO $ getEnv "GIT_ANNEX_TMP_DIR" usetmpdir tmpdir = liftIO $ catchMaybeIO $ do createDirectoryIfMissing True tmpdir - return $ tmpdir + return tmpdir portParams :: Maybe Integer -> [CommandParam] portParams Nothing = [] diff --git a/Assistant.hs b/Assistant.hs index 8ea6692e3..ebe1b92e3 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -196,7 +196,8 @@ startDaemon assistant foreground startbrowser = do | otherwise = "watch" start daemonize webappwaiter = withThreadState $ \st -> do checkCanWatch - when assistant $ checkEnvironment + when assistant + checkEnvironment dstatus <- startDaemonStatus logfile <- fromRepo gitAnnexLogFile liftIO $ debugM desc $ "logging to " ++ logfile diff --git a/Assistant/Types/NamedThread.hs b/Assistant/Types/NamedThread.hs index 0e884637a..a65edc20d 100644 --- a/Assistant/Types/NamedThread.hs +++ b/Assistant/Types/NamedThread.hs @@ -14,4 +14,4 @@ import Assistant.Types.ThreadName data NamedThread = NamedThread ThreadName (Assistant ()) namedThread :: String -> Assistant () -> NamedThread -namedThread name a = NamedThread (ThreadName name) a +namedThread = NamedThread . ThreadName diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs index 05e51045d..1ea7db7ce 100644 --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -104,7 +104,7 @@ getSide side m = m side data NetMessager = NetMessager -- outgoing messages - { netMessages :: TChan (NetMessage) + { netMessages :: TChan NetMessage -- important messages for each client , importantNetMessages :: TMVar (M.Map ClientID (S.Set NetMessage)) -- important messages that are believed to have been sent to a client diff --git a/Backend.hs b/Backend.hs index 8bf29846c..2ee14acc6 100644 --- a/Backend.hs +++ b/Backend.hs @@ -94,8 +94,7 @@ lookupFile file = do where makeret k = let bname = keyBackendName k in case maybeLookupBackendName bname of - Just backend -> do - return $ Just (k, backend) + Just backend -> return $ Just (k, backend) Nothing -> do warning $ "skipping " ++ file ++ @@ -92,7 +92,7 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv Just credpair -> do writeCacheCredPair credpair storage return $ Just credpair - _ -> do error $ "bad creds" + _ -> error "bad creds" {- Gets a CredPair from the environment. -} getEnvCredPair :: CredPairStorage -> IO (Maybe CredPair) @@ -100,7 +100,7 @@ encryptCipher :: Cipher -> KeyIds -> IO StorableCipher encryptCipher (Cipher c) (KeyIds ks) = do -- gpg complains about duplicate recipient keyids let ks' = nub $ sort ks - encipher <- Gpg.pipeStrict ([ Params "--encrypt" ] ++ recipients ks') c + encipher <- Gpg.pipeStrict (Params "--encrypt" : recipients ks') c return $ EncryptedCipher encipher (KeyIds ks') where recipients l = force_recipients : @@ -33,7 +33,7 @@ import Backend genDescription :: Maybe String -> Annex String genDescription (Just d) = return d genDescription Nothing = do - hostname <- maybe "" id <$> liftIO getHostname + hostname <- fromMaybe "" <$> liftIO getHostname let at = if null hostname then "" else "@" username <- liftIO myUserName reldir <- liftIO . relHome =<< fromRepo Git.repoPath @@ -132,7 +132,7 @@ probeCrippledFileSystem = do return True checkCrippledFileSystem :: Annex () -checkCrippledFileSystem = whenM (probeCrippledFileSystem) $ do +checkCrippledFileSystem = whenM probeCrippledFileSystem $ do warning "Detected a crippled filesystem." setCrippledFileSystem True unlessM isDirect $ do @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE PackageImports, CPP #-} +{-# LANGUAGE CPP #-} module Limit where @@ -128,7 +128,7 @@ limitIn name = Right $ \notpresent -> check $ limitPresent :: Maybe UUID -> MkLimit limitPresent u _ = Right $ const $ check $ \key -> do hereu <- getUUID - if u == Just hereu || u == Nothing + if u == Just hereu || isNothing u then inAnnex key else do us <- Remote.keyLocations key diff --git a/Logs/Group.hs b/Logs/Group.hs index a069edcdf..c08feffde 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -66,11 +66,11 @@ makeGroupMap :: M.Map UUID (S.Set Group) -> GroupMap makeGroupMap byuuid = GroupMap byuuid bygroup where bygroup = M.fromListWith S.union $ - concat $ map explode $ M.toList byuuid + concatMap explode $ M.toList byuuid explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s) {- If a repository is in exactly one standard group, returns it. -} getStandardGroup :: S.Set Group -> Maybe StandardGroup -getStandardGroup s = case catMaybes $ map toStandardGroup $ S.toList s of +getStandardGroup s = case mapMaybe toStandardGroup $ S.toList s of [g] -> Just g _ -> Nothing diff --git a/Logs/Remote.hs b/Logs/Remote.hs index 55fb40f4b..89792b054 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -93,7 +93,7 @@ prop_idempotent_configEscape s = s == (configUnEscape . configEscape) s prop_parse_show_Config :: RemoteConfig -> Bool prop_parse_show_Config c -- whitespace and '=' are not supported in keys - | any (\k -> any isSpace k || any (== '=') k) (M.keys c) = True + | any (\k -> any isSpace k || elem '=' k) (M.keys c) = True | otherwise = parseConfig (showConfig c) ~~ Just c where normalize v = sort . M.toList <$> v diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 921d8f815..778932510 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -130,8 +130,8 @@ runTransfer t file shouldretry a = do Just fd -> do locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) - when (locked == Nothing) $ - error $ "transfer already in progress" + when (isNothing locked) $ + error "transfer already in progress" void $ tryIO $ writeTransferInfoFile info tfile return mfd cleanup _ Nothing = noop @@ -169,7 +169,7 @@ mkProgressUpdater t info = do where updater tfile mvar b = modifyMVar_ mvar $ \oldbytes -> do let newbytes = fromBytesProcessed b - if (newbytes - oldbytes >= mindelta) + if newbytes - oldbytes >= mindelta then do let info' = info { bytesComplete = Just newbytes } _ <- tryIO $ writeTransferInfoFile info' tfile @@ -213,7 +213,7 @@ checkTransfer t = do {- Gets all currently running transfers. -} getTransfers :: Annex [(Transfer, TransferInfo)] getTransfers = do - transfers <- catMaybes . map parseTransferFile . concat <$> findfiles + transfers <- mapMaybe parseTransferFile . concat <$> findfiles infos <- mapM checkTransfer transfers return $ map (\(t, Just i) -> (t, i)) $ filter running $ zip transfers infos @@ -265,7 +265,7 @@ transferLockFile infofile = let (d,f) = splitFileName infofile in {- Parses a transfer information filename to a Transfer. -} parseTransferFile :: FilePath -> Maybe Transfer parseTransferFile file - | "lck." `isPrefixOf` (takeFileName file) = Nothing + | "lck." `isPrefixOf` takeFileName file = Nothing | otherwise = case drop (length bits - 3) bits of [direction, u, key] -> Transfer <$> readLcDirection direction @@ -291,17 +291,17 @@ writeTransferInfoFile info tfile = do writeTransferInfo :: TransferInfo -> String writeTransferInfo info = unlines [ (maybe "" show $ startedTime info) ++ - (maybe "" (\b -> " " ++ show b) $ bytesComplete info) + (maybe "" (\b -> ' ' : show b) (bytesComplete info)) , fromMaybe "" $ associatedFile info -- comes last; arbitrary content ] -readTransferInfoFile :: (Maybe ProcessID) -> FilePath -> IO (Maybe TransferInfo) +readTransferInfoFile :: Maybe ProcessID -> FilePath -> IO (Maybe TransferInfo) readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ do h <- openFile tfile ReadMode fileEncoding h hClose h `after` (readTransferInfo mpid <$> hGetContentsStrict h) -readTransferInfo :: (Maybe ProcessID) -> String -> Maybe TransferInfo +readTransferInfo :: Maybe ProcessID -> String -> Maybe TransferInfo readTransferInfo mpid s = TransferInfo <$> time <*> pure mpid @@ -353,8 +353,8 @@ instance Arbitrary TransferInfo where prop_read_write_transferinfo :: TransferInfo -> Bool prop_read_write_transferinfo info - | transferRemote info /= Nothing = True -- remote not stored - | transferTid info /= Nothing = True -- tid not stored + | isJust (transferRemote info) = True -- remote not stored + | isJust (transferTid info) = True -- tid not stored | otherwise = Just (info { transferPaused = False }) == info' where info' = readTransferInfo (transferPid info) (writeTransferInfo info) diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 058250740..89a5404f7 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -70,7 +70,7 @@ trustPartition level ls return $ partition (`elem` candidates) ls {- Filters UUIDs to those not matching a TrustLevel. -} -trustExclude :: TrustLevel -> [UUID] -> Annex ([UUID]) +trustExclude :: TrustLevel -> [UUID] -> Annex [UUID] trustExclude level ls = snd <$> trustPartition level ls {- trustLog in a map, overridden with any values from forcetrust or diff --git a/Logs/Unused.hs b/Logs/Unused.hs index bef78a992..437b01f71 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -31,7 +31,7 @@ readUnusedLog :: FilePath -> Annex UnusedMap readUnusedLog prefix = do f <- fromRepo $ gitAnnexUnusedLog prefix ifM (liftIO $ doesFileExist f) - ( M.fromList . catMaybes . map parse . lines + ( M.fromList . mapMaybe parse . lines <$> liftIO (readFile f) , return M.empty ) diff --git a/Messages.hs b/Messages.hs index 13b786a31..cc82b9050 100644 --- a/Messages.hs +++ b/Messages.hs @@ -71,7 +71,7 @@ showProgress = handle q $ {- Shows a progress meter while performing a transfer of a key. - The action is passed a callback to use to update the meter. -} -metered :: (Maybe MeterUpdate) -> Key -> (MeterUpdate -> Annex a) -> Annex a +metered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a metered combinemeterupdate key a = go (keySize key) where go (Just size) = meteredBytes combinemeterupdate size a @@ -79,7 +79,7 @@ metered combinemeterupdate key a = go (keySize key) {- Shows a progress meter while performing an action on a given number - of bytes. -} -meteredBytes :: (Maybe MeterUpdate) -> Integer -> (MeterUpdate -> Annex a) -> Annex a +meteredBytes :: Maybe MeterUpdate -> Integer -> (MeterUpdate -> Annex a) -> Annex a meteredBytes combinemeterupdate size a = withOutputType go where go NormalOutput = do diff --git a/Messages/JSON.hs b/Messages/JSON.hs index e262192a8..d57d69318 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -34,7 +34,4 @@ add :: JSON a => [(String, a)] -> IO () add v = putStr $ Stream.add v complete :: JSON a => [(String, a)] -> IO () -complete v = putStr $ concat - [ Stream.start v - , Stream.end - ] +complete v = putStr $ Stream.start v ++ Stream.end @@ -150,7 +150,7 @@ prettyListUUIDs :: [UUID] -> Annex [String] prettyListUUIDs uuids = do hereu <- getUUID m <- uuidDescriptions - return $ map (\u -> prettify m hereu u) uuids + return $ map (prettify m hereu) uuids where finddescription m u = M.findWithDefault "" u m prettify m hereu u diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 9563b43e8..a5750437d 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -127,7 +127,7 @@ retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool retrieveCheap o k f = ifM (preseedTmp k f) ( retrieve o k undefined f , return False ) retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp -> do +retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp -> ifM (retrieve o enck undefined tmp) ( liftIO $ catchBoolIO $ do decrypt cipher (feedFile tmp) $ @@ -28,7 +28,7 @@ seekHelper a params = do runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params {- Show warnings only for files/directories that do not exist. -} forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p -> - unlessM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus p)) $ + unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $ fileNotFound p return $ concat ll @@ -72,7 +72,7 @@ main = do divider propigate rs qcok where - divider = putStrLn $ take 70 $ repeat '-' + divider = putStrLn $ replicate 70 '-' propigate :: [Counts] -> Bool -> IO () propigate cs qcok diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 246c320d0..ff7cd3c90 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -122,8 +122,8 @@ extractRemoteGitConfig r remotename = RemoteGitConfig getbool k def = fromMaybe def $ getmaybebool k getmaybebool k = Git.Config.isTrue =<< getmaybe k getmayberead k = readish =<< getmaybe k - getmaybe k = maybe (Git.Config.getMaybe (key k) r) Just $ - Git.Config.getMaybe (remotekey k) r + getmaybe k = mplus (Git.Config.getMaybe (key k) r) + (Git.Config.getMaybe (remotekey k) r) getoptions k = fromMaybe [] $ words <$> getmaybe k key k = "annex." ++ k diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 2262c3bde..434600f3f 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -57,17 +57,17 @@ descStandardGroup UnwantedGroup = "unwanted: remove content from this repository preferredContent :: StandardGroup -> String preferredContent ClientGroup = lastResort "exclude=*/archive/* and exclude=archive/*" -preferredContent TransferGroup = lastResort $ +preferredContent TransferGroup = lastResort "not (inallgroup=client and copies=client:2) and " ++ preferredContent ClientGroup preferredContent BackupGroup = "include=*" -preferredContent IncrementalBackupGroup = lastResort $ +preferredContent IncrementalBackupGroup = lastResort "include=* and (not copies=incrementalbackup:1)" preferredContent SmallArchiveGroup = lastResort $ "(include=*/archive/* or include=archive/*) and " ++ preferredContent FullArchiveGroup -preferredContent FullArchiveGroup = lastResort $ +preferredContent FullArchiveGroup = lastResort "not (copies=archive:1 or copies=smallarchive:1)" preferredContent SourceGroup = "not (copies=1)" -preferredContent ManualGroup = lastResort $ +preferredContent ManualGroup = lastResort "present and exclude=*/archive/* and exclude=archive/*" preferredContent UnwantedGroup = "exclude=*" |