tweaks
This commit is contained in:
parent
16e7178f20
commit
abdacf58ed
8 changed files with 26 additions and 41 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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
17
Seek.hs
|
@ -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
|
||||||
|
|
14
Upgrade.hs
14
Upgrade.hs
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue