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.

12 files changed, 127 insertions, 78 deletions

diff --git a/Annex.hs b/Annex.hs
index d314d3ec7..bb3548b00 100644
--- a/Annex.hs
+++ b/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
+	}
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 54e019345..1f7516fe1 100644
--- a/Annex/Content.hs
+++ b/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
diff --git a/Annex/Queue.hs b/Annex/Queue.hs
index 64cc92897..0f8c38ab9 100644
--- a/Annex/Queue.hs
+++ b/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 }
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index cb46c06bc..d3622686c 100644
--- a/Annex/Ssh.hs
+++ b/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
-		<$> getConfig (annexConfig "sshcaching") ""
+		. annexSshCaching <$> Annex.getConfig
 #endif
 
 cacheParams :: FilePath -> [CommandParam]
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index e968959c6..7940b0836 100644
--- a/Assistant/Threads/Committer.hs
+++ b/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
-		v <- readish <$> getConfig (annexConfig "delayadd") ""
-		maybe delayaddDefault (return . Just . Seconds) v
+	delayadd <- liftAnnex $
+		maybe delayaddDefault (return . Just . Seconds)
+			=<< 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
diff --git a/Backend.hs b/Backend.hs
index 1e3d8f94f..4972288c3 100644
--- a/Backend.hs
+++ b/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
-	handle (Just "") = standard
-	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
+	gen [] = list
+	gen l = map lookupBackendName l
 
 {- Generates a key for a file, trying each backend in turn until one
  - accepts it. -}
diff --git a/Command/Status.hs b/Command/Status.hs
index d2307798f..9c5e3e70a 100644
--- a/Command/Status.hs
+++ b/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
diff --git a/Command/Unused.hs b/Command/Unused.hs
index c0551ddea..2823ccefd 100644
--- a/Command/Unused.hs
+++ b/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
-	<$> getConfig (annexConfig "bloomcapacity") ""
+bloomCapacity = fromMaybe 500000 . annexBloomCapacity <$> Annex.getConfig
 bloomAccuracy :: Annex Int
-bloomAccuracy = fromMaybe 1000 . readish
-	<$> getConfig (annexConfig "bloomaccuracy") ""
+bloomAccuracy = fromMaybe 1000 . annexBloomAccuracy <$> Annex.getConfig
 bloomBitsHashes :: Annex (Int, Int)
 bloomBitsHashes = do
 	capacity <- bloomCapacity
diff --git a/Config.hs b/Config.hs
index 02cbb5e51..afda3e7cb 100644
--- a/Config.hs
+++ b/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.changeState $ \s -> s { Annex.repo = newg }
+	Annex.changeGitRepo =<< inRepo Git.Config.reRead
 
 {- 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. -}
-getDiskReserve :: Annex Integer
-getDiskReserve = fromMaybe megabyte . readSize dataUnits
-	<$> getConfig (annexConfig "diskreserve") ""
-  where
-	megabyte = 1000000
+getNumCopies :: Maybe Int -> Annex Int
+getNumCopies (Just v) = return v
+getNumCopies Nothing = annexNumCopies <$> Annex.getConfig
 
-{- Gets annex.direct setting, cached for speed. -}
 isDirect :: Annex Bool
-isDirect = maybe fromconfig return =<< Annex.getState Annex.direct
-  where
-	fromconfig = do
-		direct <- fromMaybe False . Git.Config.isTrue <$>
-			getConfig (annexConfig "direct") ""
-		Annex.changeState $ \s -> s { Annex.direct = Just direct }
-		return direct
+isDirect = annexDirect <$> Annex.getConfig
 
 setDirect :: Bool -> Annex ()
 setDirect b = do
-	setConfig (annexConfig "direct") (if b then "true" else "false")
-	Annex.changeState $ \s -> s { Annex.direct = Just b }
+	setConfig (annexConfig "direct") $ if b then "true" else "false"
+	Annex.changeConfig $ \c -> c { annexDirect = b }
 
-{- Gets annex.httpheaders or annex.httpheaders-command setting,
- - splitting it into lines. -}
+{- Gets the http headers to use. -}
 getHttpHeaders :: Annex [String]
 getHttpHeaders = do
-	cmd <- getConfig (annexConfig "http-headers-command") ""
-	if null cmd
-		then fromRepo $ Git.Config.getList "annex.http-headers"
-		else lines <$> liftIO (readProcess "sh" ["-c", cmd])
+	v <- annexHttpHeadersCommand <$> Annex.getConfig
+	case v of
+		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
+		Nothing -> annexHttpHeaders <$> Annex.getConfig
diff --git a/GitAnnex.hs b/GitAnnex.hs
index 270f5cce8..c807326ad 100644
--- a/GitAnnex.hs
+++ b/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 $
-		\s -> s { Annex.forcenumcopies = readish v }
-	setgitconfig :: String -> Annex ()
-	setgitconfig v = do
-		newg <- inRepo $ Git.Config.store v
-		Annex.changeState $ \s -> s { Annex.repo = newg }
+	setnumcopies v = maybe noop
+		(\n -> Annex.changeConfig $ \c -> c { annexNumCopies = n })
+		(readish v)
+	setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v)
 
 header :: String
 header = "Usage: git-annex command [option ..]"
diff --git a/Types.hs b/Types.hs
index eb77826cb..16f901b26 100644
--- a/Types.hs
+++ b/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
diff --git a/Types/Config.hs b/Types/Config.hs
new file mode 100644
index 000000000..898c153d5
--- /dev/null
+++ b/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 -}