a few hlints

This commit is contained in:
Joey Hess 2015-04-11 00:10:34 -04:00
parent 32aa42de7d
commit 2b79e6fe08
14 changed files with 20 additions and 21 deletions

View file

@ -37,7 +37,7 @@ import qualified Data.Set as S
- Callers should use Git.Branch.changed first, to make sure that
- there are changed from the current branch to the branch being merged in.
-}
autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Git.Branch.CommitMode -> Annex Bool
autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> Git.Branch.CommitMode -> Annex Bool
autoMergeFrom branch currbranch commitmode = do
showOutput
case currbranch of

View file

@ -538,7 +538,7 @@ getKeysPresent keyloc = do
-}
getstate direct = do
when direct $
void $ inodesChanged
void inodesChanged
Annex.getState id
{- Things to do to record changes to content when shutting down.

View file

@ -257,7 +257,7 @@ annexSentinalFile :: Annex SentinalFile
annexSentinalFile = do
sentinalfile <- fromRepo gitAnnexInodeSentinal
sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
return $ SentinalFile
return SentinalFile
{ sentinalFile = sentinalfile
, sentinalCacheFile = sentinalcachefile
}

View file

@ -38,10 +38,10 @@ setDifferences = do
( do
oldds <- recordedDifferencesFor u
when (ds /= oldds) $
warning $ "Cannot change tunable parameters in already initialized repository."
warning "Cannot change tunable parameters in already initialized repository."
return oldds
, if otherds == mempty
then ifM (not . null . filter (/= u) . M.keys <$> uuidMap)
then ifM (any (/= u) . M.keys <$> uuidMap)
( do
warning "Cannot change tunable parameters in a clone of an existing repository."
return mempty

View file

@ -46,7 +46,7 @@ configHashLevels d config
| otherwise = def
branchHashDir :: GitConfig -> Key -> String
branchHashDir config key = hashDirLower (branchHashLevels config) key
branchHashDir = hashDirLower . branchHashLevels
{- Two different directory hashes may be used. The mixed case hash
- came first, and is fine, except for the problem of case-strict

View file

@ -24,10 +24,10 @@ import Types.Remote (RemoteConfig)
import Data.Either
import qualified Data.Set as S
checkFileMatcher :: (FileMatcher Annex) -> FilePath -> Annex Bool
checkFileMatcher :: FileMatcher Annex -> FilePath -> Annex Bool
checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True
checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
checkMatcher :: FileMatcher Annex -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
checkMatcher matcher mkey afile notpresent d
| isEmpty matcher = return d
| otherwise = case (mkey, afile) of

View file

@ -36,7 +36,7 @@ import Data.Time.Clock.POSIX
-}
genMetaData :: Key -> FilePath -> FileStatus -> Annex ()
genMetaData key file status = do
maybe noop (flip copyMetaData key) =<< catKeyFileHEAD file
maybe noop (`copyMetaData` key) =<< catKeyFileHEAD file
whenM (annexGenMetaData <$> Annex.getGitConfig) $ do
curr <- getCurrentMetaData key
addMetaData key (dateMetaData mtime curr)
@ -52,4 +52,4 @@ dateMetaData mtime old = MetaData $ M.fromList $ filter isnew
]
where
isnew (f, _) = S.null (currentMetaDataValues f old)
(y, m, _d) = toGregorian $ utctDay $ mtime
(y, m, _d) = toGregorian $ utctDay mtime

View file

@ -43,7 +43,7 @@ notifyTransfer direction (Just f) a = do
return ok
else a NotifyWitness
#else
notifyTransfer _ (Just _) a = do a NotifyWitness
notifyTransfer _ (Just _) a = a NotifyWitness
#endif
notifyDrop :: Maybe FilePath -> Bool -> Annex ()

View file

@ -314,7 +314,7 @@ getViewedFileMetaData = getDirMetaData . dirFromViewedFile . takeFileName
- branch for the view.
-}
applyView :: View -> Annex Git.Branch
applyView view = applyView' viewedFileFromReference getWorkTreeMetaData view
applyView = applyView' viewedFileFromReference getWorkTreeMetaData
{- Generates a new branch for a View, which must be a more narrow
- version of the View originally used to generate the currently

View file

@ -179,13 +179,13 @@ includeCredsInfo c storage info = do
Just _ -> do
let (uenv, penv) = credPairEnvironment storage
ret $ "from environment variables (" ++ unwords [uenv, penv] ++ ")"
Nothing -> case (\ck -> M.lookup ck c) =<< credPairRemoteKey storage of
Nothing -> case (`M.lookup` c) =<< credPairRemoteKey storage of
Nothing -> ifM (existsCacheCredPair storage)
( ret "stored locally"
, ret "not available"
)
Just _ -> case extractCipher c of
Just (EncryptedCipher _ _ _) -> ret "embedded in git repository (gpg encrypted)"
Just (EncryptedCipher {}) -> ret "embedded in git repository (gpg encrypted)"
_ -> ret "embedded in git repository (not encrypted)"
where
ret s = return $ ("creds", s) : info

View file

@ -165,7 +165,7 @@ gitAnnexLink file key r config = do
{- This special case is for git submodules on filesystems not
- supporting symlinks; generate link target that will
- work portably. -}
| coreSymlinks config == False && needsSubmoduleFixup r =
| not (coreSymlinks config) && needsSubmoduleFixup r =
fromMaybe whoops $ absNormPathUnix currdir $
Git.repoPath r </> ".git"
| otherwise = Git.localGitDir r

View file

@ -130,8 +130,7 @@ byName' n = go . filter matching <$> remoteList
byNameOrGroup :: RemoteName -> Annex [Remote]
byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." ++ n))
where
go (Just l) = concatMap maybeToList <$>
mapM (byName . Just) (split " " l)
go (Just l) = catMaybes <$> mapM (byName . Just) (split " " l)
go Nothing = maybeToList <$> byName (Just n)
{- Only matches remote name, not UUID -}
@ -343,4 +342,4 @@ claimingUrl url = do
let web = Prelude.head $ filter (\r -> uuid r == webUUID) rs
fromMaybe web <$> firstM checkclaim rs
where
checkclaim = maybe (pure False) (flip id url) . claimUrl
checkclaim = maybe (pure False) (`id` url) . claimUrl

View file

@ -62,8 +62,8 @@ readDifferences :: String -> Differences
readDifferences = maybe UnknownDifferences Differences . readish
getDifferences :: Git.Repo -> Differences
getDifferences r = Differences $ S.fromList $ catMaybes $
map getmaybe [minBound .. maxBound]
getDifferences r = Differences $ S.fromList $
mapMaybe getmaybe [minBound .. maxBound]
where
getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of
Just True -> Just d

View file

@ -25,7 +25,7 @@ type GitAnnexVersion = String
data AutoUpgrade = AskUpgrade | AutoUpgrade | NoAutoUpgrade
deriving (Eq)
toAutoUpgrade :: (Maybe String) -> AutoUpgrade
toAutoUpgrade :: Maybe String -> AutoUpgrade
toAutoUpgrade Nothing = AskUpgrade
toAutoUpgrade (Just s)
| s == "ask" = AskUpgrade