diff --git a/Common.hs b/Common.hs
--- a/Common.hs
+++ b/Common.hs
@@ -3,7 +3,7 @@
 import Control.Monad as X hiding (join)
 import Control.Monad.IfElse as X
 import Control.Applicative as X
-import Control.Monad.State as X (liftIO)
+import Control.Monad.State.Strict as X (liftIO)
 import Control.Exception.Extensible as X (IOException)
 
 import Data.Maybe as X
@@ -21,9 +21,11 @@
 import System.Exit as X
 
 import Utility.Misc as X
+import Utility.Exception as X
 import Utility.SafeCommand as X
 import Utility.Path as X
 import Utility.Directory as X
 import Utility.Monad as X
+import Utility.FileSystemEncoding as X
 
 import Utility.PartialPrelude as X
diff --git a/Git.hs b/Git.hs
--- a/Git.hs
+++ b/Git.hs
@@ -3,7 +3,7 @@
  - This is written to be completely independant of git-annex and should be
  - suitable for other uses.
  -
- - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -17,36 +17,56 @@
 	repoIsUrl,
 	repoIsSsh,
 	repoIsHttp,
+	repoIsLocal,
 	repoIsLocalBare,
 	repoDescribe,
 	repoLocation,
-	workTree,
-	gitDir,
-	configTrue,
+	repoPath,
+	localGitDir,
 	attributes,
+	hookPath,
 	assertLocal,
 ) where
 
-import qualified Data.Map as M
-import Data.Char
 import Network.URI (uriPath, uriScheme, unEscapeString)
+import System.Posix.Files
 
 import Common
 import Git.Types
+import Utility.FileMode
 
 {- User-visible description of a git repo. -}
 repoDescribe :: Repo -> String
 repoDescribe Repo { remoteName = Just name } = name
 repoDescribe Repo { location = Url url } = show url
-repoDescribe Repo { location = Dir dir } = dir
+repoDescribe Repo { location = Local { worktree = Just dir } } = dir
+repoDescribe Repo { location = Local { gitdir = dir } } = dir
+repoDescribe Repo { location = LocalUnknown dir } = dir
 repoDescribe Repo { location = Unknown } = "UNKNOWN"
 
 {- Location of the repo, either as a path or url. -}
 repoLocation :: Repo -> String
 repoLocation Repo { location = Url url } = show url
-repoLocation Repo { location = Dir dir } = dir
+repoLocation Repo { location = Local { worktree = Just dir } } = dir
+repoLocation Repo { location = Local { gitdir = dir } } = dir
+repoLocation Repo { location = LocalUnknown dir } = dir
 repoLocation Repo { location = Unknown } = undefined
 
+{- Path to a repository. For non-bare, this is the worktree, for bare, 
+ - it's the gitdir, and for URL repositories, is the path on the remote
+ - host. -}
+repoPath :: Repo -> FilePath
+repoPath Repo { location = Url u } = unEscapeString $ uriPath u
+repoPath Repo { location = Local { worktree = Just d } } = d
+repoPath Repo { location = Local { gitdir = d } } = d
+repoPath Repo { location = LocalUnknown dir } = dir
+repoPath Repo { location = Unknown } = undefined
+
+{- Path to a local repository's .git directory. -}
+localGitDir :: Repo -> FilePath
+localGitDir Repo { location = Local { gitdir = d } } = d
+localGitDir _ = undefined
+
 {- Some code needs to vary between URL and normal repos,
  - or bare and non-bare, these functions help with that. -}
 repoIsUrl :: Repo -> Bool
@@ -71,46 +91,35 @@
 	| otherwise = False
 repoIsHttp _ = False
 
-configAvail ::Repo -> Bool
-configAvail Repo { config = c } = c /= M.empty
+repoIsLocal :: Repo -> Bool
+repoIsLocal Repo { location = Local { } } = True
+repoIsLocal _ = False
 
 repoIsLocalBare :: Repo -> Bool
-repoIsLocalBare r@(Repo { location = Dir _ }) = configAvail r && configBare r
+repoIsLocalBare Repo { location = Local { worktree = Nothing } } = True
 repoIsLocalBare _ = False
 
 assertLocal :: Repo -> a -> a
-assertLocal repo action = 
-	if not $ repoIsUrl repo
-		then action
-		else error $ "acting on non-local git repo " ++  repoDescribe repo ++ 
-				" not supported"
-configBare :: Repo -> Bool
-configBare repo = maybe unknown configTrue $ M.lookup "core.bare" $ config repo
-	where
-		unknown = error $ "it is not known if git repo " ++
-			repoDescribe repo ++
-			" is a bare repository; config not read"
+assertLocal repo action
+	| repoIsUrl repo = error $ unwords
+		[ "acting on non-local git repo"
+		, repoDescribe repo
+		, "not supported"
+		]
+	| otherwise = action
 
 {- Path to a repository's gitattributes file. -}
-attributes :: Repo -> String
+attributes :: Repo -> FilePath
 attributes repo
-	| configBare repo = workTree repo ++ "/info/.gitattributes"
-	| otherwise = workTree repo ++ "/.gitattributes"
-
-{- Path to a repository's .git directory. -}
-gitDir :: Repo -> String
-gitDir repo
-	| configBare repo = workTree repo
-	| otherwise = workTree repo </> ".git"
-
-{- Path to a repository's --work-tree, that is, its top.
- -
- - Note that for URL repositories, this is the path on the remote host. -}
-workTree :: Repo -> FilePath
-workTree Repo { location = Url u } = unEscapeString $ uriPath u
-workTree Repo { location = Dir d } = d
-workTree Repo { location = Unknown } = undefined
+	| repoIsLocalBare repo = repoPath repo ++ "/info/.gitattributes"
+	| otherwise = repoPath repo ++ "/.gitattributes"
 
-{- Checks if a string from git config is a true value. -}
-configTrue :: String -> Bool
-configTrue s = map toLower s == "true"
+{- Path to a given hook script in a repository, only if the hook exists
+ - and is executable. -}
+hookPath :: String -> Repo -> IO (Maybe FilePath)
+hookPath script repo = do
+	let hook = localGitDir repo </> "hooks" </> script
+	ifM (catchBoolIO $ isexecutable hook)
+		( return $ Just hook , return Nothing )
+	where
+		isexecutable f = isExecutable . fileMode <$> getFileStatus f
diff --git a/Git/Branch.hs b/Git/Branch.hs
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -7,8 +7,6 @@
 
 module Git.Branch where
 
-import qualified Data.ByteString.Lazy.Char8 as L
-
 import Common
 import Git
 import Git.Sha
@@ -19,15 +17,15 @@
 current r = parse <$> pipeRead [Param "symbolic-ref", Param "HEAD"] r
 	where
 		parse v
-			| L.null v = Nothing
-			| otherwise = Just $ Git.Ref $ firstLine $ L.unpack v
+			| null v = Nothing
+			| otherwise = Just $ Git.Ref $ firstLine v
 
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
 changed :: Branch -> Branch -> Repo -> IO Bool
 changed origbranch newbranch repo
 	| origbranch == newbranch = return False
-	| otherwise = not . L.null <$> diffs
+	| otherwise = not . null <$> diffs
 	where
 		diffs = pipeRead
 			[ Param "log"
@@ -43,14 +41,14 @@
  -}
 fastForward :: Branch -> [Ref] -> Repo -> IO Bool
 fastForward _ [] _ = return True
-fastForward branch (first:rest) repo = do
+fastForward branch (first:rest) repo =
 	-- First, check that the branch does not contain any
 	-- new commits that are not in the first ref. If it does,
 	-- cannot fast-forward.
-	diverged <- changed first branch repo
-	if diverged
-		then no_ff
-		else maybe no_ff do_ff =<< findbest first rest
+	ifM (changed first branch repo)
+		( no_ff
+		, maybe no_ff do_ff =<< findbest first rest
+		)
 	where
 		no_ff = return False
 		do_ff to = do
@@ -73,15 +71,14 @@
  - with the specified parent refs, and returns the committed sha -}
 commit :: String -> Branch -> [Ref] -> Repo -> IO Sha
 commit message branch parentrefs repo = do
-	tree <- getSha "write-tree" $ asString $
+	tree <- getSha "write-tree" $
 		pipeRead [Param "write-tree"] repo
-	sha <- getSha "commit-tree" $ asString $
+	sha <- getSha "commit-tree" $
 		ignorehandle $ pipeWriteRead
 			(map Param $ ["commit-tree", show tree] ++ ps)
-			(L.pack message) repo
+			message repo
 	run "update-ref" [Param $ show branch, Param $ show sha] repo
 	return sha
 	where
 		ignorehandle a = snd <$> a
-		asString a = L.unpack <$> a
 		ps = concatMap (\r -> ["-p", show r]) parentrefs
diff --git a/Git/Command.hs b/Git/Command.hs
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -1,13 +1,16 @@
 {- running git commands
  -
- - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Git.Command where
 
-import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.Text.Lazy as L
+import qualified Data.Text.Lazy.IO as L
+import Control.Concurrent
+import Control.Exception (finally)
 
 import Common
 import Git
@@ -15,11 +18,12 @@
 
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
-gitCommandLine params repo@(Repo { location = Dir _ } ) =
-	-- force use of specified repo via --git-dir and --work-tree
-	[ Param ("--git-dir=" ++ gitDir repo)
-	, Param ("--work-tree=" ++ workTree repo)
-	] ++ params
+gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ params
+	where
+		setdir = Param $ "--git-dir=" ++ gitdir l
+		settree = case worktree l of
+			Nothing -> []
+			Just t -> [Param $ "--work-tree=" ++ t]
 gitCommandLine _ repo = assertLocal repo $ error "internal"
 
 {- Runs git in the specified repo. -}
@@ -31,52 +35,50 @@
 run :: String -> [CommandParam] -> Repo -> IO ()
 run subcommand params repo = assertLocal repo $
 	unlessM (runBool subcommand params repo) $
-		error $ "git " ++ show params ++ " failed"
+		error $ "git " ++ subcommand ++ " " ++ show params ++ " failed"
 
 {- Runs a git subcommand and returns its output, lazily. 
  -
  - Note that this leaves the git process running, and so zombies will
  - result unless reap is called.
  -}
-pipeRead :: [CommandParam] -> Repo -> IO L.ByteString
+pipeRead :: [CommandParam] -> Repo -> IO String
 pipeRead params repo = assertLocal repo $ do
 	(_, h) <- hPipeFrom "git" $ toCommand $ gitCommandLine params repo
-	hSetBinaryMode h True
-	L.hGetContents h
+	fileEncoding h
+	hGetContents h
 
 {- Runs a git subcommand, feeding it input.
  - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}
-pipeWrite :: [CommandParam] -> L.ByteString -> Repo -> IO PipeHandle
+pipeWrite :: [CommandParam] -> L.Text -> Repo -> IO PipeHandle
 pipeWrite params s repo = assertLocal repo $ do
 	(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
-	L.hPut h s
+	L.hPutStr h s
 	hClose h
 	return p
 
 {- Runs a git subcommand, feeding it input, and returning its output.
  - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}
-pipeWriteRead :: [CommandParam] -> L.ByteString -> Repo -> IO (PipeHandle, L.ByteString)
+pipeWriteRead :: [CommandParam] -> String -> Repo -> IO (PipeHandle, String)
 pipeWriteRead params s repo = assertLocal repo $ do
 	(p, from, to) <- hPipeBoth "git" (toCommand $ gitCommandLine params repo)
-	hSetBinaryMode from True
-	L.hPut to s
-	hClose to
-	c <- L.hGetContents from
+	fileEncoding to
+	fileEncoding from
+	_ <- forkIO $ finally (hPutStr to s) (hClose to)
+	c <- hGetContents from
 	return (p, c)
 
 {- Reads null terminated output of a git command (as enabled by the -z 
  - parameter), and splits it. -}
 pipeNullSplit :: [CommandParam] -> Repo -> IO [String]
-pipeNullSplit params repo = map L.unpack <$> pipeNullSplitB params repo
-
-{- For when Strings are not needed. -}
-pipeNullSplitB ::[CommandParam] -> Repo -> IO [L.ByteString]
-pipeNullSplitB params repo = filter (not . L.null) . L.split '\0' <$>
-	pipeRead params repo
+pipeNullSplit params repo =
+	filter (not . null) . split sep <$> pipeRead params repo
+	where
+		sep = "\0"
 
 {- Reaps any zombie git processes. -}
 reap :: IO ()
 reap = do
 	-- throws an exception when there are no child processes
-	r <- catchDefaultIO (getAnyProcessStatus False True) Nothing
-	maybe (return ()) (const reap) r
+	catchDefaultIO (getAnyProcessStatus False True) Nothing
+		>>= maybe noop (const reap)
diff --git a/Git/Config.hs b/Git/Config.hs
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -1,15 +1,14 @@
 {- git repository configuration handling
  -
- - Copyright 2010,2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Git.Config where
 
-import System.Posix.Directory
-import Control.Exception (bracket_)
 import qualified Data.Map as M
+import Data.Char
 
 import Common
 import Git
@@ -20,24 +19,37 @@
 get :: String -> String -> Repo -> String
 get key defaultValue repo = M.findWithDefault defaultValue key (config repo)
 
+{- Returns a list with each line of a multiline config setting. -}
+getList :: String -> Repo -> [String]
+getList key repo = M.findWithDefault [] key (fullconfig repo)
+
 {- Returns a single git config setting, if set. -}
 getMaybe :: String -> Repo -> Maybe String
 getMaybe key repo = M.lookup key (config repo)
 
-{- Runs git config and populates a repo with its config. -}
+{- Runs git config and populates a repo with its config.
+ - Avoids re-reading config when run repeatedly. -}
 read :: Repo -> IO Repo
-read repo@(Repo { location = Dir d }) = do
-	{- Cannot use pipeRead because it relies on the config having
-	   been already read. Instead, chdir to the repo. -}
-	cwd <- getCurrentDirectory
-	if dirContains d cwd
-		then go
-		else bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) go
+read repo@(Repo { config = c })
+	| c == M.empty = read' repo
+	| otherwise = return repo
+
+{- Reads config even if it was read before. -}
+reRead :: Repo -> IO Repo
+reRead = read'
+
+{- Cannot use pipeRead because it relies on the config having been already
+ - read. Instead, chdir to the repo.
+ -}
+read' :: Repo -> IO Repo
+read' repo = go repo
 	where
-		go = pOpen ReadFromPipe "git" ["config", "--null", "--list"] $
-			hRead repo
-read r = assertLocal r $
-	error $ "internal error; trying to read config of " ++ show r
+		go Repo { location = Local { gitdir = d } } = git_config d
+		go Repo { location = LocalUnknown d } = git_config d
+		go _ = assertLocal repo $ error "internal"
+		git_config d = bracketCd d $
+			pOpen ReadFromPipe "git" ["config", "--null", "--list"] $
+				hRead repo
 
 {- Reads git config from a handle and populates a repo with it. -}
 hRead :: Repo -> Handle -> IO Repo
@@ -45,19 +57,37 @@
 	val <- hGetContentsStrict h
 	store val repo
 
-{- Stores a git config into a repo, returning the new version of the repo.
- - The git config may be multiple lines, or a single line. Config settings
- - can be updated inrementally. -}
+{- Stores a git config into a Repo, returning the new version of the Repo.
+ - The git config may be multiple lines, or a single line.
+ - Config settings can be updated incrementally.
+ -}
 store :: String -> Repo -> IO Repo
 store s repo = do
 	let c = parse s
-	let repo' = repo
+	let repo' = updateLocation $ repo
 		{ config = (M.map Prelude.head c) `M.union` config repo
 		, fullconfig = M.unionWith (++) c (fullconfig repo)
 		}
 	rs <- Git.Construct.fromRemotes repo'
 	return $ repo' { remotes = rs }
 
+{- Updates the location of a repo, based on its configuration.
+ -
+ - Git.Construct makes LocalUknown repos, of which only a directory is
+ - known. Once the config is read, this can be fixed up to a Local repo, 
+ - based on the core.bare and core.worktree settings.
+ -}
+updateLocation :: Repo -> Repo
+updateLocation r@(Repo { location = LocalUnknown d })
+	| isBare r = newloc $ Local d Nothing
+	| otherwise = newloc $ Local (d </> ".git") (Just d)
+	where
+		newloc l = r { location = getworktree l }
+		getworktree l = case workTree r of
+			Nothing -> l
+			wt -> l { worktree = wt }
+updateLocation r = r
+
 {- Parses git config --list or git config --null --list output into a
  - config map. -}
 parse :: String -> M.Map String [String]
@@ -71,3 +101,18 @@
 		ls = lines s
 		sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .
 			map (separate (== c))
+
+{- Checks if a string from git config is a true value. -}
+isTrue :: String -> Maybe Bool
+isTrue s
+	| s' == "true" = Just True
+	| s' == "false" = Just False
+	| otherwise = Nothing
+	where
+		s' = map toLower s
+
+isBare :: Repo -> Bool
+isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r
+
+workTree :: Repo -> Maybe FilePath
+workTree = getMaybe "core.worktree"
diff --git a/Git/Construct.hs b/Git/Construct.hs
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -1,12 +1,11 @@
 {- Construction of Git Repo objects
  -
- - Copyright 2010,2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Git.Construct (
-	fromCurrent,
 	fromCwd,
 	fromAbsPath,
 	fromPath,
@@ -21,8 +20,6 @@
 ) where
 
 import System.Posix.User
-import System.Posix.Env (getEnv, unsetEnv)
-import System.Posix.Directory (changeWorkingDirectory)
 import qualified Data.Map as M hiding (map, split)
 import Network.URI
 
@@ -31,34 +28,12 @@
 import Git
 import qualified Git.Url as Url
 
-{- Finds the current git repository.
- -
- - GIT_DIR can override the location of the .git directory.
- -
- - When GIT_WORK_TREE is set, chdir to it, so that anything using
- - this repository runs in the right location. However, this chdir is
- - done after determining GIT_DIR; git does not let GIT_WORK_TREE
- - influence the git directory.
- -
- - Both environment variables are unset, to avoid confusing other git
- - commands that also look at them. This would particularly be a problem
- - when GIT_DIR is relative and we chdir for GIT_WORK_TREE. Instead,
- - the Git module passes --work-tree and --git-dir to git commands it runs.
- -}
-fromCurrent :: IO Repo
-fromCurrent = do
-	r <- maybe fromCwd fromPath =<< getEnv "GIT_DIR"
-	maybe (return ()) changeWorkingDirectory =<< getEnv "GIT_WORK_TREE"
-	unsetEnv "GIT_DIR"
-	unsetEnv "GIT_WORK_TREE"
-	return r
-
 {- Finds the git repository used for the Cwd, which may be in a parent
  - directory. -}
 fromCwd :: IO Repo
 fromCwd = getCurrentDirectory >>= seekUp isRepoTop >>= maybe norepo makerepo
 	where
-		makerepo = newFrom . Dir
+		makerepo = newFrom . LocalUnknown
 		norepo = error "Not in a git repository."
 
 {- Local Repo constructor, accepts a relative or absolute path. -}
@@ -69,27 +44,25 @@
  - specified. -}
 fromAbsPath :: FilePath -> IO Repo
 fromAbsPath dir
-	| "/" `isPrefixOf` dir = do
- 		-- Git always looks for "dir.git" in preference to
-		-- to "dir", even if dir ends in a "/".
-		let canondir = dropTrailingPathSeparator dir
-		let dir' = canondir ++ ".git"
-		e <- doesDirectoryExist dir'
-		if e
-			then ret dir'
-			else if "/.git" `isSuffixOf` canondir
-				then do
-					-- When dir == "foo/.git", git looks
-					-- for "foo/.git/.git", and failing
-					-- that, uses "foo" as the repository.
-					e' <- doesDirectoryExist $ dir </> ".git"
-					if e'
-						then ret dir
-						else ret $ takeDirectory canondir
-				else ret dir
-	| otherwise = error $ "internal error, " ++ dir ++ " is not absolute"
+	| "/" `isPrefixOf` dir =
+		ifM (doesDirectoryExist dir') ( ret dir' , hunt )
+	| otherwise =
+		error $ "internal error, " ++ dir ++ " is not absolute"
 	where
-		ret = newFrom . Dir
+		ret = newFrom . LocalUnknown
+ 		{- Git always looks for "dir.git" in preference to
+		 - to "dir", even if dir ends in a "/". -}
+		canondir = dropTrailingPathSeparator dir
+		dir' = canondir ++ ".git"
+		{- When dir == "foo/.git", git looks for "foo/.git/.git",
+		 - and failing that, uses "foo" as the repository. -}
+		hunt
+			| "/.git" `isSuffixOf` canondir =
+				ifM (doesDirectoryExist $ dir </> ".git")
+					( ret dir
+					, ret $ takeDirectory canondir
+					)
+			| otherwise = ret dir
 
 {- Remote Repo constructor. Throws exception on invalid url.
  -
@@ -124,7 +97,7 @@
 		absurl =
 			Url.scheme reference ++ "//" ++
 			Url.authority reference ++
-			workTree r
+			repoPath r
 
 {- Calculates a list of a repo's configured remotes, by parsing its config. -}
 fromRemotes :: Repo -> IO [Repo]
@@ -193,7 +166,7 @@
 fromRemotePath :: FilePath -> Repo -> IO Repo
 fromRemotePath dir repo = do
 	dir' <- expandTilde dir
-	fromAbsPath $ workTree repo </> dir'
+	fromAbsPath $ repoPath repo </> dir'
 
 {- Git remotes can have a directory that is specified relative
  - to the user's home directory, or that contains tilde expansions.
@@ -229,27 +202,20 @@
 			| otherwise = findname (n++[c]) cs
 
 seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
-seekUp want dir = do
-	ok <- want dir
-	if ok
-		then return $ Just dir
-		else case parentDir dir of
+seekUp want dir =
+	ifM (want dir)
+		( return $ Just dir
+		, case parentDir dir of
 			"" -> return Nothing
 			d -> seekUp want d
+		)
 
 isRepoTop :: FilePath -> IO Bool
-isRepoTop dir = do
-	r <- isRepo
-	if r
-		then return r
-		else isBareRepo
+isRepoTop dir = ifM isRepo ( return True , isBareRepo )
 	where
 		isRepo = gitSignature (".git" </> "config")
-		isBareRepo = do
-			e <- doesDirectoryExist (dir </> "objects")
-			if not e
-				then return e
-				else gitSignature "config"
+		isBareRepo = ifM (doesDirectoryExist $ dir </> "objects")
+			( gitSignature "config" , return False )
 		gitSignature file = doesFileExist (dir </> file)
 
 newFrom :: RepoLocation -> IO Repo
@@ -260,3 +226,5 @@
 	, remotes = []
 	, remoteName = Nothing
 	}
+
+
diff --git a/Git/Queue.hs b/Git/Queue.hs
--- a/Git/Queue.hs
+++ b/Git/Queue.hs
@@ -5,21 +5,23 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE BangPatterns #-}
+
 module Git.Queue (
 	Queue,
 	new,
 	add,
 	size,
 	full,
-	flush
+	flush,
 ) where
 
 import qualified Data.Map as M
 import System.IO
 import System.Cmd.Utils
 import Data.String.Utils
-import Utility.SafeCommand
 
+import Utility.SafeCommand
 import Common
 import Git
 import Git.Command
@@ -34,7 +36,11 @@
 {- A queue of actions to perform (in any order) on a git repository,
  - with lists of files to perform them on. This allows coalescing 
  - similar git commands. -}
-data Queue = Queue Int (M.Map Action [FilePath])
+data Queue = Queue
+	{ size :: Int
+	, _limit :: Int
+	, _items :: M.Map Action [FilePath]
+	}
 	deriving (Show, Eq)
 
 {- A recommended maximum size for the queue, after which it should be
@@ -46,37 +52,33 @@
  - above 20k, so this is a fairly good balance -- the queue will buffer
  - only a few megabytes of stuff and a minimal number of commands will be
  - run by xargs. -}
-maxSize :: Int
-maxSize = 10240
+defaultLimit :: Int
+defaultLimit = 10240
 
 {- Constructor for empty queue. -}
-new :: Queue
-new = Queue 0 M.empty
+new :: Maybe Int -> Queue
+new lim = Queue 0 (fromMaybe defaultLimit lim) M.empty
 
 {- Adds an action to a queue. -}
 add :: Queue -> String -> [CommandParam] -> [FilePath] -> Queue
-add (Queue n m) subcommand params files = Queue (n + 1) m'
+add (Queue cur lim m) subcommand params files = Queue (cur + 1) lim m'
 	where
 		action = Action subcommand params
 		-- There are probably few items in the map, but there
 		-- can be a lot of files per item. So, optimise adding
 		-- files.
 		m' = M.insertWith' const action fs m
-		fs = files ++ M.findWithDefault [] action m
-
-{- Number of items in a queue. -}
-size :: Queue -> Int
-size (Queue n _) = n
+		!fs = files ++ M.findWithDefault [] action m
 
 {- Is a queue large enough that it should be flushed? -}
 full :: Queue -> Bool
-full (Queue n _) = n > maxSize
+full (Queue cur lim  _) = cur > lim
 
 {- Runs a queue on a git repository. -}
 flush :: Queue -> Repo -> IO Queue
-flush (Queue _ m) repo = do
+flush (Queue _ lim m) repo = do
 	forM_ (M.toList m) $ uncurry $ runAction repo
-	return new
+	return $ Queue 0 lim M.empty
 
 {- Runs an Action on a list of files in a git repository.
  -
@@ -90,4 +92,6 @@
 	where
 		params = toCommand $ gitCommandLine
 			(Param (getSubcommand action):getParams action) repo
-		feedxargs h = hPutStr h $ join "\0" files
+		feedxargs h = do
+			fileEncoding h
+			hPutStr h $ join "\0" files
diff --git a/Git/Ref.hs b/Git/Ref.hs
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -7,12 +7,12 @@
 
 module Git.Ref where
 
-import qualified Data.ByteString.Lazy.Char8 as L
-
 import Common
 import Git
 import Git.Command
 
+import Data.Char (chr)
+
 {- Converts a fully qualified git ref into a user-visible string. -}
 describe :: Ref -> String
 describe = show . base
@@ -40,7 +40,7 @@
 
 {- Get the sha of a fully qualified git ref, if it exists. -}
 sha :: Branch -> Repo -> IO (Maybe Sha)
-sha branch repo = process . L.unpack <$> showref repo
+sha branch repo = process <$> showref repo
 	where
 		showref = pipeRead [Param "show-ref",
 			Param "--hash", -- get the hash
@@ -52,7 +52,7 @@
 matching :: Ref -> Repo -> IO [(Ref, Branch)]
 matching ref repo = do
 	r <- pipeRead [Param "show-ref", Param $ show ref] repo
-	return $ map (gen . L.unpack) (L.lines r)
+	return $ map gen (lines r)
 	where
 		gen l = let (r, b) = separate (== ' ') l in
 			(Ref r, Ref b)
@@ -63,3 +63,30 @@
 matchingUniq ref repo = nubBy uniqref <$> matching ref repo
 	where
 		uniqref (a, _) (b, _) = a == b
+
+{- Checks if a String is a legal git ref name.
+ -
+ - The rules for this are complex; see git-check-ref-format(1) -}
+legal :: Bool -> String -> Bool
+legal allowonelevel s = all (== False) illegal
+	where
+		illegal =
+			[ any ("." `isPrefixOf`) pathbits
+			, any (".lock" `isSuffixOf`) pathbits
+			, not allowonelevel && length pathbits < 2
+			, contains ".."
+			, any (\c -> contains [c]) illegalchars
+			, begins "/"
+			, ends "/"
+			, contains "//"
+			, ends "."
+			, contains "@{"
+			, null s
+			]
+		contains v = v `isInfixOf` s
+		ends v = v `isSuffixOf` s
+		begins v = v `isPrefixOf` s
+
+		pathbits = split "/" s
+		illegalchars = " ~^:?*[\\" ++ controlchars
+		controlchars = chr 0o177 : [chr 0 .. chr (0o40-1)]
diff --git a/Git/Types.hs b/Git/Types.hs
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -1,6 +1,6 @@
 {- git data types
  -
- - Copyright 2010,2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -10,9 +10,21 @@
 import Network.URI
 import qualified Data.Map as M
 
-{- There are two types of repositories; those on local disk and those
- - accessed via an URL. -}
-data RepoLocation = Dir FilePath | Url URI | Unknown
+{- Support repositories on local disk, and repositories accessed via an URL.
+ -
+ - Repos on local disk have a git directory, and unless bare, a worktree.
+ -
+ - A local repo may not have had its config read yet, in which case all
+ - that's known about it is its path.
+ -
+ - Finally, an Unknown repository may be known to exist, but nothing
+ - else known about it.
+ -}
+data RepoLocation
+	= Local { gitdir :: FilePath, worktree :: Maybe FilePath }
+	| LocalUnknown FilePath
+	| Url URI
+	| Unknown
 	deriving (Show, Eq)
 
 data Repo = Repo {
diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -1,12 +1,12 @@
 PREFIX=/usr
-BASEFLAGS=-Wall
+BASEFLAGS=-Wall -outputdir tmp
 GHCFLAGS=-O2 $(BASEFLAGS)
 bins=github-backup
 mans=github-backup.1
 all=$(bins)
 
 ifdef PROFILE
-GHCFLAGS=-prof -auto-all -rtsopts -caf-all -fforce-recomp
+GHCFLAGS=-prof -auto-all -rtsopts -caf-all -fforce-recomp $(BASEFLAGS)
 endif
 
 GHCMAKE=ghc $(GHCFLAGS) --make
@@ -32,7 +32,11 @@
 	install -m 0644 $(mans) $(DESTDIR)$(PREFIX)/share/man/man1
 
 clean:
-	rm -f $(bins)
-	find . \( -name \*.o -or -name \*.hi \) -exec rm {} \;
+	rm -rf $(bins) tmp
+
+# Upload to hackage.
+hackage: clean
+	@cabal sdist
+	@cabal upload dist/*.tar.gz
 
 .PHONY: $(bins)
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
 github-backup is a simple tool you run in a git repository you cloned from
 GitHub. It backs up everything GitHub publishes about the repository,
-including other forks, issues, comments, wikis, milestones, pull requests,
-and watchers.
+including branches, tags, other forks, issues, comments, wikis, milestones,
+pull requests, and watchers.
 
 ## Installation
 
diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,2 +1,2 @@
 import Distribution.Simple
-main = defaultMainWithHooks simpleUserHooks
+main = defaultMain
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -13,16 +13,32 @@
 import Control.Exception (throw)
 import Control.Monad
 import Control.Monad.IfElse
+import System.FilePath
+import Control.Applicative
+import Control.Exception (bracket_)
+import System.Posix.Directory
 
 import Utility.SafeCommand
 import Utility.TempFile
+import Utility.Exception
+import Utility.Monad
+import Utility.Path
 
+{- Lists the contents of a directory.
+ - Unlike getDirectoryContents, paths are not relative to the directory. -}
+dirContents :: FilePath -> IO [FilePath]
+dirContents d = map (d </>) . filter notcruft <$> getDirectoryContents d
+	where
+		notcruft "." = False
+		notcruft ".." = False
+		notcruft _ = True
+
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
 moveFile :: FilePath -> FilePath -> IO ()
-moveFile src dest = try (rename src dest) >>= onrename
+moveFile src dest = tryIO (rename src dest) >>= onrename
 	where
-		onrename (Right _) = return ()
+		onrename (Right _) = noop
 		onrename (Left e)
 			| isPermissionError e = rethrow
 			| isDoesNotExistError e = rethrow
@@ -40,11 +56,21 @@
 						Param src, Param tmp]
 					unless ok $ do
 						-- delete any partial
-						_ <- try $
-							removeFile tmp
+						_ <- tryIO $ removeFile tmp
 						rethrow
 		isdir f = do
-			r <- try (getFileStatus f)
+			r <- tryIO $ getFileStatus f
 			case r of
 				(Left _) -> return False
 				(Right s) -> return $ isDirectory s
+
+{- Runs an action in another directory. -}
+bracketCd :: FilePath -> IO a -> IO a
+bracketCd dir a = go =<< getCurrentDirectory
+	where
+		go cwd
+			| dirContains dir cwd = a
+			| otherwise = bracket_
+				(changeWorkingDirectory dir)
+				(changeWorkingDirectory cwd)
+				a
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -8,9 +8,7 @@
 module Utility.Misc where
 
 import System.IO
-import System.IO.Error (try)
 import Control.Monad
-import Control.Applicative
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
@@ -37,22 +35,3 @@
 {- Breaks out the first line. -}
 firstLine :: String-> String
 firstLine = takeWhile (/= '\n')
-
-{- Catches IO errors and returns a Bool -}
-catchBoolIO :: IO Bool -> IO Bool
-catchBoolIO a = catchDefaultIO a False
-
-{- Catches IO errors and returns a Maybe -}
-catchMaybeIO :: IO a -> IO (Maybe a)
-catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
-
-{- Catches IO errors and returns a default value. -}
-catchDefaultIO :: IO a -> a -> IO a
-catchDefaultIO a def = catch a (const $ return def)
-
-{- Catches IO errors and returns the error message. -}
-catchMsgIO :: IO a -> IO (Either String a)
-catchMsgIO a = dispatch <$> try a
-	where
-		dispatch (Left e) = Left $ show e
-		dispatch (Right v) = Right v
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
--- a/Utility/Monad.hs
+++ b/Utility/Monad.hs
@@ -1,6 +1,6 @@
 {- monadic stuff
  -
- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -14,11 +14,7 @@
  - predicate -}
 firstM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
 firstM _ [] = return Nothing
-firstM p (x:xs) = do
-	q <- p x
-	if q
-		then return (Just x)
-		else firstM p xs
+firstM p (x:xs) = ifM (p x) (return $ Just x , firstM p xs)
 
 {- Returns true if any value in the list satisfies the predicate,
  - stopping once one is found. -}
@@ -29,6 +25,20 @@
 untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool
 untilTrue = flip anyM
 
+{- if with a monadic conditional. -}
+ifM :: Monad m => m Bool -> (m a, m a) -> m a
+ifM cond (thenclause, elseclause) = do
+	c <- cond
+	if c then thenclause else elseclause
+
+{- short-circuiting monadic || -}
+(<||>) :: Monad m => m Bool -> m Bool -> m Bool
+ma <||> mb = ifM ma ( return True , mb )
+
+{- short-circuiting monadic && -}
+(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
+ma <&&> mb = ifM ma ( mb , return False )
+
 {- Runs an action, passing its value to an observer before returning it. -}
 observe :: Monad m => (a -> m b) -> m a -> m a
 observe observer a = do
@@ -39,3 +49,7 @@
 {- b `after` a runs first a, then b, and returns the value of a -}
 after :: Monad m => m b -> m a -> m a
 after = observe . const
+
+{- do nothing -}
+noop :: Monad m => m ()
+noop = return ()
diff --git a/Utility/Path.hs b/Utility/Path.hs
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -82,7 +82,7 @@
 		s = [pathSeparator]
 		pfrom = split s from
 		pto = split s to
-		common = map fst $ filter same $ zip pfrom pto
+		common = map fst $ takeWhile same $ zip pfrom pto
 		same (c,d) = c == d
 		uncommon = drop numcommon pto
 		dotdots = replicate (length pfrom - numcommon) ".."
@@ -95,6 +95,15 @@
 	where
 		r = relPathDirToFile from to 
 
+prop_relPathDirToFile_regressionTest :: Bool
+prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
+	where
+		{- Two paths have the same directory component at the same
+		 - location, but it's not really the same directory.
+		 - Code used to get this wrong. -}
+		same_dir_shortcurcuits_at_difference =
+			relPathDirToFile "/tmp/r/lll/xxx/yyy/18" "/tmp/r/.git/annex/objects/18/gk/SHA256-foo/SHA256-foo" == "../../../../.git/annex/objects/18/gk/SHA256-foo/SHA256-foo"
+
 {- Given an original list of files, and an expanded list derived from it,
  - ensures that the original list's ordering is preserved. 
  -
@@ -118,15 +127,6 @@
  -}
 runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
 runPreserveOrder a files = preserveOrder files <$> a files
-
-{- Lists the contents of a directory.
- - Unlike getDirectoryContents, paths are not relative to the directory. -}
-dirContents :: FilePath -> IO [FilePath]
-dirContents d = map (d </>) . filter notcruft <$> getDirectoryContents d
-	where
-		notcruft "." = False
-		notcruft ".." = False
-		notcruft _ = True
 
 {- Current user's home directory. -}
 myHomeDir :: IO FilePath
diff --git a/Utility/TempFile.hs b/Utility/TempFile.hs
--- a/Utility/TempFile.hs
+++ b/Utility/TempFile.hs
@@ -12,7 +12,7 @@
 import System.Posix.Process hiding (executeFile)
 import System.Directory
 
-import Utility.Misc
+import Utility.Exception
 import Utility.Path
 
 {- Runs an action like writeFile, writing to a temp file first and
diff --git a/github-backup.1 b/github-backup.1
--- a/github-backup.1
+++ b/github-backup.1
@@ -8,8 +8,8 @@
 .I github-backup
 is a simple tool you run in a git repository you cloned from
 GitHub. It backs up everything GitHub publishes about the repository,
-including other forks, issues, comments, wikis, milestones, pull requests,
-and watchers.
+including other branches, tags, forks, issues, comments, wikis,
+milestones, pull requests, and watchers.
 .PP
 Alternately, if you pass it the username of a GitHub user, it will check
 out, and back up, all that user's repositories. (Also works to pass
diff --git a/github-backup.cabal b/github-backup.cabal
--- a/github-backup.cabal
+++ b/github-backup.cabal
@@ -1,5 +1,5 @@
 Name: github-backup
-Version: 1.20120314
+Version: 1.20120627
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>
@@ -25,7 +25,7 @@
 Executable github-backup
   Main-Is: github-backup.hs
   Build-Depends: MissingH, hslogger, directory, filepath, containers, mtl,
-   network, extensible-exceptions, unix, bytestring, base < 5,
+   network, extensible-exceptions, unix, bytestring, base >= 4.5, base < 5,
    IfElse, pretty-show, github >= 0.2.1
 
 source-repository head
diff --git a/github-backup.hs b/github-backup.hs
--- a/github-backup.hs
+++ b/github-backup.hs
@@ -220,7 +220,7 @@
 
 workDir :: Backup FilePath
 workDir = (</>)
-		<$> (Git.gitDir <$> getState gitRepo)
+		<$> (Git.repoPath <$> getState gitRepo)
 		<*> pure "github-backup.tmp"
 
 storeSorted :: Ord a => Show a => FilePath -> Request -> [a] -> Backup ()
@@ -270,14 +270,14 @@
 			when (oldbranch == Just branchref) $
 				error $ "it's not currently safe to run github-backup while the " ++
 					branchname ++ " branch is checked out!"
-			exists <- Git.Ref.matching branchref r
-			if null exists
-				then checkout [Param "--orphan", Param branchname]
-				else checkout [Param branchname]
+			ifM (null <$> Git.Ref.matching branchref r)
+				( checkout [Param "--orphan", Param branchname]
+				, checkout [Param branchname]
+				)
 			return oldbranch
-		cleanup Nothing = return ()
+		cleanup Nothing = noop
 		cleanup (Just oldbranch)
-			| name == branchname = return ()
+			| name == branchname = noop
 			| otherwise = checkout [Param "--force", Param name]
 			where
 				name = show $ Git.Ref.base oldbranch
@@ -292,7 +292,7 @@
 	r <- getState gitRepo
 	let git_false_worktree ps = boolSystem "git" $
 		[ Param ("--work-tree=" ++ dir)
-		, Param ("--git-dir=" ++ Git.gitDir r)
+		, Param ("--git-dir=" ++ Git.localGitDir r)
 		] ++ ps
 	liftIO $ whenM (doesDirectoryExist dir) $ onGithubBranch r $ do
 		_ <- git_false_worktree [ Param "add", Param "." ]
@@ -301,33 +301,31 @@
 		removeDirectoryRecursive dir
 
 updateWiki :: GithubUserRepo -> Backup ()
-updateWiki fork = do
-	remotes <- Git.remotes <$> getState gitRepo
-	if any (\r -> Git.remoteName r == Just remote) remotes
-		then do
-			_ <- fetchwiki
-			return ()
-		else do
+updateWiki fork =
+	ifM (any (\r -> Git.remoteName r == Just remote) <$> remotes)
+		( void fetchwiki
+		, void $
 			-- github often does not really have a wiki,
 			-- don't bloat config if there is none
 			unlessM (addRemote remote $ repoWikiUrl fork) $
 				removeRemote remote
-			return ()
+		)
 	where
 		fetchwiki = inRepo $ Git.Command.runBool "fetch" [Param remote]
+		remotes = Git.remotes <$> getState gitRepo
 		remote = remoteFor fork
 		remoteFor (GithubUserRepo user repo) =
 			"github_" ++ user ++ "_" ++ repo ++ ".wiki"
 
 addFork :: GithubUserRepo -> Backup Bool
-addFork fork = do
-	remotes <- gitHubRemotes
-	if fork `elem` remotes
-		then return False
-		else do
+addFork fork =
+	ifM (elem fork <$> gitHubRemotes)
+		( return False
+		, do
 			liftIO $ putStrLn $ "New fork: " ++ repoUrl fork
 			_ <- addRemote (remoteFor fork) (repoUrl fork)
 			return True
+		)
 	where
 		remoteFor (GithubUserRepo user repo) =
 			"github_" ++ user ++ "_" ++ repo
@@ -343,12 +341,10 @@
 		]
 
 removeRemote :: String -> Backup ()
-removeRemote remotename = do
-	_ <- inRepo $ Git.Command.runBool "remote"
-		[ Param "rm"
-		, Param remotename
-		]
-	return ()
+removeRemote remotename = void $ inRepo $ Git.Command.runBool "remote"
+	[ Param "rm"
+	, Param remotename
+	]
 
 {- Fetches from the github remote. Done by github-backup, just because
  - it would be weird for a backup to not fetch all available data.
@@ -368,9 +364,8 @@
 		call name = runRequest $ RequestSimple name repo
 
 storeRetry :: [Request] -> Git.Repo -> IO ()
-storeRetry [] r = do
-	_ <- try $ removeFile (retryFile r) :: IO (Either SomeException ()) 
-	return ()
+storeRetry [] r = void $ do
+	try $ removeFile (retryFile r) :: IO (Either SomeException ()) 
 storeRetry retryrequests r = writeFile (retryFile r) (show retryrequests)
 
 loadRetry :: Git.Repo -> IO [Request]
@@ -378,7 +373,7 @@
 	<$> catchMaybeIO (readFileStrict (retryFile r))
 
 retryFile :: Git.Repo -> FilePath
-retryFile r = Git.gitDir r </> "github-backup.todo"
+retryFile r = Git.localGitDir r </> "github-backup.todo"
 
 retry :: Backup (S.Set Request)
 retry = do