mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactor

Browse source
This commit is contained in:
Joey Hess 2011-10-29 18:47:53 -04:00
parent 506282399c
commit 61000904d7
2 changed files with 13 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

10
Command.hs
View file

@ -149,22 +149,28 @@ backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs)
runFilteredGen :: (b -> Annex (Maybe a)) -> (b -> FilePath) -> Annex [b] -> Annex [Annex (Maybe a)] runFilteredGen :: (b -> Annex (Maybe a)) -> (b -> FilePath) -> Annex [b] -> Annex [Annex (Maybe a)]
runFilteredGen a d fs = do runFilteredGen a d fs = do
matcher <- Limit.getMatcher matcher <- Limit.getMatcher
liftM (map $ proc matcher) fs runActions (proc matcher) fs
where where
proc matcher v = do proc matcher v = do
let f = d v let f = d v
ok <- matcher f ok <- matcher f
if ok then a v else stop if ok then a v else stop
runActions :: (b -> Annex (Maybe a)) -> Annex [b] -> Annex [Annex (Maybe a)]
runActions a fs = liftM (map a) fs
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a) notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a) isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
isBareRepo :: Annex Bool
isBareRepo = Git.repoIsLocalBare <$> gitRepo
notBareRepo :: Annex a -> Annex a notBareRepo :: Annex a -> Annex a
notBareRepo a = do notBareRepo a = do
whenM (Git.repoIsLocalBare <$> gitRepo) $ whenM isBareRepo $
error "You cannot run this subcommand in a bare repository." error "You cannot run this subcommand in a bare repository."
a a

12
Command/Fsck.hs
View file

@ -13,7 +13,6 @@ import qualified Remote
import qualified Types.Backend import qualified Types.Backend
import qualified Types.Key import qualified Types.Key
import qualified Backend import qualified Backend
import qualified Git
import Annex.Content import Annex.Content
import Logs.Location import Logs.Location
import Logs.Trust import Logs.Trust
@ -44,14 +43,13 @@ perform key file backend numcopies = check
{- To fsck a bare repository, fsck each key in the location log. -} {- To fsck a bare repository, fsck each key in the location log. -}
withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek
withBarePresentKeys a params = do withBarePresentKeys a params = isBareRepo >>= go
bare <- Git.repoIsLocalBare <$> gitRepo where
if bare go False = return []
then do go True = do
unless (null params) $ do unless (null params) $ do
error "fsck should be run without parameters in a bare repository" error "fsck should be run without parameters in a bare repository"
liftM (map a) loggedKeys runActions a loggedKeys
else return []
startBare :: Key -> CommandStart startBare :: Key -> CommandStart
startBare key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of startBare key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of