From 6c396a256c93464d726c66a95132536941871ee8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Jul 2011 12:47:14 -0400 Subject: finished hlint pass --- Command/Add.hs | 6 +++--- Command/DropUnused.hs | 9 ++++----- Command/Fsck.hs | 2 +- Command/InAnnex.hs | 2 +- Command/InitRemote.hs | 8 ++++---- Command/Map.hs | 19 ++++++++++--------- Command/Move.hs | 2 +- Command/SetKey.hs | 4 ++-- Command/Status.hs | 16 ++++++++-------- Command/Uninit.hs | 5 +++-- Command/Unused.hs | 16 ++++++++-------- Command/Version.hs | 2 +- Command/Whereis.hs | 4 ++-- Locations.hs | 4 ++-- Remote/Bup.hs | 20 +++++++++++--------- Remote/Directory.hs | 5 +++-- Remote/Encryptable.hs | 4 ++-- Remote/Git.hs | 6 +++--- Remote/Hook.hs | 16 +++++++++------- Remote/Rsync.hs | 12 ++++++------ Remote/S3real.hs | 24 ++++++++++-------------- Remote/Special.hs | 2 +- Remote/Ssh.hs | 2 +- Remote/Web.hs | 4 ++-- Touch.hsc | 5 ++--- Utility/CopyFile.hs | 12 +++++------- Utility/DataUnits.hs | 6 +++--- Utility/Dot.hs | 10 +++++----- Utility/RsyncFile.hs | 2 +- 29 files changed, 114 insertions(+), 115 deletions(-) diff --git a/Command/Add.hs b/Command/Add.hs index 51b95b9b5..58c0143dd 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -39,7 +39,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start] start :: CommandStartBackendFile start pair@(file, _) = notAnnexed file $ do s <- liftIO $ getSymbolicLinkStatus file - if (isSymbolicLink s) || (not $ isRegularFile s) + if isSymbolicLink s || not (isRegularFile s) then stop else do showStart "add" file @@ -58,8 +58,8 @@ perform (file, backend) = do - This can be called before or after the symlink is in place. -} undo :: FilePath -> Key -> IOException -> Annex a undo file key e = do - unlessM (inAnnex key) $ rethrow -- no cleanup to do - liftIO $ whenM (doesFileExist file) $ do removeFile file + unlessM (inAnnex key) rethrow -- no cleanup to do + liftIO $ whenM (doesFileExist file) $ removeFile file handle tryharder $ fromAnnex key file logStatus key InfoMissing rethrow diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 55007c1f7..a01e08ab5 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -49,7 +49,7 @@ start (unused, unusedbad, unusedtmp) s = notBareRepo $ search ] where search [] = stop - search ((m, a):rest) = do + search ((m, a):rest) = case M.lookup s m of Nothing -> search rest Just key -> do @@ -78,10 +78,9 @@ readUnusedLog prefix = do let f = gitAnnexUnusedLog prefix g e <- liftIO $ doesFileExist f if e - then do - l <- liftIO $ readFile f - return $ M.fromList $ map parse $ lines l - else return $ M.empty + then return . M.fromList . map parse . lines + =<< liftIO (readFile f) + else return M.empty where parse line = (head ws, fromJust $ readKey $ unwords $ tail ws) where diff --git a/Command/Fsck.hs b/Command/Fsck.hs index ec3f1d8e7..0d3ecb58f 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -94,7 +94,7 @@ fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool fsckKey backend key file numcopies = do size_ok <- checkKeySize key copies_ok <- checkKeyNumCopies key file numcopies - backend_ok <-(Types.Backend.fsckKey backend) key + backend_ok <- (Types.Backend.fsckKey backend) key return $ size_ok && copies_ok && backend_ok {- The size of the data for a key is checked against the size encoded in diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index b5b59ccf7..24f7162ac 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -25,4 +25,4 @@ start key = do present <- inAnnex key if present then stop - else liftIO $ exitFailure + else liftIO exitFailure diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 15962ad99..9859308e5 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -24,7 +24,7 @@ import Messages command :: [Command] command = [repoCommand "initremote" (paramPair paramName $ - paramOptional $ paramRepeating $ paramKeyValue) seek + paramOptional $ paramRepeating paramKeyValue) seek "sets up a special (non-git) remote"] seek :: [CommandSeek] @@ -32,7 +32,7 @@ seek = [withWords start] start :: CommandStartWords start ws = do - when (null ws) $ needname + when (null ws) needname (u, c) <- findByName name let fullconfig = M.union config c @@ -69,7 +69,7 @@ findByName name = do maybe generate return $ findByName' name m where generate = do - uuid <- liftIO $ genUUID + uuid <- liftIO genUUID return (uuid, M.insert nameKey name M.empty) findByName' :: String -> M.Map UUID R.RemoteConfig -> Maybe (UUID, R.RemoteConfig) @@ -85,7 +85,7 @@ findByName' n m = if null matches then Nothing else Just $ head matches remoteNames :: Annex [String] remoteNames = do m <- RemoteLog.readRemoteLog - return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m + return $ mapMaybe (M.lookup nameKey . snd) $ M.toList m {- find the specified remote type -} findType :: R.RemoteConfig -> Annex (R.RemoteType Annex) diff --git a/Command/Map.hs b/Command/Map.hs index 0391ab8e8..557ae2787 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -12,6 +12,7 @@ import Control.Exception.Extensible import System.Cmd.Utils import qualified Data.Map as M import Data.List.Utils +import Data.Maybe import Command import qualified Annex @@ -58,7 +59,7 @@ start = do - the repositories first, followed by uuids that were not matched - to a repository. -} -drawMap :: [Git.Repo] -> (M.Map UUID String) -> [UUID] -> String +drawMap :: [Git.Repo] -> M.Map UUID String -> [UUID] -> String drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others where repos = map (node umap rs) rs @@ -78,23 +79,23 @@ basehostname r = head $ split "." $ hostname r {- A name to display for a repo. Uses the name from uuid.log if available, - or the remote name if not. -} -repoName :: (M.Map UUID String) -> Git.Repo -> String +repoName :: M.Map UUID String -> Git.Repo -> String repoName umap r | null repouuid = fallback | otherwise = M.findWithDefault fallback repouuid umap where repouuid = getUncachedUUID r - fallback = maybe "unknown" id $ Git.repoRemoteName r + fallback = fromMaybe "unknown" $ Git.repoRemoteName r {- A unique id for the node for a repo. Uses the annex.uuid if available. -} nodeId :: Git.Repo -> String nodeId r = - case (getUncachedUUID r) of + case getUncachedUUID r of "" -> Git.repoLocation r u -> u {- A node representing a repo. -} -node :: (M.Map UUID String) -> [Git.Repo] -> Git.Repo -> String +node :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> String node umap fullinfo r = unlines $ n:edges where n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $ @@ -105,14 +106,14 @@ node umap fullinfo r = unlines $ n:edges | otherwise = reachable {- An edge between two repos. The second repo is a remote of the first. -} -edge :: (M.Map UUID String) -> [Git.Repo] -> Git.Repo -> Git.Repo -> String +edge :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> Git.Repo -> String edge umap fullinfo from to = Dot.graphEdge (nodeId from) (nodeId fullto) edgename where -- get the full info for the remote, to get its UUID fullto = findfullinfo to findfullinfo n = - case (filter (same n) fullinfo) of + case filter (same n) fullinfo of [] -> n (n':_) -> n' {- Only name an edge if the name is different than the name @@ -120,7 +121,7 @@ edge umap fullinfo from to = - different from its hostname. (This reduces visual clutter.) -} edgename = maybe Nothing calcname $ Git.repoRemoteName to calcname n - | n == repoName umap fullto || n == hostname fullto = Nothing + | n `elem` [repoName umap fullto, hostname fullto] = Nothing | otherwise = Just n unreachable :: String -> String @@ -188,7 +189,7 @@ tryScan r | otherwise = safely $ Git.configRead r where safely a = do - result <- liftIO (try (a)::IO (Either SomeException Git.Repo)) + result <- liftIO (try a :: IO (Either SomeException Git.Repo)) case result of Left _ -> return Nothing Right r' -> return $ Just r' diff --git a/Command/Move.hs b/Command/Move.hs index 6bf6e0582..a98276e7e 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -124,7 +124,7 @@ fromStart src move file = isAnnexed file $ \(key, _) -> do g <- Annex.gitRepo u <- getUUID g remotes <- Remote.keyPossibilities key - if (u == Remote.uuid src) || (null $ filter (== src) remotes) + if u == Remote.uuid src || not (any (== src) remotes) then stop else do showAction move file diff --git a/Command/SetKey.hs b/Command/SetKey.hs index b000a4e8b..f2a5259ba 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -16,7 +16,7 @@ import Content import Messages command :: [Command] -command = [repoCommand "setkey" (paramPath) seek +command = [repoCommand "setkey" paramPath seek "sets annexed content for a key using a temp file"] seek :: [CommandSeek] @@ -34,7 +34,7 @@ perform file = do -- the file might be on a different filesystem, so mv is used -- rather than simply calling moveToObjectDir; disk space is also -- checked this way. - ok <- getViaTmp key $ \dest -> do + ok <- getViaTmp key $ \dest -> if dest /= file then liftIO $ boolSystem "mv" [File file, File dest] diff --git a/Command/Status.hs b/Command/Status.hs index 1ec478236..aef4df232 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -32,8 +32,8 @@ type Stat = StatState (Maybe (String, StatState String)) -- cached info that multiple Stats may need data StatInfo = StatInfo - { keysPresentCache :: (Maybe (SizeList Key)) - , keysReferencedCache :: (Maybe (SizeList Key)) + { keysPresentCache :: Maybe (SizeList Key) + , keysReferencedCache :: Maybe (SizeList Key) } -- a state monad for running Stats in @@ -84,7 +84,7 @@ stat :: String -> StatState String -> Stat stat desc a = return $ Just (desc, a) nostat :: Stat -nostat = return $ Nothing +nostat = return Nothing showStat :: Stat -> StatState () showStat s = calc =<< s @@ -144,7 +144,7 @@ cachedKeysPresent = do case keysPresentCache s of Just v -> return v Nothing -> do - keys <- lift $ getKeysPresent + keys <- lift getKeysPresent let v = sizeList keys put s { keysPresentCache = Just v } return v @@ -155,7 +155,7 @@ cachedKeysReferenced = do case keysReferencedCache s of Just v -> return v Nothing -> do - keys <- lift $ Command.Unused.getKeysReferenced + keys <- lift Command.Unused.getKeysReferenced -- A given key may be referenced repeatedly. -- nub does not seem too slow (yet).. let v = sizeList $ nub keys @@ -164,9 +164,9 @@ cachedKeysReferenced = do keySizeSum :: SizeList Key -> StatState String keySizeSum (keys, len) = do - let knownsize = catMaybes $ map keySize keys - let total = roughSize storageUnits False $ foldl (+) 0 knownsize - let missing = len - genericLength knownsize + let knownsizes = mapMaybe keySize keys + let total = roughSize storageUnits False $ sum knownsizes + let missing = len - genericLength knownsizes return $ total ++ if missing > 0 then aside $ "but " ++ show missing ++ " keys have unknown size" diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 1497bbfd1..8b8d7e364 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -52,8 +52,9 @@ cleanup = do liftIO $ removeDirectoryRecursive (gitAnnexDir g) -- avoid normal shutdown saveState - liftIO $ Git.run g "branch" [Param "-D", Param Branch.name] - liftIO $ exitSuccess + liftIO $ do + Git.run g "branch" [Param "-D", Param Branch.name] + exitSuccess gitPreCommitHookUnWrite :: Git.Repo -> Annex () gitPreCommitHookUnWrite repo = do diff --git a/Command/Unused.hs b/Command/Unused.hs index 3f51e2c2c..870c993f1 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -7,7 +7,7 @@ module Command.Unused where -import Control.Monad (filterM, unless, forM_, when) +import Control.Monad (filterM, unless, forM_) import Control.Monad.State (liftIO) import qualified Data.Set as S import Data.Maybe @@ -55,9 +55,9 @@ checkUnused = do where list file msg l c = do let unusedlist = number c l - when (not $ null l) $ do + unless (null l) $ do showLongNote $ msg unusedlist - showLongNote $ "\n" + showLongNote "\n" writeUnusedFile file unusedlist return $ c + length l @@ -68,7 +68,7 @@ checkRemoteUnused name = do checkRemoteUnused' :: Remote.Remote Annex -> Annex () checkRemoteUnused' r = do - showNote $ "checking for unused data..." + showNote "checking for unused data..." referenced <- getKeysReferenced remotehas <- filterM isthere =<< loggedKeys let remoteunused = remotehas `exclude` referenced @@ -76,7 +76,7 @@ checkRemoteUnused' r = do writeUnusedFile "" list unless (null remoteunused) $ do showLongNote $ remoteUnusedMsg r list - showLongNote $ "\n" + showLongNote "\n" where isthere k = do us <- keyLocations k @@ -90,14 +90,14 @@ writeUnusedFile prefix l = do unlines $ map (\(n, k) -> show n ++ " " ++ show k) l table :: [(Int, Key)] -> [String] -table l = [" NUMBER KEY"] ++ map cols l +table l = " NUMBER KEY" : map cols l where cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ show k pad n s = s ++ replicate (n - length s) ' ' number :: Int -> [a] -> [(Int, a)] number _ [] = [] -number n (x:xs) = (n+1, x):(number (n+1) xs) +number n (x:xs) = (n+1, x) : number (n+1) xs staleTmpMsg :: [(Int, Key)] -> String staleTmpMsg t = unlines $ @@ -210,4 +210,4 @@ staleKeys dirspec = do contents <- liftIO $ getDirectoryContents dir files <- liftIO $ filterM doesFileExist $ map (dir ) contents - return $ catMaybes $ map (fileKey . takeFileName) files + return $ mapMaybe (fileKey . takeFileName) files diff --git a/Command/Version.hs b/Command/Version.hs index bb7acd12d..2392c9bf6 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -31,4 +31,4 @@ start = do liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions stop where - vs l = join " " l + vs = join " " diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 0e4858f8b..05748e8d6 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -30,11 +30,11 @@ perform key = do uuids <- keyLocations key let num = length uuids showNote $ show num ++ " " ++ copiesplural num - if null $ uuids + if null uuids then stop else do pp <- prettyPrintUUIDs uuids - showLongNote $ pp + showLongNote pp showProgress next $ return True where diff --git a/Locations.hs b/Locations.hs index 2dbf2f55e..942b687bb 100644 --- a/Locations.hs +++ b/Locations.hs @@ -167,8 +167,8 @@ display_32bits_as_dir w = trim $ swap_pairs cs -- a real word, use letters that appear less frequently. chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF" cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7] - getc n = chars !! (fromIntegral n) + getc n = chars !! fromIntegral n swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs swap_pairs _ = [] -- Last 2 will always be 00, so omit. - trim s = take 6 s + trim = take 6 diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 5a44397f0..4ea455226 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -8,7 +8,8 @@ module Remote.Bup (remote) where import qualified Data.ByteString.Lazy.Char8 as L -import IO +import System.IO +import System.IO.Error import Control.Exception.Extensible (IOException) import qualified Data.Map as M import Control.Monad (when) @@ -16,6 +17,7 @@ import Control.Monad.State (liftIO) import System.Process import System.Exit import System.FilePath +import Data.Maybe import Data.List.Utils import System.Cmd.Utils @@ -68,7 +70,7 @@ gen r u c = do bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig bupSetup u c = do -- verify configuration is sane - let buprepo = maybe (error "Specify buprepo=") id $ + let buprepo = fromMaybe (error "Specify buprepo=") $ M.lookup "buprepo" c c' <- encryptionSetup c @@ -87,7 +89,7 @@ bupSetup u c = do bupParams :: String -> BupRepo -> [CommandParam] -> [CommandParam] bupParams command buprepo params = - (Param command) : [Param "-r", Param buprepo] ++ params + Param command : [Param "-r", Param buprepo] ++ params bup :: String -> BupRepo -> [CommandParam] -> Annex Bool bup command buprepo params = do @@ -123,8 +125,8 @@ storeEncrypted r buprepo (cipher, enck) k = do g <- Annex.gitRepo let src = gitAnnexLocation g k params <- bupSplitParams r buprepo enck (Param "-") - liftIO $ catchBool $ do - withEncryptedHandle cipher (L.readFile src) $ \h -> do + liftIO $ catchBool $ + withEncryptedHandle cipher (L.readFile src) $ \h -> pipeBup params (Just h) Nothing retrieve :: BupRepo -> Key -> FilePath -> Annex Bool @@ -184,7 +186,7 @@ onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [ onBupRemote r a command params = do let dir = shellEscape (Git.workTree r) sshparams <- sshToRepo r [Param $ - "cd " ++ dir ++ " && " ++ (unwords $ command : toCommand params)] + "cd " ++ dir ++ " && " ++ unwords (command : toCommand params)] liftIO $ a "ssh" sshparams {- Allow for bup repositories on removable media by checking @@ -215,20 +217,20 @@ bup2GitRemote "" = do Git.repoFromAbsPath $ h ".bup" bup2GitRemote r | bupLocal r = - if r !! 0 == '/' + if head r == '/' then Git.repoFromAbsPath r else error "please specify an absolute path" | otherwise = Git.repoFromUrl $ "ssh://" ++ host ++ slash dir where bits = split ":" r - host = bits !! 0 + host = head bits dir = join ":" $ drop 1 bits -- "host:~user/dir" is not supported specially by bup; -- "host:dir" is relative to the home directory; -- "host:" goes in ~/.bup slash d | d == "" = "/~/.bup" - | d !! 0 == '/' = d + | head d == '/' = d | otherwise = "/~/" ++ d bupLocal :: BupRepo -> Bool diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 05d42136f..235f61300 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -8,13 +8,14 @@ module Remote.Directory (remote) where import qualified Data.ByteString.Lazy.Char8 as L -import IO +import System.IO.Error import Control.Exception.Extensible (IOException) import qualified Data.Map as M import Control.Monad (when) import Control.Monad.State (liftIO) import System.Directory hiding (copyFile) import System.FilePath +import Data.Maybe import Types import Types.Remote @@ -60,7 +61,7 @@ gen r u c = do directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig directorySetup u c = do -- verify configuration is sane - let dir = maybe (error "Specify directory=") id $ + let dir = fromMaybe (error "Specify directory=") $ M.lookup "directory" c liftIO $ doesDirectoryExist dir >>! error $ "Directory does not exist: " ++ dir diff --git a/Remote/Encryptable.hs b/Remote/Encryptable.hs index 443f5cf83..66e1738ac 100644 --- a/Remote/Encryptable.hs +++ b/Remote/Encryptable.hs @@ -56,10 +56,10 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = where store k = cip k >>= maybe (storeKey r k) - (\x -> storeKeyEncrypted x k) + (`storeKeyEncrypted` k) retrieve k f = cip k >>= maybe (retrieveKeyFile r k f) - (\x -> retrieveKeyFileEncrypted x f) + (`retrieveKeyFileEncrypted` f) withkey a k = cip k >>= maybe (a k) (a . snd) cip = cipherKey c diff --git a/Remote/Git.hs b/Remote/Git.hs index fb8512382..1f22ad11c 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -57,7 +57,7 @@ gen r u _ = do let defcst = if cheap then cheapRemoteCost else expensiveRemoteCost cst <- remoteCost r' defcst - return $ Remote { + return Remote { uuid = u', cost = cst, name = Git.repoDescribe r', @@ -81,7 +81,7 @@ tryGitConfigRead r -- Reading config can fail due to IO error or -- for other reasons; catch all possible exceptions. safely a = do - result <- liftIO (try (a)::IO (Either SomeException Git.Repo)) + result <- liftIO (try a :: IO (Either SomeException Git.Repo)) case result of Left _ -> return r Right r' -> return r' @@ -154,7 +154,7 @@ copyToRemote r key rsyncHelper =<< rsyncParamsRemote r False key keysrc | otherwise = error "copying to non-ssh repo not supported" -rsyncHelper :: [CommandParam] -> Annex (Bool) +rsyncHelper :: [CommandParam] -> Annex Bool rsyncHelper p = do showProgress -- make way for progress bar res <- liftIO $ rsync p diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 86a7bca56..f0e4d5bfb 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -17,6 +17,7 @@ import System.Posix.IO import System.IO import System.IO.Error (try) import System.Exit +import Data.Maybe import Types import Types.Remote @@ -61,7 +62,7 @@ gen r u c = do hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig hookSetup u c = do - let hooktype = maybe (error "Specify hooktype=") id $ + let hooktype = fromMaybe (error "Specify hooktype=") $ M.lookup "hooktype" c c' <- encryptionSetup c gitConfigSpecialRemote u c' "hooktype" hooktype @@ -73,12 +74,13 @@ hookEnv k f = Just $ fileenv f ++ keyenv env s v = ("ANNEX_" ++ s, v) keyenv = [ env "KEY" (show k) - , env "HASH_1" (hashbits !! 0) - , env "HASH_2" (hashbits !! 1) + , env "HASH_1" hash_1 + , env "HASH_2" hash_2 ] fileenv Nothing = [] fileenv (Just file) = [env "FILE" file] - hashbits = map takeDirectory $ splitPath $ hashDirMixed k + [hash_1, hash_2, _rest] = + map takeDirectory $ splitPath $ hashDirMixed k lookupHook :: String -> String -> Annex (Maybe String) lookupHook hooktype hook =do @@ -127,7 +129,7 @@ retrieveEncrypted h (cipher, enck) f = withTmp enck $ \tmp -> return True remove :: String -> Key -> Annex Bool -remove h k = runHook h "remove" k Nothing $ do return True +remove h k = runHook h "remove" k Nothing $ return True checkPresent :: Git.Repo -> String -> Key -> Annex (Either IOException Bool) checkPresent r h k = do @@ -135,7 +137,7 @@ checkPresent r h k = do v <- lookupHook h "checkpresent" liftIO (try (check v) ::IO (Either IOException Bool)) where - findkey s = (show k) `elem` (lines s) + findkey s = show k `elem` lines s env = hookEnv k Nothing check Nothing = error "checkpresent hook misconfigured" check (Just hook) = do @@ -150,5 +152,5 @@ checkPresent r h k = do hClose fromh s <- getProcessStatus True False pid case s of - Just (Exited (ExitSuccess)) -> return $ findkey reply + Just (Exited ExitSuccess) -> return $ findkey reply _ -> error "checkpresent hook failed" diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 80e194fed..ca4236276 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -15,6 +15,7 @@ import System.FilePath import System.Directory import System.Posix.Files import System.Posix.Process +import Data.Maybe import Types import Types.Remote @@ -82,7 +83,7 @@ genRsyncOpts r = do rsyncSetup :: UUID -> RemoteConfig -> Annex RemoteConfig rsyncSetup u c = do -- verify configuration is sane - let url = maybe (error "Specify rsyncurl=") id $ + let url = fromMaybe (error "Specify rsyncurl=") $ M.lookup "rsyncurl" c c' <- encryptionSetup c @@ -160,10 +161,10 @@ partialParams = Params "--no-inplace --partial --partial-dir=.rsync-partial" withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool withRsyncScratchDir a = do g <- Annex.gitRepo - pid <- liftIO $ getProcessID + pid <- liftIO getProcessID let tmp = gitAnnexTmpDir g "rsynctmp" show pid nuke tmp - liftIO $ createDirectoryIfMissing True $ tmp + liftIO $ createDirectoryIfMissing True tmp res <- a tmp nuke tmp return res @@ -189,15 +190,14 @@ rsyncRemote o params = do rsyncSend :: RsyncOpts -> Key -> FilePath -> Annex Bool rsyncSend o k src = withRsyncScratchDir $ \tmp -> do let dest = tmp hashDirMixed k f f - liftIO $ createDirectoryIfMissing True $ parentDir $ dest + liftIO $ createDirectoryIfMissing True $ parentDir dest liftIO $ createLink src dest - res <- rsyncRemote o + rsyncRemote o [ Param "--recursive" , partialParams -- tmp/ to send contents of tmp dir , Param $ addTrailingPathSeparator tmp , Param $ rsyncUrl o ] - return res where f = keyFile k diff --git a/Remote/S3real.hs b/Remote/S3real.hs index 52d1ed1be..cbd3ef622 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -52,7 +52,7 @@ gen r u c = do cst <- remoteCost r expensiveRemoteCost return $ gen' r u c cst gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote Annex -gen' r u c cst = do +gen' r u c cst = encryptableRemote c (storeEncrypted this) (retrieveEncrypted this) @@ -85,7 +85,7 @@ s3Setup u c = handlehost $ M.lookup "host" c handlehost Nothing = defaulthost handlehost (Just h) - | ".archive.org" `isSuffixOf` (map toLower h) = archiveorg + | ".archive.org" `isSuffixOf` map toLower h = archiveorg | otherwise = defaulthost use fullconfig = do @@ -99,7 +99,7 @@ s3Setup u c = handlehost $ M.lookup "host" c use fullconfig archiveorg = do - showNote $ "Internet Archive mode" + showNote "Internet Archive mode" maybe (error "specify bucket=") (const $ return ()) $ M.lookup "bucket" archiveconfig use archiveconfig @@ -203,10 +203,8 @@ s3Error :: ReqError -> a s3Error e = error $ prettyReqError e s3Bool :: AWSResult () -> Annex Bool -s3Bool res = do - case res of - Right _ -> return True - Left e -> s3Warning e +s3Bool (Right _) = return True +s3Bool (Left e) = s3Warning e s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a s3Action r noconn action = do @@ -219,7 +217,7 @@ s3Action r noconn action = do _ -> return noconn bucketFile :: Remote Annex -> Key -> FilePath -bucketFile r k = (munge $ show k) +bucketFile r = munge . show where munge s = case M.lookup "mungekeys" $ fromJust $ config r of Just "ia" -> iaMunge s @@ -271,8 +269,8 @@ s3Connection c = do warning $ "Set both " ++ s3AccessKey ++ " and " ++ s3SecretKey ++ " to use S3" return Nothing where - host = fromJust $ (M.lookup "host" c) - port = let s = fromJust $ (M.lookup "port" c) in + host = fromJust $ M.lookup "host" c + port = let s = fromJust $ M.lookup "port" c in case reads s of [(p, _)] -> p _ -> error $ "bad S3 port value: " ++ s @@ -283,7 +281,7 @@ s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String)) s3GetCreds c = do ak <- getEnvKey s3AccessKey sk <- getEnvKey s3SecretKey - if (null ak || null sk) + if null ak || null sk then do mcipher <- remoteCipher c case (M.lookup "s3creds" c, mcipher) of @@ -291,9 +289,7 @@ s3GetCreds c = do s <- liftIO $ withDecryptedContent cipher (return $ L.pack $ fromB64 encrypted) (return . L.unpack) - let line = lines s - let ak' = line !! 0 - let sk' = line !! 1 + let [ak', sk', _rest] = lines s liftIO $ do setEnv s3AccessKey ak True setEnv s3SecretKey sk True diff --git a/Remote/Special.hs b/Remote/Special.hs index 9a00dbd82..d6f362ce3 100644 --- a/Remote/Special.hs +++ b/Remote/Special.hs @@ -38,7 +38,7 @@ gitConfigSpecialRemote u c k v = do g <- Annex.gitRepo liftIO $ do Git.run g "config" [Param (configsetting $ "annex-"++k), Param v] - Git.run g "config" [Param (configsetting $ "annex-uuid"), Param u] + Git.run g "config" [Param (configsetting "annex-uuid"), Param u] where remotename = fromJust (M.lookup "name" c) configsetting s = "remote." ++ remotename ++ "." ++ s diff --git a/Remote/Ssh.hs b/Remote/Ssh.hs index 0d4842a1a..fe4e6dfc1 100644 --- a/Remote/Ssh.hs +++ b/Remote/Ssh.hs @@ -39,7 +39,7 @@ git_annex_shell r command params where dir = Git.workTree r shellcmd = "git-annex-shell" - shellopts = (Param command):(File dir):params + shellopts = Param command : File dir : params sshcmd = shellcmd ++ " " ++ unwords (map shellEscape $ toCommand shellopts) diff --git a/Remote/Web.hs b/Remote/Web.hs index d3d140d73..60f64cfe0 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -52,7 +52,7 @@ webUUID = "00000000-0000-0000-0000-000000000001" gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r _ _ = - return $ Remote { + return Remote { uuid = webUUID, cost = expensiveRemoteCost, name = Git.repoDescribe r, @@ -111,7 +111,7 @@ checkKey' (u:us) = do if e then return e else checkKey' us urlexists :: URLString -> IO Bool -urlexists url = do +urlexists url = case parseURI url of Nothing -> return False Just u -> do diff --git a/Touch.hsc b/Touch.hsc index 4f26855d2..dd0c38984 100644 --- a/Touch.hsc +++ b/Touch.hsc @@ -15,6 +15,7 @@ module Touch ( import Foreign import Foreign.C +import Control.Monad (when) newtype TimeSpec = TimeSpec CTime @@ -66,9 +67,7 @@ touchBoth file atime mtime follow = withCString file $ \f -> do pokeArray ptr [atime, mtime] r <- c_utimensat at_fdcwd f ptr flags - if (r /= 0) - then throwErrno "touchBoth" - else return () + when (r /= 0) $ throwErrno "touchBoth" where flags = if follow then 0 diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs index 5ee4a91df..2e06dd92b 100644 --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -20,10 +20,8 @@ copyFile src dest = do removeFile dest boolSystem "cp" [params, File src, File dest] where - params = if SysConfig.cp_reflink_auto - then Params "--reflink=auto" - else if SysConfig.cp_a - then Params "-a" - else if SysConfig.cp_p - then Params "-p" - else Params "" + params + | SysConfig.cp_reflink_auto = Params "--reflink=auto" + | SysConfig.cp_a = Params "-a" + | SysConfig.cp_p = Params "-p" + | otherwise = Params "" diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs index 7af2eadaf..f2bc333ea 100644 --- a/Utility/DataUnits.hs +++ b/Utility/DataUnits.hs @@ -106,7 +106,7 @@ oldSchoolUnits = map mingle $ zip storageUnits memoryUnits {- approximate display of a particular number of bytes -} roughSize :: [Unit] -> Bool -> ByteSize -> String roughSize units abbrev i - | i < 0 = "-" ++ findUnit units' (negate i) + | i < 0 = '-' : findUnit units' (negate i) | otherwise = findUnit units' i where units' = reverse $ sort units -- largest first @@ -139,10 +139,10 @@ readSize :: [Unit] -> String -> Maybe ByteSize readSize units input | null parsednum = Nothing | null parsedunit = Nothing - | otherwise = Just $ round $ number * (fromIntegral multiplier) + | otherwise = Just $ round $ number * fromIntegral multiplier where (number, rest) = head parsednum - multiplier = head $ parsedunit + multiplier = head parsedunit unitname = takeWhile isAlpha $ dropWhile isSpace rest parsednum = reads input :: [(Double, String)] diff --git a/Utility/Dot.hs b/Utility/Dot.hs index 869684996..83f52a3cc 100644 --- a/Utility/Dot.hs +++ b/Utility/Dot.hs @@ -20,13 +20,13 @@ graphNode nodeid desc = label desc $ quote nodeid {- an edge between two nodes -} graphEdge :: String -> String -> Maybe String -> String -graphEdge fromid toid desc = indent $ maybe edge (\d -> label d edge) desc +graphEdge fromid toid desc = indent $ maybe edge (`label` edge) desc where edge = quote fromid ++ " -> " ++ quote toid {- adds a label to a node or edge -} label :: String -> String -> String -label l s = attr "label" l s +label = attr "label" {- adds an attribute to a node or edge - (can be called multiple times for multiple attributes) -} @@ -35,7 +35,7 @@ attr a v s = s ++ " [ " ++ a ++ "=" ++ quote v ++ " ]" {- fills a node with a color -} fillColor :: String -> String -> String -fillColor color s = attr "fillcolor" color $ attr "style" "filled" $ s +fillColor color s = attr "fillcolor" color $ attr "style" "filled" s {- apply to graphNode to put the node in a labeled box -} subGraph :: String -> String -> String -> String -> String @@ -52,10 +52,10 @@ subGraph subid l color s = setlabel = "label=" ++ quote l setfilled = "style=" ++ quote "filled" setcolor = "fillcolor=" ++ quote color - ii x = (indent $ indent x) ++ "\n" + ii x = indent (indent x) ++ "\n" indent ::String -> String -indent s = "\t" ++ s +indent s = '\t' : s quote :: String -> String quote s = "\"" ++ s' ++ "\"" diff --git a/Utility/RsyncFile.hs b/Utility/RsyncFile.hs index c68909d2d..6e21ba063 100644 --- a/Utility/RsyncFile.hs +++ b/Utility/RsyncFile.hs @@ -19,7 +19,7 @@ rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand comman {- rsync requires some weird, non-shell like quoting in - here. A doubled single quote inside the single quoted - string is a single quote. -} - escape s = "'" ++ (join "''" $ split "'" s) ++ "'" + escape s = "'" ++ join "''" (split "'" s) ++ "'" {- Runs rsync in server mode to send a file, and exits. -} rsyncServerSend :: FilePath -> IO () -- cgit v1.2.3