diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-26 15:59:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-26 15:59:50 -0400 |
commit | ef26076a5a3df9b8740883e3f7b3b68585b47ad5 (patch) | |
tree | 4866077b46f25ba1446ddebf7d5b151fc98fd8ac /Annex.hs | |
parent | 4cda7b6e7c2f08c99b0c4c14bb86e691903a985b (diff) |
add git queue to Annex monad
not used anywhere just yet..
Diffstat (limited to 'Annex.hs')
-rw-r--r-- | Annex.hs | 42 |
1 files changed, 36 insertions, 6 deletions
@@ -11,25 +11,28 @@ module Annex ( flagIsSet, flagChange, flagGet, - Flag(..) + Flag(..), + queue, + queueGet ) where import Control.Monad.State import qualified Data.Map as M import qualified GitRepo as Git +import qualified GitQueue import Types import qualified TypeInternals as Internals -{- Create and returns an Annex state object for the specified git repo. - -} +{- Create and returns an Annex state object for the specified git repo. -} new :: Git.Repo -> [Backend] -> IO AnnexState new gitrepo allbackends = do let s = Internals.AnnexState { Internals.repo = gitrepo, Internals.backends = [], Internals.supportedBackends = allbackends, - Internals.flags = M.empty + Internals.flags = M.empty, + Internals.repoqueue = GitQueue.empty } (_,s') <- Annex.run s (prep gitrepo) return s' @@ -39,46 +42,73 @@ new gitrepo allbackends = do gitrepo' <- liftIO $ Git.configRead gitrepo Annex.gitRepoChange gitrepo' --- performs an action in the Annex monad +{- performs an action in the Annex monad -} run state action = runStateT (action) state --- Annex monad state accessors +{- Returns the git repository being acted on -} gitRepo :: Annex Git.Repo gitRepo = do state <- get return (Internals.repo state) + +{- Changes the git repository being acted on. -} gitRepoChange :: Git.Repo -> Annex () gitRepoChange r = do state <- get put state { Internals.repo = r } return () + +{- Returns the backends being used. -} backends :: Annex [Backend] backends = do state <- get return (Internals.backends state) + +{- Sets the backends to use. -} backendsChange :: [Backend] -> Annex () backendsChange b = do state <- get put state { Internals.backends = b } return () + +{- Returns the full list of supported backends. -} supportedBackends :: Annex [Backend] supportedBackends = do state <- get return (Internals.supportedBackends state) + +{- Return True if a Bool flag is set. -} flagIsSet :: FlagName -> Annex Bool flagIsSet name = do state <- get case (M.lookup name $ Internals.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 { Internals.flags = M.insert name val $ Internals.flags state } return () + +{- 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 $ Internals.flags state) of Just (FlagString s) -> return s _ -> return "" + +{- Adds a git command to the queue. -} +queue :: String -> [String] -> FilePath -> Annex () +queue subcommand params file = do + state <- get + let q = Internals.repoqueue state + put state { Internals.repoqueue = GitQueue.add q subcommand params file } + +{- Returns the queue. -} +queueGet :: Annex GitQueue.Queue +queueGet = do + state <- get + return (Internals.repoqueue state) |