summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-01-25 21:49:04 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-01-25 21:49:04 -0400
commit082b022f9ae56b1446b6607cf7851cd4f1d4f904 (patch)
tree4712d36e841bca351c9aa68a911c4fb82188b4c1
parent109a719b03dbeb70eb317be17f7e18567efa9dac (diff)
successfully split Annex and AnnexState out of TypeInternals
-rw-r--r--Annex.hs91
-rw-r--r--Backend.hs10
-rw-r--r--Backend/File.hs1
-rw-r--r--Backend/SHA1.hs1
-rw-r--r--Backend/URL.hs1
-rw-r--r--Backend/WORM.hs1
-rw-r--r--CmdLine.hs4
-rw-r--r--Options.hs8
-rw-r--r--Remotes.hs2
-rw-r--r--TypeInternals.hs21
-rw-r--r--Types.hs6
-rw-r--r--test.hs3
12 files changed, 72 insertions, 77 deletions
diff --git a/Annex.hs b/Annex.hs
index a0de63087..a67ea4863 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -6,18 +6,20 @@
-}
module Annex (
+ Annex,
+ AnnexState(..),
+ getState,
new,
run,
eval,
gitRepo,
gitRepoChange,
- backends,
backendsChange,
- supportedBackends,
+ FlagName,
+ Flag(..),
flagIsSet,
flagChange,
flagGet,
- Flag(..),
queue,
queueGet,
queueRun,
@@ -29,19 +31,38 @@ import qualified Data.Map as M
import qualified GitRepo as Git
import qualified GitQueue
-import Types
-import qualified TypeInternals as Internals
+import qualified TypeInternals
+
+-- git-annex's monad
+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)
{- Create and returns an Annex state object for the specified git repo. -}
-new :: Git.Repo -> [Backend Annex] -> IO AnnexState
+new :: Git.Repo -> [TypeInternals.Backend Annex] -> IO AnnexState
new gitrepo allbackends = do
- let s = Internals.AnnexState {
- Internals.repo = gitrepo,
- Internals.backends = [],
- Internals.supportedBackends = allbackends,
- Internals.flags = M.empty,
- Internals.repoqueue = GitQueue.empty,
- Internals.quiet = False
+ let s = AnnexState {
+ repo = gitrepo,
+ backends = [],
+ supportedBackends = allbackends,
+ flags = M.empty,
+ repoqueue = GitQueue.empty,
+ quiet = False
}
(_,s') <- Annex.run s prep
return s'
@@ -57,41 +78,33 @@ 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 -}
+getState :: (AnnexState -> a) -> Annex a
+getState a = do
+ state <- get
+ return (a state)
+
{- Returns the git repository being acted on -}
gitRepo :: Annex Git.Repo
-gitRepo = do
- state <- get
- return (Internals.repo state)
+gitRepo = getState repo
{- Changes the git repository being acted on. -}
gitRepoChange :: Git.Repo -> Annex ()
gitRepoChange r = do
state <- get
- put state { Internals.repo = r }
-
-{- Returns the backends being used. -}
-backends :: Annex [Backend Annex]
-backends = do
- state <- get
- return (Internals.backends state)
+ put state { repo = r }
{- Sets the backends to use. -}
-backendsChange :: [Backend Annex] -> Annex ()
+backendsChange :: [TypeInternals.Backend Annex] -> Annex ()
backendsChange b = do
state <- get
- put state { Internals.backends = b }
-
-{- Returns the full list of supported backends. -}
-supportedBackends :: Annex [Backend Annex]
-supportedBackends = do
- state <- get
- return (Internals.supportedBackends state)
+ 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 $ Internals.flags state) of
+ case (M.lookup name $ flags state) of
Just (FlagBool True) -> return True
_ -> return False
@@ -99,13 +112,13 @@ flagIsSet name = do
flagChange :: FlagName -> Flag -> Annex ()
flagChange name val = do
state <- get
- put state { Internals.flags = M.insert name val $ Internals.flags state }
+ 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 $ Internals.flags state) of
+ case (M.lookup name $ flags state) of
Just (FlagString s) -> return s
_ -> return ""
@@ -113,23 +126,23 @@ flagGet name = do
queue :: String -> [String] -> FilePath -> Annex ()
queue command params file = do
state <- get
- let q = Internals.repoqueue state
- put state { Internals.repoqueue = GitQueue.add q command params file }
+ 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 (Internals.repoqueue state)
+ return (repoqueue state)
{- Runs (and empties) the queue. -}
queueRun :: Annex ()
queueRun = do
state <- get
- let q = Internals.repoqueue state
+ let q = repoqueue state
g <- gitRepo
liftIO $ GitQueue.run g q
- put state { Internals.repoqueue = GitQueue.empty }
+ put state { repoqueue = GitQueue.empty }
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: String -> String -> Annex ()
diff --git a/Backend.hs b/Backend.hs
index caf50005a..551c041a8 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -44,11 +44,11 @@ import Messages
{- List of backends in the order to try them when storing a new key. -}
list :: Annex [Backend Annex]
list = do
- l <- Annex.backends -- list is cached here
+ l <- Annex.getState Annex.backends -- list is cached here
if not $ null l
then return l
else do
- bs <- Annex.supportedBackends
+ bs <- Annex.getState Annex.supportedBackends
g <- Annex.gitRepo
let defaults = parseBackendList bs $ Git.configGet g "annex.backends" ""
backendflag <- Annex.flagGet "backend"
@@ -121,7 +121,7 @@ fsckKey backend key numcopies = (Internals.fsckKey backend) key numcopies
- by examining what the file symlinks to. -}
lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex))
lookupFile file = do
- bs <- Annex.supportedBackends
+ bs <- Annex.getState Annex.supportedBackends
tl <- liftIO $ try getsymlink
case tl of
Left _ -> return Nothing
@@ -150,12 +150,12 @@ lookupFile file = do
chooseBackends :: [FilePath] -> Annex [(FilePath, Maybe (Backend Annex))]
chooseBackends fs = do
g <- Annex.gitRepo
- bs <- Annex.supportedBackends
+ bs <- Annex.getState Annex.supportedBackends
pairs <- liftIO $ Git.checkAttr g "annex.backend" fs
return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs
{- Returns the backend to use for a key. -}
keyBackend :: Key -> Annex (Backend Annex)
keyBackend key = do
- bs <- Annex.supportedBackends
+ bs <- Annex.getState Annex.supportedBackends
return $ lookupBackendName bs $ backendName key
diff --git a/Backend/File.hs b/Backend/File.hs
index c8ddd5938..962d09909 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -24,6 +24,7 @@ import qualified Remotes
import qualified GitRepo as Git
import Content
import qualified Annex
+import Types
import UUID
import Messages
diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs
index e665e5da7..be41264b0 100644
--- a/Backend/SHA1.hs
+++ b/Backend/SHA1.hs
@@ -19,6 +19,7 @@ import Messages
import qualified Annex
import Locations
import Content
+import Types
backend :: Backend Annex
backend = Backend.File.backend {
diff --git a/Backend/URL.hs b/Backend/URL.hs
index 8ed354aed..d67b7db84 100644
--- a/Backend/URL.hs
+++ b/Backend/URL.hs
@@ -10,6 +10,7 @@ module Backend.URL (backend) where
import Control.Monad.State (liftIO)
import Data.String.Utils
+import Types
import TypeInternals
import Utility
import Messages
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index cd4254e2b..011018393 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -20,6 +20,7 @@ import Locations
import qualified Annex
import Content
import Messages
+import Types
backend :: Backend Annex
backend = Backend.File.backend {
diff --git a/CmdLine.hs b/CmdLine.hs
index 6772282c5..39dd61e99 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -78,9 +78,9 @@ usage header cmds options =
- (but explicitly thrown errors terminate the whole command).
- Runs shutdown and propigates an overall error status at the end.
-}
-tryRun :: AnnexState -> [Annex Bool] -> IO ()
+tryRun :: Annex.AnnexState -> [Annex Bool] -> IO ()
tryRun state actions = tryRun' state 0 actions
-tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO ()
+tryRun' :: Annex.AnnexState -> Integer -> [Annex Bool] -> IO ()
tryRun' state errnum (a:as) = do
result <- try $ Annex.run state a
case result of
diff --git a/Options.hs b/Options.hs
index 5f367c9dd..2d4bb85fb 100644
--- a/Options.hs
+++ b/Options.hs
@@ -18,10 +18,10 @@ import Command
-}
type Option = OptDescr (Annex ())
-storeOptBool :: FlagName -> Bool -> Annex ()
-storeOptBool name val = Annex.flagChange name $ FlagBool val
-storeOptString :: FlagName -> String -> Annex ()
-storeOptString name val = Annex.flagChange name $ FlagString val
+storeOptBool :: Annex.FlagName -> Bool -> Annex ()
+storeOptBool name val = Annex.flagChange name $ Annex.FlagBool val
+storeOptString :: Annex.FlagName -> String -> Annex ()
+storeOptString name val = Annex.flagChange name $ Annex.FlagString val
commonOptions :: [Option]
commonOptions =
diff --git a/Remotes.hs b/Remotes.hs
index 9004b33d0..e5aa80e1c 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -105,7 +105,7 @@ readConfigs = do
let todo = cheap ++ doexpensive
unless (null todo) $ do
_ <- mapM tryGitConfigRead todo
- Annex.flagChange "remotesread" $ FlagBool True
+ Annex.flagChange "remotesread" $ Annex.FlagBool True
where
cachedUUID r = do
u <- getUUID r
diff --git a/TypeInternals.hs b/TypeInternals.hs
index 99f304973..abafe8711 100644
--- a/TypeInternals.hs
+++ b/TypeInternals.hs
@@ -17,27 +17,6 @@ import Test.QuickCheck
import qualified GitRepo as Git
import qualified GitQueue
--- command-line flags
-type FlagName = String
-data Flag =
- FlagBool Bool |
- FlagString String
- deriving (Eq, Read, Show)
-
--- git-annex's runtime state type doesn't really belong here,
--- but it uses Backend, so has to be here to avoid a depends loop.
-data AnnexState = AnnexState {
- repo :: Git.Repo,
- backends :: [Backend Annex],
- supportedBackends :: [Backend Annex],
- flags :: M.Map FlagName Flag,
- repoqueue :: GitQueue.Queue,
- quiet :: Bool
-} deriving (Show)
-
--- git-annex's monad
-type Annex = StateT AnnexState IO
-
-- annexed filenames are mapped through a backend into keys
type KeyName = String
type BackendName = String
diff --git a/Types.hs b/Types.hs
index b94a4170a..8c19bbbb3 100644
--- a/Types.hs
+++ b/Types.hs
@@ -7,14 +7,12 @@
module Types (
Annex,
- AnnexState,
Backend,
Key,
genKey,
backendName,
- keyName,
- FlagName,
- Flag(..)
+ keyName
) where
import TypeInternals
+import Annex
diff --git a/test.hs b/test.hs
index b8b264f0c..2528e6398 100644
--- a/test.hs
+++ b/test.hs
@@ -28,6 +28,7 @@ import qualified GitRepo as Git
import qualified Locations
import qualified Utility
import qualified TypeInternals
+import qualified Types
import qualified GitAnnex
import qualified LocationLog
import qualified UUID
@@ -416,7 +417,7 @@ git_annex command params = do
-- Runs an action in the current annex. Note that shutdown actions
-- are not run; this should only be used for actions that query state.
-annexeval :: TypeInternals.Annex a -> IO a
+annexeval :: Types.Annex a -> IO a
annexeval a = do
g <- Git.repoFromCwd
g' <- Git.configRead g