diff --git a/Backend.hs b/Backend.hs index 0c9ea8d0b7..d129139850 100644 --- a/Backend.hs +++ b/Backend.hs @@ -111,7 +111,7 @@ chooseBackends :: [FilePath] -> Annex [BackendFile] chooseBackends fs = do g <- Annex.gitRepo forced <- Annex.getState Annex.forcebackend - if forced /= Nothing + if isJust forced then do l <- orderedList return $ map (\f -> (Just $ head l, f)) fs diff --git a/Backend/SHA.hs b/Backend/SHA.hs index ed2a47db9b..15d3fa20d1 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -38,7 +38,7 @@ backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes genBackend :: SHASize -> Maybe (Backend Annex) genBackend size - | shaCommand size == Nothing = Nothing + | isNothing (shaCommand size) = Nothing | otherwise = Just b where b = Types.Backend.Backend diff --git a/Command.hs b/Command.hs index cc9bcbf0c9..c061c7c464 100644 --- a/Command.hs +++ b/Command.hs @@ -162,7 +162,7 @@ withNothing a [] = return [a] withNothing _ _ = error "This command takes no parameters." runFiltered :: (FilePath -> Annex (Maybe a)) -> Annex [FilePath] -> Annex [Annex (Maybe a)] -runFiltered a fs = runFilteredGen a id fs +runFiltered a = runFilteredGen a id backendPairs :: (BackendFile -> CommandStart) -> CommandSeek backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index d9fcc17e2b..2e9e04fd3e 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -28,7 +28,7 @@ import Utility.Path import Utility.Conditional command :: [Command] -command = [repoCommand "addurl" (paramRepeating $ paramUrl) seek +command = [repoCommand "addurl" (paramRepeating paramUrl) seek "add urls to annex"] seek :: [CommandSeek] diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 671f945d22..c6d9f52003 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -35,7 +35,7 @@ start ws = do when (null ws) needname (u, c) <- findByName name - let fullconfig = M.union config c + let fullconfig = config `M.union` c t <- findType fullconfig showStart "initremote" name diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 2be9108512..054db6e27b 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -12,6 +12,7 @@ import Control.Applicative import System.Posix.Files import System.Directory import System.FilePath +import Data.Maybe import Command import qualified Annex @@ -48,7 +49,7 @@ start (b, file) = isAnnexed file $ \(key, oldbackend) -> do {- Checks if a key is upgradable to a newer representation. -} {- Ideally, all keys have file size metadata. Old keys may not. -} upgradableKey :: Key -> Bool -upgradableKey key = Types.Key.keySize key == Nothing +upgradableKey key = isNothing $ Types.Key.keySize key perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform file oldkey newbackend = do diff --git a/Command/Status.hs b/Command/Status.hs index fc306bbe5e..6da8064f85 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -94,11 +94,11 @@ supported_remote_types = stat "supported remote types" $ local_annex_size :: Stat local_annex_size = stat "local annex size" $ - cachedKeysPresent >>= return . keySizeSum + keySizeSum <$> cachedKeysPresent total_annex_size :: Stat total_annex_size = stat "total annex size" $ - cachedKeysReferenced >>= return . keySizeSum + keySizeSum <$> cachedKeysReferenced local_annex_keys :: Stat local_annex_keys = stat "local annex keys" $ diff --git a/Git.hs b/Git.hs index cd6cdfbfd0..86a8c7695c 100644 --- a/Git.hs +++ b/Git.hs @@ -62,7 +62,7 @@ module Git ( prop_idempotent_deencode ) where -import Control.Monad (unless, when) +import Control.Monad (unless, when, liftM2) import Control.Applicative import System.Directory import System.FilePath @@ -425,7 +425,7 @@ getSha :: String -> IO String -> IO String getSha subcommand a = do t <- a let t' = if last t == '\n' - then take (length t - 1) t + then init t else t when (length t' /= shaSize) $ error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")" @@ -576,7 +576,7 @@ decodeGitFile f@(c:s) | otherwise = f where e = '\\' - middle = take (length s - 1) s + middle = init s unescape (b, []) = b -- look for escapes starting with '\' unescape (b, v) = b ++ beginning ++ unescape (decode rest) @@ -702,7 +702,6 @@ isRepoTop dir = do where isRepo = gitSignature ".git" ".git/config" isBareRepo = gitSignature "objects" "config" - gitSignature subdir file = do - s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) - f <- (doesFileExist (dir ++ "/" ++ file)) - return (s && f) + gitSignature subdir file = liftM2 (&&) + (doesDirectoryExist (dir ++ "/" ++ subdir)) + (doesFileExist (dir ++ "/" ++ file)) diff --git a/GitAnnex.hs b/GitAnnex.hs index a284daad5c..a9d469b44e 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -108,11 +108,11 @@ options = commonOptions ++ "override trust setting to untrusted" , Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE") "override git configuration setting" - , Option ['x'] ["exclude"] (ReqArg (Limit.addExclude) paramGlob) + , Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob) "skip files matching the glob pattern" - , Option ['i'] ["in"] (ReqArg (Limit.addIn) paramRemote) + , Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote) "skip files not present in a remote" - , Option ['C'] ["copies"] (ReqArg (Limit.addCopies) paramNumber) + , Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber) "skip files with fewer copies" ] ++ matcherOptions where diff --git a/Init.hs b/Init.hs index 2067c524cf..4df1599333 100644 --- a/Init.hs +++ b/Init.hs @@ -33,8 +33,7 @@ initialize = do gitPreCommitHookWrite uninitialize :: Annex () -uninitialize = do - gitPreCommitHookUnWrite +uninitialize = gitPreCommitHookUnWrite {- Will automatically initialize if there is already a git-annex branch from somewhere. Otherwise, require a manual init diff --git a/Limit.hs b/Limit.hs index b3b041396f..10fc0ea6ca 100644 --- a/Limit.hs +++ b/Limit.hs @@ -69,7 +69,7 @@ addExclude glob = addLimit $ return . notExcluded addIn :: String -> Annex () addIn name = do u <- Remote.nameToUUID name - addLimit $ if name == "." then check local else check (remote u) + addLimit $ if name == "." then check inAnnex else check (remote u) where check a f = Backend.lookupFile f >>= handle a handle _ Nothing = return False @@ -77,12 +77,11 @@ addIn name = do remote u key = do us <- keyLocations key return $ u `elem` us - local key = inAnnex key {- Adds a limit to skip files not believed to have the specified number - of copies. -} addCopies :: String -> Annex () -addCopies num = do +addCopies num = case readMaybe num :: Maybe Int of Nothing -> error "bad number for --copies" Just n -> addLimit $ check n diff --git a/Options.hs b/Options.hs index eeb3639b4d..b5eaf98cd8 100644 --- a/Options.hs +++ b/Options.hs @@ -58,5 +58,5 @@ matcherOptions = , shortopt ")" "close group of options" ] where - longopt o d = Option [] [o] (NoArg (addToken o)) d - shortopt o d = Option o [] (NoArg (addToken o)) d + longopt o = Option [] [o] $ NoArg $ addToken o + shortopt o = Option o [] $ NoArg $ addToken o diff --git a/Remote/Git.hs b/Remote/Git.hs index 9789a06252..d50899c674 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -81,7 +81,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo tryGitConfigRead r | not $ M.null $ Git.configMap r = return r -- already read | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] - | Git.repoIsHttp r = store $ safely $ geturlconfig + | Git.repoIsHttp r = store $ safely geturlconfig | Git.repoIsUrl r = return r | otherwise = store $ safely $ do onLocal r ensureInitialized @@ -101,7 +101,7 @@ tryGitConfigRead r geturlconfig = do s <- Url.get (Git.repoLocation r ++ "/config") - withTempFile "git-annex.tmp" $ \tmpfile -> \h -> do + withTempFile "git-annex.tmp" $ \tmpfile h -> do hPutStr h s hClose h pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $ diff --git a/Remote/S3real.hs b/Remote/S3real.hs index 77b6b6ca40..cafa4f15a8 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -95,7 +95,7 @@ s3Setup u c = handlehost $ M.lookup "host" c defaulthost = do c' <- encryptionSetup c - let fullconfig = M.union c' defaults + let fullconfig = c' `M.union` defaults genBucket fullconfig use fullconfig @@ -209,7 +209,7 @@ s3Bool (Left e) = s3Warning e s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a s3Action r noconn action = do - when (config r == Nothing) $ + when (isNothing $ config r) $ error $ "Missing configuration for special remote " ++ name r let bucket = M.lookup "bucket" $ fromJust $ config r conn <- s3Connection $ fromJust $ config r diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 9c3fd99595..78f7d3adbc 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -173,7 +173,7 @@ readKey1 v = then Just (read (bits !! 2) :: Integer) else Nothing wormy = head bits == "WORM" - mixup = wormy && (isUpper $ head $ bits !! 1) + mixup = wormy && isUpper (head $ bits !! 1) showKey1 :: Key -> String showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } = @@ -248,7 +248,7 @@ logFile' hasher repo key = gitStateDir repo ++ hasher key ++ keyFile key ++ ".log" stateDir :: FilePath -stateDir = addTrailingPathSeparator $ ".git-annex" +stateDir = addTrailingPathSeparator ".git-annex" gitStateDir :: Git.Repo -> FilePath gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo stateDir diff --git a/Utility/JSONStream.hs b/Utility/JSONStream.hs index af3766948f..7910c11941 100644 --- a/Utility/JSONStream.hs +++ b/Utility/JSONStream.hs @@ -19,7 +19,7 @@ import Text.JSON later. -} start :: JSON a => [(String, a)] -> String start l - | last s == endchar = take (length s - 1) s + | last s == endchar = init s | otherwise = bad s where s = encodeStrict $ toJSObject l diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs index 69b78be4a0..01500a2111 100644 --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -63,7 +63,7 @@ consume m (t:ts) = go t where go And = cont $ m `MAnd` next go Or = cont $ m `MOr` next - go Not = cont $ m `MAnd` (MNot next) + go Not = cont $ m `MAnd` MNot next go Open = let (n, r) = consume next rest in (m `MAnd` n, r) go Close = (m, ts) go (Operation o) = (m `MAnd` MOp o, ts) diff --git a/Utility/Path.hs b/Utility/Path.hs index fe474ee825..ce54fb3695 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -19,7 +19,7 @@ import Control.Applicative parentDir :: FilePath -> FilePath parentDir dir = if not $ null dirs - then slash ++ join s (take (length dirs - 1) dirs) + then slash ++ join s (init dirs) else "" where dirs = filter (not . null) $ split s dir diff --git a/Utility/Touch.hsc b/Utility/Touch.hsc index f27ac31360..fd3320cd1d 100644 --- a/Utility/Touch.hsc +++ b/Utility/Touch.hsc @@ -24,7 +24,7 @@ newtype TimeSpec = TimeSpec CTime touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO () touch :: FilePath -> TimeSpec -> Bool -> IO () -touch file mtime follow = touchBoth file mtime mtime follow +touch file mtime = touchBoth file mtime mtime #include #include diff --git a/configure.hs b/configure.hs index 9f7179c539..b68fa12dbc 100644 --- a/configure.hs +++ b/configure.hs @@ -51,7 +51,7 @@ getVersionString = do let verline = head $ lines changelog return $ middle (words verline !! 1) where - middle s = drop 1 $ take (length s - 1) s + middle = drop 1 . init {- Set up cabal file with version. -} cabalSetup :: IO () diff --git a/git-union-merge.hs b/git-union-merge.hs index 4e1a932b45..8b70e678c9 100644 --- a/git-union-merge.hs +++ b/git-union-merge.hs @@ -23,7 +23,7 @@ tmpIndex :: Git.Repo -> FilePath tmpIndex g = Git.gitDir g "index.git-union-merge" setup :: Git.Repo -> IO () -setup g = cleanup g -- idempotency +setup = cleanup -- idempotency cleanup :: Git.Repo -> IO () cleanup g = do