diff options
author | Joey Hess <joey@kitenet.net> | 2011-01-26 00:17:38 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-01-26 00:17:38 -0400 |
commit | 6a97b10fcb3e1fa6a230d92a25b42ded587ff743 (patch) | |
tree | b8a6ce70916c397c67788b47de6a389db8753969 /Annex.hs | |
parent | 082b022f9ae56b1446b6607cf7851cd4f1d4f904 (diff) |
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.
Diffstat (limited to 'Annex.hs')
-rw-r--r-- | Annex.hs | 136 |
1 files changed, 50 insertions, 86 deletions
@@ -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' } |