rework config storage

Moved away from a map of flags to storing config directly in the AnnexState
structure. Got rid of most accessor functions in Annex.

This allowed supporting multiple --exclude flags.

1 files changed, 50 insertions, 86 deletions

diff --git a/Annex.hs b/Annex.hs
index a67ea4863..d47d44967 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -8,26 +8,18 @@
 module Annex (
 	Annex,
 	AnnexState(..),
-	getState,
 	new,
 	run,
 	eval,
+	getState,
+	changeState,
 	gitRepo,
-	gitRepoChange,
-	backendsChange,
-	FlagName,
-	Flag(..),	
-	flagIsSet,
-	flagChange,
-	flagGet,
 	queue,
-	queueGet,
 	queueRun,
 	setConfig
 ) where
 
 import Control.Monad.State
-import qualified Data.Map as M
 
 import qualified GitRepo as Git
 import qualified GitQueue
@@ -37,40 +29,42 @@ import qualified TypeInternals
 type Annex = StateT AnnexState IO
 
 -- internal state storage
-data AnnexState = AnnexState {
-	repo :: Git.Repo,
-	backends :: [TypeInternals.Backend Annex],
-	supportedBackends :: [TypeInternals.Backend Annex],
-	flags :: M.Map FlagName Flag,
-	repoqueue :: GitQueue.Queue,
-	quiet :: Bool
-} deriving (Show)
-
--- command-line flags
-type FlagName = String
-data Flag =
-	FlagBool Bool |
-	FlagString String
-		deriving (Eq, Read, Show)
+data AnnexState = AnnexState
+	{ repo :: Git.Repo
+	, backends :: [TypeInternals.Backend Annex]
+	, supportedBackends :: [TypeInternals.Backend Annex]
+	, repoqueue :: GitQueue.Queue
+	, quiet :: Bool
+	, force :: Bool
+	, defaultbackend :: Maybe String
+	, defaultkey :: Maybe String
+	, toremote :: Maybe String
+	, fromremote :: Maybe String
+	, exclude :: [String]
+	, remotesread :: Bool
+	} deriving (Show)
+
+newState :: Git.Repo -> [TypeInternals.Backend Annex] -> AnnexState
+newState gitrepo allbackends = AnnexState
+	{ repo = gitrepo
+	, backends = []
+	, supportedBackends = allbackends
+	, repoqueue = GitQueue.empty
+	, quiet = False
+	, force = False
+	, defaultbackend = Nothing
+	, defaultkey = Nothing
+	, toremote = Nothing
+	, fromremote = Nothing
+	, exclude = []
+	, remotesread = False
+	}
 
 {- Create and returns an Annex state object for the specified git repo. -}
 new :: Git.Repo -> [TypeInternals.Backend Annex] -> IO AnnexState
 new gitrepo allbackends = do
-	let s = AnnexState {
-		repo = gitrepo,
-		backends = [],
-		supportedBackends = allbackends,
-		flags = M.empty,
-		repoqueue = GitQueue.empty,
-		quiet = False
-	}
-	(_,s') <- Annex.run s prep
-	return s'
-	where
-		prep = do
-			-- read git config and update state
-			gitrepo' <- liftIO $ Git.configRead gitrepo
-			Annex.gitRepoChange gitrepo'
+	gitrepo' <- liftIO $ Git.configRead gitrepo
+	return $ newState gitrepo' allbackends
 
 {- performs an action in the Annex monad -}
 run :: AnnexState -> Annex a -> IO (a, AnnexState)
@@ -78,50 +72,26 @@ run state action = runStateT action state
 eval :: AnnexState -> Annex a -> IO a
 eval state action = evalStateT action state
 
-{- gets a value from the internal Annex state -}
+{- Gets a value from the internal state, selected by the passed value
+ - constructor. -}
 getState :: (AnnexState -> a) -> Annex a
-getState a = do
+getState c = do
 	state <- get
-	return (a state)
+	return (c state)
+
+{- Applies a state mutation function to change the internal state. 
+ -
+ - Example: changeState (\s -> s { quiet = True })
+ -}
+changeState :: (AnnexState -> AnnexState) -> Annex ()
+changeState a = do
+	state <- get
+	put (a state)
 
 {- Returns the git repository being acted on -}
 gitRepo :: Annex Git.Repo
 gitRepo = getState repo
 
-{- Changes the git repository being acted on. -}
-gitRepoChange :: Git.Repo -> Annex ()
-gitRepoChange r = do
-	state <- get
-	put state { repo = r }
-
-{- Sets the backends to use. -}
-backendsChange :: [TypeInternals.Backend Annex] -> Annex ()
-backendsChange b = do
-	state <- get
-	put state { backends = b }
-
-{- Return True if a Bool flag is set. -}
-flagIsSet :: FlagName -> Annex Bool
-flagIsSet name = do
-	state <- get
-	case (M.lookup name $ flags state) of
-		Just (FlagBool True) -> return True
-		_ -> return False 
-
-{- Sets the value of a flag. -}
-flagChange :: FlagName -> Flag -> Annex ()
-flagChange name val = do
-	state <- get
-	put state { flags = M.insert name val $ flags state }
-
-{- Gets the value of a String flag (or "" if there is no such String flag) -}
-flagGet :: FlagName -> Annex String
-flagGet name = do
-	state <- get
-	case (M.lookup name $ flags state) of
-		Just (FlagString s) -> return s
-		_ -> return ""
-
 {- Adds a git command to the queue. -}
 queue :: String -> [String] -> FilePath -> Annex ()
 queue command params file = do
@@ -129,12 +99,6 @@ queue command params file = do
 	let q = repoqueue state
 	put state { repoqueue = GitQueue.add q command params file }
 
-{- Returns the queue. -}
-queueGet :: Annex GitQueue.Queue
-queueGet = do
-	state <- get
-	return (repoqueue state)
-
 {- Runs (and empties) the queue. -}
 queueRun :: Annex ()
 queueRun = do
@@ -146,9 +110,9 @@ queueRun = do
 
 {- Changes a git config setting in both internal state and .git/config -}
 setConfig :: String -> String -> Annex ()
-setConfig key value = do
+setConfig k value = do
 	g <- Annex.gitRepo
-	liftIO $ Git.run g ["config", key, value]
+	liftIO $ Git.run g ["config", k, value]
 	-- re-read git config and update the repo's state
 	g' <- liftIO $ Git.configRead g
-	Annex.gitRepoChange g'
+	Annex.changeState $ \s -> s { Annex.repo = g' }