type based git config handling

Now there's a Config type, that's extracted from the git config at startup.
Note that laziness means that individual config values are only looked up
and parsed on demand, and so we get implicit memoization for all of them.
So this is not only prettier and more type safe, it optimises several
places that didn't have explicit memoization before. As well as getting rid
of the ugly explicit memoization code.

Not yet done for annex.<remote>.* configuration settings.

Annex.hs

@@ -1,6 +1,6 @@
 {- git-annex monad
  -
- - 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.
  -}
@@ -28,6 +28,9 @@ module Annex (
 	gitRepo,
 	inRepo,
 	fromRepo,
+	getConfig,
+	changeConfig,
+	changeGitRepo,
 ) where
 
 import "mtl" Control.Monad.State.Strict
@@ -43,6 +46,7 @@ import Git.CheckAttr
 import Git.SharedRepository
 import qualified Git.Queue
 import Types.Backend
+import Types.Config
 import qualified Types.Remote
 import Types.Crypto
 import Types.BranchState
@@ -88,6 +92,7 @@ type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> Fi
 -- internal state storage
 data AnnexState = AnnexState
 	{ repo :: Git.Repo
+	, config :: Config
 	, backends :: [BackendA Annex]
 	, remotes :: [Types.Remote.RemoteA Annex]
 	, output :: MessageState
@@ -99,7 +104,6 @@ data AnnexState = AnnexState
 	, catfilehandle :: Maybe CatFileHandle
 	, checkattrhandle :: Maybe CheckAttrHandle
 	, forcebackend :: Maybe String
-	, forcenumcopies :: Maybe Int
 	, limit :: Matcher (FileInfo -> Annex Bool)
 	, uuidmap :: Maybe UUIDMap
 	, preferredcontentmap :: Maybe PreferredContentMap
@@ -118,6 +122,7 @@ data AnnexState = AnnexState
 newState :: Git.Repo -> AnnexState
 newState gitrepo = AnnexState
 	{ repo = gitrepo
+	, config = extractConfig gitrepo
 	, backends = []
 	, remotes = []
 	, output = defaultMessageState
@@ -129,7 +134,6 @@ newState gitrepo = AnnexState
 	, catfilehandle = Nothing
 	, checkattrhandle = Nothing
 	, forcebackend = Nothing
-	, forcenumcopies = Nothing
 	, limit = Left []
 	, uuidmap = Nothing
 	, preferredcontentmap = Nothing
@@ -197,3 +201,18 @@ inRepo a = liftIO . a =<< gitRepo
 {- Extracts a value from the annex's git repisitory. -}
 fromRepo :: (Git.Repo -> a) -> Annex a
 fromRepo a = a <$> gitRepo
+
+{- Gets the Config settings. -}
+getConfig :: Annex Config
+getConfig = getState config
+
+{- Modifies a Config setting. -}
+changeConfig :: (Config -> Config) -> Annex ()
+changeConfig a = changeState $ \s -> s { config = a (config s) }
+
+{- Changing the git Repo data also involves re-extracting its Config. -}
+changeGitRepo :: Git.Repo -> Annex ()
+changeGitRepo r = changeState $ \s -> s
+	{ repo = r
+	, config = extractConfig r
+	}

Annex/Content.hs

@@ -35,7 +35,6 @@ import System.IO.Unsafe (unsafeInterleaveIO)
 import Common.Annex
 import Logs.Location
 import qualified Git
-import qualified Git.Config
 import qualified Annex
 import qualified Annex.Queue
 import qualified Annex.Branch
@@ -188,7 +187,7 @@ withTmp key action = do
  - in a destination (or the annex) printing a warning if not. -}
 checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Annex Bool
 checkDiskSpace destination key alreadythere = do
-	reserve <- getDiskReserve
+	reserve <- annexDiskReserve <$> Annex.getConfig
 	free <- liftIO . getDiskFree =<< dir
 	force <- Annex.getState Annex.force
 	case (free, keySize key) of
@@ -396,11 +395,8 @@ saveState :: Bool -> Annex ()
 saveState nocommit = doSideAction $ do
 	Annex.Queue.flush
 	unless nocommit $
-		whenM alwayscommit $
+		whenM (annexAlwaysCommit <$> Annex.getConfig) $
 			Annex.Branch.commit "update"
-  where
-	alwayscommit = fromMaybe True . Git.Config.isTrue
-		<$> getConfig (annexConfig "alwayscommit") ""
 
 {- Downloads content from any of a list of urls. -}
 downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool

Annex/Queue.hs

@@ -17,7 +17,6 @@ import Common.Annex
 import Annex hiding (new)
 import qualified Git.Queue
 import qualified Git.UpdateIndex
-import Config
 
 {- Adds a git command to the queue. -}
 addCommand :: String -> [CommandParam] -> [FilePath] -> Annex ()
@@ -55,11 +54,9 @@ get = maybe new return =<< getState repoqueue
 
 new :: Annex Git.Queue.Queue
 new = do
-	q <- Git.Queue.new <$> queuesize
+	q <- Git.Queue.new . annexQueueSize <$> getConfig
 	store q
 	return q
-  where
-	queuesize = readish <$> getConfig (annexConfig "queuesize") ""
 
 store :: Git.Queue.Queue -> Annex ()
 store q = changeState $ \s -> s { repoqueue = Just q }

Annex/Ssh.hs

@@ -18,9 +18,8 @@ import Common.Annex
 import Annex.LockPool
 import Annex.Perms
 #ifndef WITH_OLD_SSH
-import qualified Git.Config
-import Config
 import qualified Build.SysConfig as SysConfig
+import qualified Annex
 #endif
 
 {- Generates parameters to ssh to a given host (or user@host) on a given
@@ -60,8 +59,7 @@ sshInfo (host, port) = ifM caching
 	caching = return False
 #else
 	caching = fromMaybe SysConfig.sshconnectioncaching 
-		. Git.Config.isTrue
+		. annexSshCaching <$> Annex.getConfig
-		<$> getConfig (annexConfig "sshcaching") ""
 #endif
 
 cacheParams :: FilePath -> [CommandParam]

Assistant/Threads/Committer.hs

@@ -32,6 +32,7 @@ import Types.KeySource
 import Config
 import Annex.Exception
 import Annex.Content
+import qualified Annex
 
 import Data.Time.Clock
 import Data.Tuple.Utils
@@ -41,9 +42,9 @@ import Data.Either
 {- This thread makes git commits at appropriate times. -}
 commitThread :: NamedThread
 commitThread = NamedThread "Committer" $ do
-	delayadd <- liftAnnex $ do
+	delayadd <- liftAnnex $
-		v <- readish <$> getConfig (annexConfig "delayadd") ""
+		maybe delayaddDefault (return . Just . Seconds)
-		maybe delayaddDefault (return . Just . Seconds) v
+			=<< annexDelayAdd <$> Annex.getConfig
 	runEvery (Seconds 1) <~> do
 		-- We already waited one second as a simple rate limiter.
 		-- Next, wait until at least one change is available for

Assistant/WebApp/Configurators.hs

@@ -28,10 +28,10 @@ import Assistant.XMPP.Client
 import qualified Data.Map as M
 
 {- The main configuration screen. -}
-getConfigR :: Handler RepHtml
+getConfigurationR :: Handler RepHtml
-getConfigR = ifM (inFirstRun)
+getConfigurationR = ifM (inFirstRun)
 	( getFirstRepositoryR
-	, page "Configuration" (Just Config) $ do
+	, page "Configuration" (Just Configuration) $ do
 #ifdef WITH_XMPP
 		xmppconfigured <- lift $ runAnnex False $ isJust <$> getXMPPCreds
 #else
@@ -62,7 +62,7 @@ makeCloudRepositories = $(widgetFile "configurators/repositories/cloud")
 
 {- Lists known repositories, followed by options to add more. -}
 getRepositoriesR :: Handler RepHtml
-getRepositoriesR = page "Repositories" (Just Config) $ do
+getRepositoriesR = page "Repositories" (Just Configuration) $ do
 	let repolist = repoListDisplay $ RepoSelector
 		{ onlyCloud = False
 		, onlyConfigured = False

Assistant/WebApp/Configurators/AWS.hs

@@ -27,7 +27,7 @@ import qualified Data.Text as T
 import qualified Data.Map as M
 
 awsConfigurator :: Widget -> Handler RepHtml
-awsConfigurator = page "Add an Amazon repository" (Just Config)
+awsConfigurator = page "Add an Amazon repository" (Just Configuration)
 
 glacierConfigurator :: Widget -> Handler RepHtml
 glacierConfigurator a = do

Assistant/WebApp/Configurators/Edit.hs

@@ -112,7 +112,7 @@ getEditNewCloudRepositoryR :: UUID -> Handler RepHtml
 getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
 
 editForm :: Bool -> UUID -> Handler RepHtml
-editForm new uuid = page "Configure repository" (Just Config) $ do
+editForm new uuid = page "Configure repository" (Just Configuration) $ do
 	(repo, mremote) <- lift $ runAnnex undefined $ Remote.repoFromUUID uuid
 	curr <- lift $ runAnnex undefined $ getRepoConfig uuid repo mremote
 	lift $ checkarchivedirectory curr

Assistant/WebApp/Configurators/Local.hs

@@ -29,7 +29,6 @@ import Annex.UUID
 import Types.StandardGroups
 import Logs.PreferredContent
 import Utility.UserInfo
-import Config
 
 import qualified Data.Text as T
 import Data.Char
@@ -128,7 +127,7 @@ newRepositoryForm defpath msg = do
 
 {- Making the first repository, when starting the webapp for the first time. -}
 getFirstRepositoryR :: Handler RepHtml
-getFirstRepositoryR = page "Getting started" (Just Config) $ do
+getFirstRepositoryR = page "Getting started" (Just Configuration) $ do
 	path <- liftIO . defaultRepositoryPath =<< lift inFirstRun
 	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm path
 	case res of
@@ -138,7 +137,7 @@ getFirstRepositoryR = page "Getting started" (Just Config) $ do
 
 {- Adding a new, separate repository. -}
 getNewRepositoryR :: Handler RepHtml
-getNewRepositoryR = page "Add another repository" (Just Config) $ do
+getNewRepositoryR = page "Add another repository" (Just Configuration) $ do
 	home <- liftIO myHomeDir
 	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home
 	case res of
@@ -175,7 +174,7 @@ selectDriveForm drives def = renderBootstrap $ RemovableDrive
 
 {- Adding a removable drive. -}
 getAddDriveR :: Handler RepHtml
-getAddDriveR = page "Add a removable drive" (Just Config) $ do
+getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
 	removabledrives <- liftIO $ driveList
 	writabledrives <- liftIO $
 		filterM (canWrite . T.unpack . mountPoint) removabledrives
@@ -213,7 +212,7 @@ getAddDriveR = page "Add a removable drive" (Just Config) $ do
 		addRemote $ makeGitRemote name dir
 
 getEnableDirectoryR :: UUID -> Handler RepHtml
-getEnableDirectoryR uuid = page "Enable a repository" (Just Config) $ do
+getEnableDirectoryR uuid = page "Enable a repository" (Just Configuration) $ do
 	description <- lift $ runAnnex "" $
 		T.pack . concat <$> prettyListUUIDs [uuid]
 	$(widgetFile "configurators/enabledirectory")

Assistant/WebApp/Configurators/Pairing.hs

@@ -286,7 +286,7 @@ sampleQuote = T.unwords
 #endif
 
 pairPage :: Widget -> Handler RepHtml
-pairPage = page "Pairing" (Just Config)
+pairPage = page "Pairing" (Just Configuration)
 
 noPairing :: Text -> Handler RepHtml
 noPairing pairingtype = pairPage $

Assistant/WebApp/Configurators/Ssh.hs

@@ -24,7 +24,7 @@ import qualified Data.Map as M
 import Network.Socket
 
 sshConfigurator :: Widget -> Handler RepHtml
-sshConfigurator = page "Add a remote server" (Just Config)
+sshConfigurator = page "Add a remote server" (Just Configuration)
 
 data SshInput = SshInput
 	{ inputHostname :: Maybe Text
@@ -288,7 +288,7 @@ getAddRsyncNetR = do
 	((result, form), enctype) <- runFormGet $
 		renderBootstrap $ sshInputAForm hostnamefield $
 			SshInput Nothing Nothing Nothing 22
-	let showform status = page "Add a Rsync.net repository" (Just Config) $
+	let showform status = page "Add a Rsync.net repository" (Just Configuration) $
 		$(widgetFile "configurators/addrsync.net")
 	case result of
 		FormSuccess sshinput

Assistant/WebApp/Configurators/WebDAV.hs

@@ -26,10 +26,10 @@ import qualified Data.Text as T
 import qualified Data.Map as M
 
 webDAVConfigurator :: Widget -> Handler RepHtml
-webDAVConfigurator = page "Add a WebDAV repository" (Just Config)
+webDAVConfigurator = page "Add a WebDAV repository" (Just Configuration)
 
 boxConfigurator :: Widget -> Handler RepHtml
-boxConfigurator = page "Add a Box.com repository" (Just Config)
+boxConfigurator = page "Add a Box.com repository" (Just Configuration)
 
 data WebDAVInput = WebDAVInput
 	{ user :: Text

Assistant/WebApp/Configurators/XMPP.hs

@@ -48,7 +48,7 @@ xmppNeeded = return ()
 
 getXMPPR :: Handler RepHtml
 #ifdef WITH_XMPP
-getXMPPR = getXMPPR' ConfigR
+getXMPPR = getXMPPR' ConfigurationR
 #else
 getXMPPR = xmppPage $
 	$(widgetFile "configurators/xmpp/disabled")
@@ -155,4 +155,4 @@ testXMPP creds = either Left (const $ Right creds)
 #endif
 
 xmppPage :: Widget -> Handler RepHtml
-xmppPage = page "Jabber" (Just Config)
+xmppPage = page "Jabber" (Just Configuration)

Assistant/WebApp/DashBoard.hs

@@ -79,7 +79,7 @@ dashboard warnNoScript = do
 
 getHomeR :: Handler RepHtml
 getHomeR = ifM (inFirstRun)
-	( redirect ConfigR
+	( redirect ConfigurationR
 	, page "" (Just DashBoard) $ dashboard True
 	)
 

Assistant/WebApp/Page.hs

@@ -19,24 +19,24 @@ import Yesod
 import Text.Hamlet
 import Data.Text (Text)
 
-data NavBarItem = DashBoard | Config | About
+data NavBarItem = DashBoard | Configuration | About
 	deriving (Eq)
 
 navBarName :: NavBarItem -> Text
 navBarName DashBoard = "Dashboard"
-navBarName Config = "Configuration"
+navBarName Configuration = "Configuration"
 navBarName About = "About"
 
 navBarRoute :: NavBarItem -> Route WebApp
 navBarRoute DashBoard = HomeR
-navBarRoute Config = ConfigR
+navBarRoute Configuration = ConfigurationR
 navBarRoute About = AboutR
 
 defaultNavBar :: [NavBarItem]
-defaultNavBar = [DashBoard, Config, About]
+defaultNavBar = [DashBoard, Configuration, About]
 
 firstRunNavBar :: [NavBarItem]
-firstRunNavBar = [Config, About]
+firstRunNavBar = [Configuration, About]
 
 selectNavBar :: Handler [NavBarItem]
 selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar)

Assistant/WebApp/routes

@@ -5,7 +5,7 @@
 /about/license LicenseR GET
 /about/repogroups RepoGroupR GET
 
-/config ConfigR GET
+/config ConfigurationR GET
 /config/repository RepositoriesR GET
 /config/xmpp XMPPR GET
 /config/xmpp/for/pairing XMPPForPairingR GET

Backend.hs

@@ -18,7 +18,6 @@ module Backend (
 import System.Posix.Files
 
 import Common.Annex
-import Config
 import qualified Annex
 import Annex.CheckAttr
 import Types.Key
@@ -39,17 +38,18 @@ orderedList = do
 	l <- Annex.getState Annex.backends -- list is cached here
 	if not $ null l
 		then return l
-		else handle =<< Annex.getState Annex.forcebackend
+		else do
+			f <- Annex.getState Annex.forcebackend
+			case f of
+				Just name | not (null name) ->
+					return [lookupBackendName name]
+				_ -> do
+					l' <- gen . annexBackends <$> Annex.getConfig
+					Annex.changeState $ \s -> s { Annex.backends = l' }
+					return l'
   where
-	handle Nothing = standard
+	gen [] = list
-	handle (Just "") = standard
+	gen l = map lookupBackendName l
-	handle (Just name) = do
-		l' <- (lookupBackendName name :) <$> standard
-		Annex.changeState $ \s -> s { Annex.backends = l' }
-		return l'
-	standard = parseBackendList <$> getConfig (annexConfig "backends") ""
-	parseBackendList [] = list
-	parseBackendList s = map lookupBackendName $ words s
 
 {- Generates a key for a file, trying each backend in turn until one
  - accepts it. -}

Command/Status.hs

@@ -200,7 +200,7 @@ transfer_list = stat "transfers in progress" $ nojson $ lift $ do
 disk_size :: Stat
 disk_size = stat "available local disk space" $ json id $ lift $
 	calcfree
-		<$> getDiskReserve
+		<$> (annexDiskReserve <$> Annex.getConfig)
 		<*> inRepo (getDiskFree . gitAnnexDir)
   where
 	calcfree reserve (Just have) = unwords

Command/Unused.hs

@@ -22,7 +22,6 @@ import Logs.Unused
 import Annex.Content
 import Utility.FileMode
 import Logs.Location
-import Config
 import qualified Annex
 import qualified Git
 import qualified Git.Command
@@ -181,11 +180,9 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
  - so will easily fit on even my lowest memory systems.
  -}
 bloomCapacity :: Annex Int
-bloomCapacity = fromMaybe 500000 . readish
+bloomCapacity = fromMaybe 500000 . annexBloomCapacity <$> Annex.getConfig
-	<$> getConfig (annexConfig "bloomcapacity") ""
 bloomAccuracy :: Annex Int
-bloomAccuracy = fromMaybe 1000 . readish
+bloomAccuracy = fromMaybe 1000 . annexBloomAccuracy <$> Annex.getConfig
-	<$> getConfig (annexConfig "bloomaccuracy") ""
 bloomBitsHashes :: Annex (Int, Int)
 bloomBitsHashes = do
 	capacity <- bloomCapacity

Config.hs

@@ -12,7 +12,6 @@ import qualified Git
 import qualified Git.Config
 import qualified Git.Command
 import qualified Annex
-import Utility.DataUnits
 
 type UnqualifiedConfigKey = String
 data ConfigKey = ConfigKey String
@@ -21,8 +20,7 @@ data ConfigKey = ConfigKey String
 setConfig :: ConfigKey -> String -> Annex ()
 setConfig (ConfigKey key) value = do
 	inRepo $ Git.Command.run "config" [Param key, Param value]
-	newg <- inRepo Git.Config.reRead
+	Annex.changeGitRepo =<< inRepo Git.Config.reRead
-	Annex.changeState $ \s -> s { Annex.repo = newg }
 
 {- Unsets a git config setting. (Leaves it in state currently.) -}
 unsetConfig :: ConfigKey -> Annex ()
@@ -93,49 +91,28 @@ repoSyncable :: Git.Repo -> Annex Bool
 repoSyncable r = fromMaybe True . Git.Config.isTrue
 	<$> getRemoteConfig r "sync" ""
 
-{- 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 = perhaps (use v) =<< Annex.getState Annex.forcenumcopies
-  where
-	use (Just n) = return n
-	use Nothing = perhaps (return 1) =<< 
-		readish <$> getConfig (annexConfig "numcopies") "1"
-	perhaps fallback = maybe fallback (return . id)
-
 {- Gets the trust level set for a remote in git config. -}
 getTrustLevel :: Git.Repo -> Annex (Maybe String)
 getTrustLevel r = fromRepo $ Git.Config.getMaybe key
   where
 	(ConfigKey key) = remoteConfig r "trustlevel"
 
-{- Gets annex.diskreserve setting. -}
+getNumCopies :: Maybe Int -> Annex Int
-getDiskReserve :: Annex Integer
+getNumCopies (Just v) = return v
-getDiskReserve = fromMaybe megabyte . readSize dataUnits
+getNumCopies Nothing = annexNumCopies <$> Annex.getConfig
-	<$> getConfig (annexConfig "diskreserve") ""
-  where
-	megabyte = 1000000
 
-{- Gets annex.direct setting, cached for speed. -}
 isDirect :: Annex Bool
-isDirect = maybe fromconfig return =<< Annex.getState Annex.direct
+isDirect = annexDirect <$> Annex.getConfig
-  where
-	fromconfig = do
-		direct <- fromMaybe False . Git.Config.isTrue <$>
-			getConfig (annexConfig "direct") ""
-		Annex.changeState $ \s -> s { Annex.direct = Just direct }
-		return direct
 
 setDirect :: Bool -> Annex ()
 setDirect b = do
-	setConfig (annexConfig "direct") (if b then "true" else "false")
+	setConfig (annexConfig "direct") $ if b then "true" else "false"
-	Annex.changeState $ \s -> s { Annex.direct = Just b }
+	Annex.changeConfig $ \c -> c { annexDirect = b }
 
-{- Gets annex.httpheaders or annex.httpheaders-command setting,
+{- Gets the http headers to use. -}
- - splitting it into lines. -}
 getHttpHeaders :: Annex [String]
 getHttpHeaders = do
-	cmd <- getConfig (annexConfig "http-headers-command") ""
+	v <- annexHttpHeadersCommand <$> Annex.getConfig
-	if null cmd
+	case v of
-		then fromRepo $ Git.Config.getList "annex.http-headers"
+		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
-		else lines <$> liftIO (readProcess "sh" ["-c", cmd])
+		Nothing -> annexHttpHeaders <$> Annex.getConfig

GitAnnex.hs

@@ -170,12 +170,10 @@ options = Option.common ++
 	, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier")) "Trust Amazon Glacier inventory"
 	] ++ Option.matcher
   where
-	setnumcopies v = Annex.changeState $
+	setnumcopies v = maybe noop
-		\s -> s { Annex.forcenumcopies = readish v }
+		(\n -> Annex.changeConfig $ \c -> c { annexNumCopies = n })
-	setgitconfig :: String -> Annex ()
+		(readish v)
-	setgitconfig v = do
+	setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v)
-		newg <- inRepo $ Git.Config.store v
-		Annex.changeState $ \s -> s { Annex.repo = newg }
 
 header :: String
 header = "Usage: git-annex command [option ..]"

Types.hs

@@ -10,6 +10,7 @@ module Types (
 	Backend,
 	Key,
 	UUID(..),
+	Config(..),
 	Remote,
 	RemoteType,
 	Option,
@@ -18,6 +19,7 @@ module Types (
 
 import Annex
 import Types.Backend
+import Types.Config
 import Types.Key
 import Types.UUID
 import Types.Remote

Types/Config.hs

@@ -0,0 +1,64 @@
+{- git-annex configuration
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Config ( 
+	Config(..),
+	extractConfig,
+) where
+
+import Common
+import qualified Git
+import qualified Git.Config
+import Utility.DataUnits
+
+{- Main git-annex settings. Each setting corresponds to a git-config key
+ - such as annex.foo -}
+data Config = Config
+	{ annexNumCopies :: Int
+	, annexDiskReserve :: Integer
+	, annexDirect :: Bool
+	, annexBackends :: [String]
+	, annexQueueSize :: Maybe Int
+	, annexBloomCapacity :: Maybe Int
+	, annexBloomAccuracy :: Maybe Int
+	, annexSshCaching :: Maybe Bool
+	, annexAlwaysCommit :: Bool
+	, annexDelayAdd :: Maybe Int
+	, annexHttpHeaders :: [String]
+	, annexHttpHeadersCommand :: Maybe String
+	}
+
+extractConfig :: Git.Repo -> Config
+extractConfig r = Config
+	{ annexNumCopies = get "numcopies" 1
+	, annexDiskReserve = fromMaybe onemegabyte $
+		readSize dataUnits =<< getmaybe "diskreserve"
+	, annexDirect = getbool "direct" False
+	, annexBackends = fromMaybe [] $
+		words <$> getmaybe "backends"
+	, annexQueueSize = getmayberead "queuesize"
+	, annexBloomCapacity = getmayberead "bloomcapacity"
+	, annexBloomAccuracy = getmayberead "bloomaccuracy"
+	, annexSshCaching = getmaybebool "sshcaching"
+	, annexAlwaysCommit = getbool "alwayscommit" True
+	, annexDelayAdd = getmayberead "delayadd"
+	, annexHttpHeaders = getlist "http-headers"
+	, annexHttpHeadersCommand = getmaybe "http-headers-command"
+	}
+  where
+	get k def = fromMaybe def $ getmayberead k
+	getbool k def = fromMaybe def $ getmaybebool k
+	getmaybebool k = Git.Config.isTrue =<< getmaybe k
+	getmayberead k = readish =<< getmaybe k
+	getmaybe k = Git.Config.getMaybe (key k) r
+	getlist k = Git.Config.getList (key k) r
+	key k = "annex." ++ k
+			
+	onemegabyte = 1000000
+
+{- Per-remote git-annex settings. Each setting corresponds to a git-config
+ - key such as annex.<remote>.foo -}