This commit is contained in:
Joey Hess 2012-01-10 15:36:54 -04:00
parent 16e7178f20
commit abdacf58ed
8 changed files with 26 additions and 41 deletions

View file

@ -68,15 +68,15 @@ create = do
return () return ()
{- Returns the ref of the branch, creating it first if necessary. -} {- Returns the ref of the branch, creating it first if necessary. -}
getBranch :: Annex (Git.Ref) getBranch :: Annex Git.Ref
getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< branchsha getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
where where
go True = do go True = do
inRepo $ Git.Command.run "branch" inRepo $ Git.Command.run "branch"
[Param $ show name, Param $ show originname] [Param $ show name, Param $ show originname]
fromMaybe (error $ "failed to create " ++ show name) fromMaybe (error $ "failed to create " ++ show name)
<$> branchsha <$> branchsha
go False = withIndex' True $ do go False = withIndex' True $
inRepo $ Git.Branch.commit "branch created" fullname [] inRepo $ Git.Branch.commit "branch created" fullname []
use sha = do use sha = do
setIndexSha sha setIndexSha sha

View file

@ -47,7 +47,7 @@ dispatch args cmds commonoptions header getgitrepo = do
- the Command being run, and the remaining parameters for the command. -} - the Command being run, and the remaining parameters for the command. -}
parseCmd :: Params -> [Command] -> [Option] -> String -> (Flags, Command, Params) parseCmd :: Params -> [Command] -> [Option] -> String -> (Flags, Command, Params)
parseCmd argv cmds commonoptions header parseCmd argv cmds commonoptions header
| name == Nothing = err "missing command" | isNothing name = err "missing command"
| null matches = err $ "unknown command " ++ fromJust name | null matches = err $ "unknown command " ++ fromJust name
| otherwise = check $ getOpt Permute (commonoptions ++ cmdoptions cmd) args | otherwise = check $ getOpt Permute (commonoptions ++ cmdoptions cmd) args
where where

View file

@ -52,7 +52,7 @@ withBarePresentKeys a params = isBareRepo >>= go
go True = do go True = do
unless (null params) $ unless (null params) $
error "fsck should be run without parameters in a bare repository" error "fsck should be run without parameters in a bare repository"
prepStart a loggedKeys map a <$> loggedKeys
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

View file

@ -1,6 +1,6 @@
{- git-annex trust {- git-annex trust log
- -
- Copyright 2010 Joey Hess <joey@kitenet.net> - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -76,14 +76,12 @@ trustMap = do
where where
configuredtrust r = configuredtrust r =
maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$> maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$>
(convert <$> getTrustLevel (Types.Remote.repo r)) maybe Nothing convert <$>
convert :: Maybe String -> Maybe TrustLevel getTrustLevel (Types.Remote.repo r)
convert Nothing = Nothing convert "trusted" = Just Trusted
convert (Just s) convert "untrusted" = Just UnTrusted
| s == "trusted" = Just Trusted convert "semitrusted" = Just SemiTrusted
| s == "untrusted" = Just UnTrusted convert _ = Nothing
| s == "semitrusted" = Just SemiTrusted
| otherwise = Nothing
{- The trust.log used to only list trusted repos, without a field for the {- The trust.log used to only list trusted repos, without a field for the
- trust status, which is why this defaults to Trusted. -} - trust status, which is why this defaults to Trusted. -}

View file

@ -200,7 +200,7 @@ showTriedRemotes :: [Remote] -> Annex ()
showTriedRemotes [] = return () showTriedRemotes [] = return ()
showTriedRemotes remotes = showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++ showLongNote $ "Unable to access these remotes: " ++
(join ", " $ map name remotes) join ", " (map name remotes)
forceTrust :: TrustLevel -> String -> Annex () forceTrust :: TrustLevel -> String -> Annex ()
forceTrust level remotename = do forceTrust level remotename = do

17
Seek.hs
View file

@ -23,9 +23,7 @@ import qualified Limit
import qualified Option import qualified Option
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath] seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
seekHelper a params = do seekHelper a params = inRepo $ \g -> runPreserveOrder (`a` g) params
g <- gitRepo
liftIO $ runPreserveOrder (`a` g) params
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
@ -41,9 +39,8 @@ withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
go (file, v) = a (readMaybe v) file go (file, v) = a (readMaybe v) file
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
withBackendFilesInGit a params = do withBackendFilesInGit a params =
files <- seekHelper LsFiles.inRepo params prepBackendPairs a =<< seekHelper LsFiles.inRepo params
prepBackendPairs a files
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
withFilesNotInGit a params = do withFilesNotInGit a params = do
@ -118,18 +115,12 @@ prepBackendPairs a fs = prepFilteredGen a snd (chooseBackends fs)
prepFilteredGen :: (b -> CommandStart) -> (b -> FilePath) -> Annex [b] -> Annex [CommandStart] prepFilteredGen :: (b -> CommandStart) -> (b -> FilePath) -> Annex [b] -> Annex [CommandStart]
prepFilteredGen a d fs = do prepFilteredGen a d fs = do
matcher <- Limit.getMatcher matcher <- Limit.getMatcher
prepStart (proc matcher) fs map (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 return Nothing if ok then a v else return Nothing
{- Generates a list of CommandStart actions that will be run to perform a
- command, using a list (ie of files) coming from an action. The list
- will be produced and consumed lazily. -}
prepStart :: (b -> CommandStart) -> Annex [b] -> Annex [CommandStart]
prepStart a = liftM (map a)
notSymlink :: FilePath -> IO Bool notSymlink :: FilePath -> IO Bool
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f

View file

@ -13,12 +13,10 @@ import qualified Upgrade.V0
import qualified Upgrade.V1 import qualified Upgrade.V1
import qualified Upgrade.V2 import qualified Upgrade.V2
{- Uses the annex.version git config setting to automate upgrades. -}
upgrade :: Annex Bool upgrade :: Annex Bool
upgrade = do upgrade = go =<< getVersion
version <- getVersion where
case version of go (Just "0") = Upgrade.V0.upgrade
Just "0" -> Upgrade.V0.upgrade go (Just "1") = Upgrade.V1.upgrade
Just "1" -> Upgrade.V1.upgrade go (Just "2") = Upgrade.V2.upgrade
Just "2" -> Upgrade.V2.upgrade go _ = return True
_ -> return True

View file

@ -28,9 +28,7 @@ setup :: Git.Repo -> IO ()
setup = cleanup -- idempotency setup = cleanup -- idempotency
cleanup :: Git.Repo -> IO () cleanup :: Git.Repo -> IO ()
cleanup g = do cleanup g = whenM (doesFileExist $ tmpIndex g) $ removeFile $ tmpIndex g
e' <- doesFileExist (tmpIndex g)
when e' $ removeFile (tmpIndex g)
parseArgs :: IO [String] parseArgs :: IO [String]
parseArgs = do parseArgs = do
@ -43,7 +41,7 @@ main :: IO ()
main = do main = do
[aref, bref, newref] <- map Git.Ref <$> parseArgs [aref, bref, newref] <- map Git.Ref <$> parseArgs
g <- Git.Config.read =<< Git.Construct.fromCwd g <- Git.Config.read =<< Git.Construct.fromCwd
_ <- Git.Index.override (tmpIndex g) _ <- Git.Index.override $ tmpIndex g
setup g setup g
Git.UnionMerge.merge aref bref g Git.UnionMerge.merge aref bref g
_ <- Git.Branch.commit "union merge" newref [aref, bref] g _ <- Git.Branch.commit "union merge" newref [aref, bref] g