diff options
| -rw-r--r-- | Annex/Branch.hs | 2 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 4 | ||||
| -rw-r--r-- | Command/Sync.hs | 70 | ||||
| -rw-r--r-- | Config.hs | 7 | ||||
| -rw-r--r-- | Git.hs | 20 | ||||
| -rw-r--r-- | GitAnnex.hs | 4 | ||||
| -rw-r--r-- | Utility/BadPrelude.hs | 28 | ||||
| -rw-r--r-- | Utility/Misc.hs | 13 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 11 |
10 files changed, 141 insertions, 20 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 8f0a09fd6..37237ec66 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -141,7 +141,7 @@ update = onceonly $ do let merge_desc = if null branches then "update" else "merging " ++ - unwords (map (show . Git.refDescribe) branches) ++ + unwords (map Git.refDescribe branches) ++ " into " ++ show name unless (null branches) $ do showSideAction merge_desc diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 3df9ab6c2..244f378d9 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -73,6 +73,6 @@ readUnusedLog prefix = do then M.fromList . map parse . lines <$> liftIO (readFile f) else return M.empty where - parse line = (num, fromJust $ readKey $ tail rest) + parse line = (num, fromJust $ readKey rest) where - (num, rest) = break (== ' ') line + (num, rest) = separate (== ' ') line diff --git a/Command/Sync.hs b/Command/Sync.hs new file mode 100644 index 000000000..7dc5f4d24 --- /dev/null +++ b/Command/Sync.hs @@ -0,0 +1,70 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Sync where + +import Common.Annex +import Command +import qualified Annex.Branch +import qualified Git + +import qualified Data.ByteString.Lazy.Char8 as L + +def :: [Command] +def = [command "sync" paramPaths seek "synchronize local repository with remote"] + +-- syncing involves several operations, any of which can independantly fail +seek :: [CommandSeek] +seek = map withNothing [commit, pull, push] + +commit :: CommandStart +commit = do + showStart "commit" "" + next $ next $ do + showOutput + -- Commit will fail when the tree is clean, so ignore failure. + _ <- inRepo $ Git.runBool "commit" [Param "-a", Param "-m", Param "sync"] + return True + +pull :: CommandStart +pull = do + remote <- defaultRemote + showStart "pull" remote + next $ next $ do + showOutput + checkRemote remote + inRepo $ Git.runBool "pull" [Param remote] + +push :: CommandStart +push = do + remote <- defaultRemote + showStart "push" remote + next $ next $ do + Annex.Branch.update + showOutput + inRepo $ Git.runBool "push" [Param remote, matchingbranches] + where + -- git push may be configured to not push matching + -- branches; this should ensure it always does. + matchingbranches = Param ":" + +-- the remote defaults to origin when not configured +defaultRemote :: Annex String +defaultRemote = do + branch <- currentBranch + fromRepo $ Git.configGet ("branch." ++ branch ++ ".remote") "origin" + +currentBranch :: Annex String +currentBranch = last . split "/" . L.unpack . head . L.lines <$> + inRepo (Git.pipeRead [Param "symbolic-ref", Param "HEAD"]) + +checkRemote :: String -> Annex () +checkRemote remote = do + remoteurl <- fromRepo $ + Git.configGet ("remote." ++ remote ++ ".url") "" + when (null remoteurl) $ do + error $ "No url is configured for the remote: " ++ remote @@ -79,9 +79,10 @@ repoNotIgnored r = not . Git.configTrue <$> getConfig r "ignore" "false" {- If a value is specified, it is used; otherwise the default is looked up - in git config. forcenumcopies overrides everything. -} getNumCopies :: Maybe Int -> Annex Int -getNumCopies v = - Annex.getState Annex.forcenumcopies >>= maybe (use v) (return . id) +getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies where use (Just n) = return n - use Nothing = read <$> fromRepo (Git.configGet config "1") + use Nothing = perhaps (return 1) =<< + readMaybe <$> fromRepo (Git.configGet config "1") + perhaps fallback = maybe fallback (return . id) config = "annex.numcopies" @@ -345,7 +345,7 @@ urlPort :: Repo -> Maybe Integer urlPort r = case urlAuthPart uriPort r of ":" -> Nothing - (':':p) -> Just (read p) + (':':p) -> readMaybe p _ -> Nothing {- Hostname of an URL repo, including any username (ie, "user@host") -} @@ -507,11 +507,7 @@ configStore s repo = do configParse :: String -> M.Map String String configParse s = M.fromList $ map pair $ lines s where - pair l = (key l, val l) - key l = head $ keyval l - val l = join sep $ drop 1 $ keyval l - keyval l = split sep l :: [String] - sep = "=" + pair = separate (== '=') {- Calculates a list of a repo's configured remotes, by parsing its config. -} configRemotes :: Repo -> IO [Repo] @@ -550,13 +546,11 @@ genRemote s repo = gen $ calcloc s scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v) scptourl v = "ssh://" ++ host ++ slash dir where - bits = split ":" v - host = head bits - dir = join ":" $ drop 1 bits - slash d | d == "" = "/~/" ++ dir - | head d == '/' = dir - | head d == '~' = '/':dir - | otherwise = "/~/" ++ dir + (host, dir) = separate (== ':') v + slash d | d == "" = "/~/" ++ d + | "/" `isPrefixOf` d = d + | "~" `isPrefixOf` d = '/':d + | otherwise = "/~/" ++ d {- Checks if a string from git config is a true value. -} configTrue :: String -> Bool diff --git a/GitAnnex.hs b/GitAnnex.hs index d768499dd..7871638e4 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -47,6 +47,7 @@ import qualified Command.Trust import qualified Command.Untrust import qualified Command.Semitrust import qualified Command.Dead +import qualified Command.Sync import qualified Command.AddUrl import qualified Command.Map import qualified Command.Upgrade @@ -61,6 +62,8 @@ cmds = concat , Command.Copy.def , Command.Unlock.def , Command.Lock.def + , Command.Sync.def + , Command.AddUrl.def , Command.Init.def , Command.Describe.def , Command.InitRemote.def @@ -72,7 +75,6 @@ cmds = concat , Command.Untrust.def , Command.Semitrust.def , Command.Dead.def - , Command.AddUrl.def , Command.FromKey.def , Command.DropKey.def , Command.Fix.def diff --git a/Utility/BadPrelude.hs b/Utility/BadPrelude.hs new file mode 100644 index 000000000..7921a7e9b --- /dev/null +++ b/Utility/BadPrelude.hs @@ -0,0 +1,28 @@ +{- Some stuff from Prelude should not be used, as it tends to be a source + - of bugs. + - + - This exports functions that conflict with the prelude, which avoids + - them being accidentially used. + -} + +module Utility.BadPrelude where + +{- head is a partial function; head [] is an error -} +head :: [a] -> a +head = Prelude.head + +{- tail is also partial -} +tail :: [a] -> a +tail = Prelude.tail + +{- init too -} +init :: [a] -> a +init = Prelude.init + +{- last too -} +last :: [a] -> a +last = Prelude.last + +{- read should be avoided, as it throws an error -} +read :: Read a => String -> a +read = Prelude.read diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 728598723..541e150b7 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -27,6 +27,19 @@ readMaybe s = case reads s of ((x,_):_) -> Just x _ -> Nothing +{- Like break, but the character matching the condition is not included + - in the second result list. + - + - separate (== ':') "foo:bar" = ("foo", "bar") + - separate (== ':') "foobar" = ("foo, "") + -} +separate :: (a -> Bool) -> [a] -> ([a], [a]) +separate c l = unbreak $ break c l + where + unbreak r@(a, b) + | null b = r + | otherwise = (a, tail b) + {- Catches IO errors and returns a Bool -} catchBoolIO :: IO Bool -> IO Bool catchBoolIO a = catchDefaultIO a False diff --git a/debian/changelog b/debian/changelog index 1c27ad566..b481d9999 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,8 @@ git-annex (3.20111204) UNRELEASED; urgency=low multiple different encrypted special remotes. * unannex: Can be run on files that have been added to the annex, but not yet committed. + * sync: New command that synchronises the local repository and default + remote, by running git commit, pull, and push for you. -- Joey Hess <joeyh@debian.org> Sun, 04 Dec 2011 12:22:37 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 08def0d62..d7a51663f 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -120,6 +120,17 @@ subdirectories). Use this to undo an unlock command if you don't want to modify the files, or have made modifications you want to discard. +* sync + + Use this command when you want to synchronize the local repository + with its default remote (typically "origin"). The sync process involves + first committing all local changes, then pulling and merging any changes + from the remote, and finally pushing the repository's state to the remote. + You can use standard git commands to do each of those steps by hand, + or if you don't want to worry about the details, you can use sync. + + Note that sync does not transfer any file contents from or to the remote. + * addurl [url ...] Downloads each url to a file, which is added to the annex. |