Merge branch 'master' into autosync
This commit is contained in:
commit
252376d639
12 changed files with 109 additions and 12 deletions
17
Annex.hs
17
Annex.hs
|
@ -5,7 +5,7 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, MultiParamTypeClasses #-}
|
||||||
|
|
||||||
module Annex (
|
module Annex (
|
||||||
Annex,
|
Annex,
|
||||||
|
@ -22,8 +22,9 @@ module Annex (
|
||||||
fromRepo,
|
fromRepo,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Control
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import Control.Monad.Trans.Control (StM, MonadBaseControl, liftBaseWith, restoreM)
|
||||||
|
import Control.Monad.Base (liftBase, MonadBase)
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
@ -45,12 +46,22 @@ newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
|
||||||
deriving (
|
deriving (
|
||||||
Monad,
|
Monad,
|
||||||
MonadIO,
|
MonadIO,
|
||||||
MonadControlIO,
|
|
||||||
MonadState AnnexState,
|
MonadState AnnexState,
|
||||||
Functor,
|
Functor,
|
||||||
Applicative
|
Applicative
|
||||||
)
|
)
|
||||||
|
|
||||||
|
instance MonadBase IO Annex where
|
||||||
|
liftBase = Annex . liftBase
|
||||||
|
|
||||||
|
instance MonadBaseControl IO Annex where
|
||||||
|
newtype StM Annex a = StAnnex (StM (StateT AnnexState IO) a)
|
||||||
|
liftBaseWith f = Annex $ liftBaseWith $ \runInIO ->
|
||||||
|
f $ liftM StAnnex . runInIO . runAnnex
|
||||||
|
restoreM = Annex . restoreM . unStAnnex
|
||||||
|
where
|
||||||
|
unStAnnex (StAnnex st) = st
|
||||||
|
|
||||||
data OutputType = NormalOutput | QuietOutput | JSONOutput
|
data OutputType = NormalOutput | QuietOutput | JSONOutput
|
||||||
|
|
||||||
-- internal state storage
|
-- internal state storage
|
||||||
|
|
|
@ -11,8 +11,8 @@ module Annex.Exception (
|
||||||
throw,
|
throw,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception.Control (handle)
|
import Control.Exception.Lifted (handle)
|
||||||
import Control.Monad.IO.Control (liftIOOp)
|
import Control.Monad.Trans.Control (liftBaseOp)
|
||||||
import Control.Exception hiding (handle, throw)
|
import Control.Exception hiding (handle, throw)
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
@ -20,7 +20,7 @@ import Common.Annex
|
||||||
{- Runs an Annex action, with setup and cleanup both in the IO monad. -}
|
{- Runs an Annex action, with setup and cleanup both in the IO monad. -}
|
||||||
bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a
|
bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a
|
||||||
bracketIO setup cleanup go =
|
bracketIO setup cleanup go =
|
||||||
liftIOOp (Control.Exception.bracket setup cleanup) (const go)
|
liftBaseOp (Control.Exception.bracket setup cleanup) (const go)
|
||||||
|
|
||||||
{- Throws an exception in the Annex monad. -}
|
{- Throws an exception in the Annex monad. -}
|
||||||
throw :: Control.Exception.Exception e => e -> Annex a
|
throw :: Control.Exception.Exception e => e -> Annex a
|
||||||
|
|
2
Makefile
2
Makefile
|
@ -1,6 +1,6 @@
|
||||||
PREFIX=/usr
|
PREFIX=/usr
|
||||||
IGNORE=-ignore-package monads-fd
|
IGNORE=-ignore-package monads-fd
|
||||||
GHCFLAGS=-O2 -Wall $(IGNORE) -fspec-constr-count=5
|
GHCFLAGS=-O2 -Wall $(IGNORE) -fspec-constr-count=8
|
||||||
|
|
||||||
ifdef PROFILE
|
ifdef PROFILE
|
||||||
GHCFLAGS=-prof -auto-all -rtsopts -caf-all -fforce-recomp $(IGNORE)
|
GHCFLAGS=-prof -auto-all -rtsopts -caf-all -fforce-recomp $(IGNORE)
|
||||||
|
|
5
debian/changelog
vendored
5
debian/changelog
vendored
|
@ -8,13 +8,14 @@ git-annex (3.20111212) UNRELEASED; urgency=low
|
||||||
* Test suite improvements. Current top-level test coverage: 75%
|
* Test suite improvements. Current top-level test coverage: 75%
|
||||||
* Improve deletion of files from rsync special remotes. Closes: #652849
|
* Improve deletion of files from rsync special remotes. Closes: #652849
|
||||||
* Add --include, which is the same as --not --exclude.
|
* Add --include, which is the same as --not --exclude.
|
||||||
* Can now be built with older git versions (before 1.7.7); the resulting
|
|
||||||
binary should only be used with old git.
|
|
||||||
* Format strings can be specified using the new --format option, to control
|
* Format strings can be specified using the new --format option, to control
|
||||||
what is output by git annex find.
|
what is output by git annex find.
|
||||||
* Support git annex find --json
|
* Support git annex find --json
|
||||||
* Fixed behavior when multiple insteadOf configs are provided for the
|
* Fixed behavior when multiple insteadOf configs are provided for the
|
||||||
same url base.
|
same url base.
|
||||||
|
* Can now be built with older git versions (before 1.7.7); the resulting
|
||||||
|
binary should only be used with old git.
|
||||||
|
* Updated to build with monad-control 0.3.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Mon, 12 Dec 2011 01:57:49 -0400
|
-- Joey Hess <joeyh@debian.org> Mon, 12 Dec 2011 01:57:49 -0400
|
||||||
|
|
||||||
|
|
3
debian/control
vendored
3
debian/control
vendored
|
@ -13,7 +13,8 @@ Build-Depends:
|
||||||
libghc-utf8-string-dev,
|
libghc-utf8-string-dev,
|
||||||
libghc-hs3-dev (>= 0.5.6),
|
libghc-hs3-dev (>= 0.5.6),
|
||||||
libghc-testpack-dev [any-i386 any-amd64],
|
libghc-testpack-dev [any-i386 any-amd64],
|
||||||
libghc-monad-control-dev,
|
libghc-monad-control-dev (>= 0.3),
|
||||||
|
libghc-lifted-base-dev,
|
||||||
libghc-json-dev,
|
libghc-json-dev,
|
||||||
ikiwiki,
|
ikiwiki,
|
||||||
perlmagick,
|
perlmagick,
|
||||||
|
|
|
@ -0,0 +1,30 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="http://joey.kitenet.net/"
|
||||||
|
nickname="joey"
|
||||||
|
subject="comment 11"
|
||||||
|
date="2011-12-30T21:49:06Z"
|
||||||
|
content="""
|
||||||
|
OMG, my first sizable haskell patch!
|
||||||
|
|
||||||
|
So trying this out..
|
||||||
|
|
||||||
|
In each repo I want to sync, I first `git branch synced/master`
|
||||||
|
|
||||||
|
Then in each repo, I found I had to pull from each of its remotes, to get the tracking branches that `defaultSyncRemotes` looks for to know those remotes are syncable. This was the surprising thing for me, I had expected sync to somehow work out which remotes were syncable without my explicit pull. And it was not very obvious that sync was not doing its thing before I did that, since it still does a lot of \"stuff\".
|
||||||
|
|
||||||
|
Once set up properly, `git annex sync` fetches from each remote, merges, and then pushes to each remote that has a synced branch. Changes propigate around even when some links are one-directional. Cool!
|
||||||
|
|
||||||
|
So it works fine, but I think more needs to be done to make setting up syncing easier. Ideally, all a user would need to do is run \"git annex sync\" and it syncs from all remotes, without needing to manually set up the synced/master branch.
|
||||||
|
|
||||||
|
While this would lose the ability to control which remotes are synced, I think that being able to `git annex sync origin` and only sync from/to origin is sufficient, for the centralized use case.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
Code review:
|
||||||
|
|
||||||
|
Why did you make `branch` strict?
|
||||||
|
|
||||||
|
There is a bit of a bug in your use of Command.Merge.start. The git-annex branch merge code only runs once per git-annex run, and often this comes before sync fetches from the remotes, leading to a push conflict. I've fixed this in my \"sync\" branch, along with a few other minor things.
|
||||||
|
|
||||||
|
`mergeRemote` merges from `refs/remotes/foo/synced/master`. But that will only be up-to-date if `git annex sync` has recently been run there. Is there any reason it couldn't merge from `refs/remotes/foo/master`?
|
||||||
|
"""]]
|
|
@ -0,0 +1,10 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="http://joey.kitenet.net/"
|
||||||
|
nickname="joey"
|
||||||
|
subject="comment 12"
|
||||||
|
date="2011-12-30T23:45:57Z"
|
||||||
|
content="""
|
||||||
|
I have made a new `autosync` branch, where all that the user needs to do is run `git annex sync` and it automatically sets up the synced/master branch. I find this very easy to use, what do you think?
|
||||||
|
|
||||||
|
Note that `autosync` is also pretty smart about not running commands like \"git merge\" and \"git push\" when they would not do anything. So you may find `git annex sync` not showing all the steps you'd expect. The only step a sync always performs now is pulling from the remotes.
|
||||||
|
"""]]
|
|
@ -25,6 +25,7 @@ To build and use git-annex, you will need:
|
||||||
* [SHA](http://hackage.haskell.org/package/SHA)
|
* [SHA](http://hackage.haskell.org/package/SHA)
|
||||||
* [dataenc](http://hackage.haskell.org/package/dataenc)
|
* [dataenc](http://hackage.haskell.org/package/dataenc)
|
||||||
* [monad-control](http://hackage.haskell.org/package/monad-control)
|
* [monad-control](http://hackage.haskell.org/package/monad-control)
|
||||||
|
* [lifted-base](http://hackage.haskell.org/package/lifted-base)
|
||||||
* [TestPack](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/testpack)
|
* [TestPack](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/testpack)
|
||||||
* [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck)
|
* [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck)
|
||||||
* [HTTP](http://hackage.haskell.org/package/HTTP)
|
* [HTTP](http://hackage.haskell.org/package/HTTP)
|
||||||
|
|
|
@ -0,0 +1,8 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="bremner"
|
||||||
|
ip="156.34.79.193"
|
||||||
|
subject="repo name conventions?"
|
||||||
|
date="2011-12-30T21:41:13Z"
|
||||||
|
content="""
|
||||||
|
I'm confused by the fact that the git-annex-shell adc rejects any repo names that don't start with /~/ since none of my repos start that way. It seems work ok if I just delete /\~ from the front of the regex, but I feel like I must be missing something.
|
||||||
|
"""]]
|
|
@ -0,0 +1,33 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="http://joey.kitenet.net/"
|
||||||
|
nickname="joey"
|
||||||
|
subject="comment 4"
|
||||||
|
date="2011-12-31T00:29:45Z"
|
||||||
|
content="""
|
||||||
|
Well a repo url like `gitolite@localhost:testing` puts it in the gitolite user's /~/testing
|
||||||
|
|
||||||
|
This worked when I added the gitolite stuff, anyway.. Let's see if it still does:
|
||||||
|
|
||||||
|
<pre>
|
||||||
|
joey@gnu:~/tmp>mkdir g
|
||||||
|
joey@gnu:~/tmp>cd g
|
||||||
|
joey@gnu:~/tmp/g>git init
|
||||||
|
Initialized empty Git repository in /home/joey/tmp/g/.git/
|
||||||
|
joey@gnu:~/tmp/g>git annex init
|
||||||
|
init ok
|
||||||
|
joey@gnu:~/tmp/g>git remote add test 'gitolite@localhost:testing'
|
||||||
|
joey@gnu:~/tmp/g>touch foo
|
||||||
|
joey@gnu:~/tmp/g>git annex add foo
|
||||||
|
add foo (checksum...) ok
|
||||||
|
(Recording state in git...)
|
||||||
|
joey@gnu:~/tmp/g>git annex copy foo --to test --debug
|
||||||
|
git [\"--git-dir=/home/joey/tmp/g/.git\",\"--work-tree=/home/joey/tmp/g\",\"ls-files\",\"--cached\",\"-z\",\"--\",\"foo\"]
|
||||||
|
git [\"--git-dir=/home/joey/tmp/g/.git\",\"--work-tree=/home/joey/tmp/g\",\"check-attr\",\"annex.numcopies\",\"-z\",\"--stdin\"]
|
||||||
|
git [\"--git-dir=/home/joey/tmp/g/.git\",\"--work-tree=/home/joey/tmp/g\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"]
|
||||||
|
git [\"--git-dir=/home/joey/tmp/g/.git\",\"--work-tree=/home/joey/tmp/g\",\"show-ref\",\"git-annex\"]
|
||||||
|
git [\"--git-dir=/home/joey/tmp/g/.git\",\"--work-tree=/home/joey/tmp/g\",\"cat-file\",\"--batch\"]
|
||||||
|
Running: ssh [\"-4\",\"gitolite@localhost\",\"git-annex-shell 'configlist' '/~/testing'\"]
|
||||||
|
</pre>
|
||||||
|
|
||||||
|
Still seems right, the ADC's regexp will match this the git-annex shell command.
|
||||||
|
"""]]
|
|
@ -5,3 +5,5 @@ Git-annex doesn't compile with the latest version of monad-control. Would it be
|
||||||
>
|
>
|
||||||
> There is now a branch in git called `new-monad-control` that will build
|
> There is now a branch in git called `new-monad-control` that will build
|
||||||
> with the new monad-control. --[[Joey]]
|
> with the new monad-control. --[[Joey]]
|
||||||
|
|
||||||
|
>> Now merged to master. [[done]] --[[Joey]]
|
||||||
|
|
|
@ -30,8 +30,8 @@ Executable git-annex
|
||||||
Main-Is: git-annex.hs
|
Main-Is: git-annex.hs
|
||||||
Build-Depends: MissingH, hslogger, directory, filepath,
|
Build-Depends: MissingH, hslogger, directory, filepath,
|
||||||
unix, containers, utf8-string, network, mtl, bytestring, old-locale, time,
|
unix, containers, utf8-string, network, mtl, bytestring, old-locale, time,
|
||||||
pcre-light, extensible-exceptions, dataenc, SHA, process, hS3, HTTP,
|
pcre-light, extensible-exceptions, dataenc, SHA, process, hS3, json, HTTP,
|
||||||
base < 5, monad-control < 0.3, json
|
base < 5, monad-control, transformers-base, lifted-base
|
||||||
|
|
||||||
Executable git-annex-shell
|
Executable git-annex-shell
|
||||||
Main-Is: git-annex-shell.hs
|
Main-Is: git-annex-shell.hs
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue