a few hlints
This commit is contained in:
parent
32aa42de7d
commit
2b79e6fe08
14 changed files with 20 additions and 21 deletions
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -257,7 +257,7 @@ annexSentinalFile :: Annex SentinalFile
|
|||
annexSentinalFile = do
|
||||
sentinalfile <- fromRepo gitAnnexInodeSentinal
|
||||
sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
|
||||
return $ SentinalFile
|
||||
return SentinalFile
|
||||
{ sentinalFile = sentinalfile
|
||||
, sentinalCacheFile = sentinalcachefile
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
4
Creds.hs
4
Creds.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue