aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-07-15 12:47:14 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-07-15 12:47:14 -0400
commit6c396a256c93464d726c66a95132536941871ee8 (patch)
tree7f934c9eae22a9cfd3fb1672ebd7bf6870439c81
parent185f0b687081f47d059cc0503f4f6b671868f753 (diff)
finished hlint pass
-rw-r--r--Command/Add.hs6
-rw-r--r--Command/DropUnused.hs9
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Command/InAnnex.hs2
-rw-r--r--Command/InitRemote.hs8
-rw-r--r--Command/Map.hs19
-rw-r--r--Command/Move.hs2
-rw-r--r--Command/SetKey.hs4
-rw-r--r--Command/Status.hs16
-rw-r--r--Command/Uninit.hs5
-rw-r--r--Command/Unused.hs16
-rw-r--r--Command/Version.hs2
-rw-r--r--Command/Whereis.hs4
-rw-r--r--Locations.hs4
-rw-r--r--Remote/Bup.hs20
-rw-r--r--Remote/Directory.hs5
-rw-r--r--Remote/Encryptable.hs4
-rw-r--r--Remote/Git.hs6
-rw-r--r--Remote/Hook.hs16
-rw-r--r--Remote/Rsync.hs12
-rw-r--r--Remote/S3real.hs24
-rw-r--r--Remote/Special.hs2
-rw-r--r--Remote/Ssh.hs2
-rw-r--r--Remote/Web.hs4
-rw-r--r--Touch.hsc5
-rw-r--r--Utility/CopyFile.hs12
-rw-r--r--Utility/DataUnits.hs6
-rw-r--r--Utility/Dot.hs10
-rw-r--r--Utility/RsyncFile.hs2
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 ()