simplified a bunch of Maybe handling
This commit is contained in:
parent
efa7f54405
commit
cad0e1c8b7
19 changed files with 81 additions and 140 deletions
|
@ -58,14 +58,13 @@ start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
|
|||
next $ a key
|
||||
|
||||
perform :: Key -> CommandPerform
|
||||
perform key = do
|
||||
from <- Annex.getState Annex.fromremote
|
||||
case from of
|
||||
Just name -> do
|
||||
perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
|
||||
where
|
||||
dropremote name = do
|
||||
r <- Remote.byName name
|
||||
showNote $ "from " ++ Remote.name r ++ "..."
|
||||
next $ Command.Move.fromCleanup r True key
|
||||
_ -> do
|
||||
droplocal = do
|
||||
backend <- keyBackend key
|
||||
Command.Drop.perform key backend (Just 0) -- force drop
|
||||
|
||||
|
|
|
@ -68,11 +68,11 @@ cleanup u c = do
|
|||
findByName :: String -> Annex (UUID, RemoteClass.RemoteConfig)
|
||||
findByName name = do
|
||||
m <- Remote.readRemoteLog
|
||||
case findByName' name m of
|
||||
Just i -> return i
|
||||
Nothing -> do
|
||||
maybe generate return $ findByName' name m
|
||||
where
|
||||
generate = do
|
||||
uuid <- liftIO $ genUUID
|
||||
return $ (uuid, M.insert nameKey name M.empty)
|
||||
return (uuid, M.insert nameKey name M.empty)
|
||||
|
||||
findByName' :: String -> M.Map UUID RemoteClass.RemoteConfig -> Maybe (UUID, RemoteClass.RemoteConfig)
|
||||
findByName' n m = if null matches then Nothing else Just $ head matches
|
||||
|
@ -86,12 +86,13 @@ findByName' n m = if null matches then Nothing else Just $ head matches
|
|||
|
||||
{- find the specified remote type -}
|
||||
findType :: RemoteClass.RemoteConfig -> Annex (RemoteClass.RemoteType Annex)
|
||||
findType config =
|
||||
case M.lookup typeKey config of
|
||||
Nothing -> error "Specify the type of remote with type="
|
||||
Just s -> case filter (\i -> RemoteClass.typename i == s) Remote.remoteTypes of
|
||||
findType config = maybe unspecified specified $ M.lookup typeKey config
|
||||
where
|
||||
unspecified = error "Specify the type of remote with type="
|
||||
specified s = case filter (findtype s) Remote.remoteTypes of
|
||||
[] -> error $ "Unknown remote type " ++ s
|
||||
(t:_) -> return t
|
||||
findtype s i = RemoteClass.typename i == s
|
||||
|
||||
{- The name of a configured remote is stored in its config using this key. -}
|
||||
nameKey :: String
|
||||
|
|
|
@ -84,10 +84,7 @@ repoName umap r
|
|||
| otherwise = M.findWithDefault fallback repouuid umap
|
||||
where
|
||||
repouuid = getUncachedUUID r
|
||||
fallback =
|
||||
case (Git.repoRemoteName r) of
|
||||
Just n -> n
|
||||
Nothing -> "unknown"
|
||||
fallback = maybe "unknown" id $ Git.repoRemoteName r
|
||||
|
||||
{- A unique id for the node for a repo. Uses the annex.uuid if available. -}
|
||||
nodeId :: Git.Repo -> String
|
||||
|
@ -121,13 +118,10 @@ edge umap fullinfo from to =
|
|||
{- Only name an edge if the name is different than the name
|
||||
- that will be used for the destination node, and is
|
||||
- different from its hostname. (This reduces visual clutter.) -}
|
||||
edgename =
|
||||
case (Git.repoRemoteName to) of
|
||||
Nothing -> Nothing
|
||||
Just n ->
|
||||
if (n == repoName umap fullto || n == hostname fullto)
|
||||
then Nothing
|
||||
else Just n
|
||||
edgename = maybe Nothing calcname $ Git.repoRemoteName to
|
||||
calcname n
|
||||
| n == repoName umap fullto || n == hostname fullto = Nothing
|
||||
| otherwise = Just n
|
||||
|
||||
unreachable :: String -> String
|
||||
unreachable = Dot.fillColor "red"
|
||||
|
|
|
@ -41,12 +41,7 @@ start = notBareRepo $ do
|
|||
|
||||
perform :: CommandPerform
|
||||
perform = do
|
||||
from <- Annex.getState Annex.fromremote
|
||||
case from of
|
||||
Just name -> do
|
||||
r <- Remote.byName name
|
||||
checkRemoteUnused r
|
||||
_ -> checkUnused
|
||||
maybe checkUnused checkRemoteUnused =<< Annex.getState Annex.fromremote
|
||||
next $ return True
|
||||
|
||||
checkUnused :: Annex ()
|
||||
|
@ -63,8 +58,11 @@ checkUnused = do
|
|||
writeUnusedFile file unusedlist
|
||||
return $ length l
|
||||
|
||||
checkRemoteUnused :: Remote.Remote Annex -> Annex ()
|
||||
checkRemoteUnused r = do
|
||||
checkRemoteUnused :: String -> Annex ()
|
||||
checkRemoteUnused name = checkRemoteUnused' =<< Remote.byName name
|
||||
|
||||
checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
|
||||
checkRemoteUnused' r = do
|
||||
g <- Annex.gitRepo
|
||||
showNote $ "checking for unused data on " ++ Remote.name r ++ "..."
|
||||
referenced <- getKeysReferenced
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue