moved config reading into GitRepo

This commit is contained in:
Joey Hess 2010-10-11 23:22:38 -04:00
parent f6306bc301
commit cd1e39b127
2 changed files with 76 additions and 65 deletions

View file

@ -20,49 +20,41 @@ import LocationLog
-- git-annex's runtime state
data State = State {
repo :: GitRepo,
config :: Config
}
data Config = Config {
annex_name :: String,
annex_numcopies :: Int,
annex_backends :: [Backend]
backends :: [Backend]
}
{- An annexed file's content is stored somewhere under .git/annex/ -}
annexDir :: GitRepo -> Key -> IO FilePath
annexDir repo key = do
dir <- gitDir repo
return $ dir ++ "/annex/" ++ key
annexDir :: GitRepo -> Key -> FilePath
annexDir repo key = gitDir repo ++ "/annex/" ++ key
{- On startup, examine the git repo, prepare it, and record state for
- later. -}
startAnnex :: IO State
startAnnex = do
r <- gitRepoCurrent
config <- queryConfig r
gitPrep r
return State {
repo = r,
config = config
backends = parseBackendList $ gitConfig r "annex.backends" ""
}
{- Annexes a file, storing it in a backend, and then moving it into
- the annex directory and setting up the symlink pointing to its content. -}
annexFile :: State -> FilePath -> IO ()
annexFile state file = do
alreadyannexed <- lookupBackend backends (repo state) file
alreadyannexed <- lookupBackend (backends state) (repo state) file
case (alreadyannexed) of
Just _ -> error $ "already annexed: " ++ file
Nothing -> do
checkLegal file
stored <- storeFile backends (repo state) file
stored <- storeFile (backends state) (repo state) file
case (stored) of
Nothing -> error $ "no backend could store: " ++ file
Just key -> symlink key
where
symlink key = do
dest <- annexDir (repo state) key
let dest = annexDir (repo state) key
createDirectoryIfMissing True (parentDir dest)
renameFile file dest
createSymbolicLink dest file
@ -72,40 +64,22 @@ annexFile state file = do
if ((isSymbolicLink s) || (not $ isRegularFile s))
then error $ "not a regular file: " ++ file
else return ()
backends = getConfig state annex_backends
{- Inverse of annexFile. -}
unannexFile :: State -> FilePath -> IO ()
unannexFile state file = do
alreadyannexed <- lookupBackend backends (repo state) file
alreadyannexed <- lookupBackend (backends state) (repo state) file
case (alreadyannexed) of
Nothing -> error $ "not annexed " ++ file
Just _ -> do
mkey <- dropFile backends (repo state) file
mkey <- dropFile (backends state) (repo state) file
case (mkey) of
Nothing -> return ()
Just key -> do
src <- annexDir (repo state) key
let src = annexDir (repo state) key
removeFile file
renameFile src file
return ()
where
backends = getConfig state annex_backends
{- Query the git repo for relevant configuration settings. -}
queryConfig :: GitRepo -> IO Config
queryConfig repo = do
-- a name can be configured, if none is, use the repository path
name <- gitConfigGet "annex.name" (gitRepoTop repo)
-- default number of copies to keep of file contents is 1
numcopies <- gitConfigGet "annex.numcopies" "1"
backends <- gitConfigGet "annex.backends" ""
return Config {
annex_name = name,
annex_numcopies = read numcopies,
annex_backends = parseBackendList backends
}
{- Sets up a git repo for git-annex. May be called repeatedly. -}
gitPrep :: GitRepo -> IO ()
@ -125,7 +99,3 @@ gitPrep repo = do
appendFile attributes $ attrLine ++ "\n"
gitAdd repo attributes
else return ()
{- Looks up a key in a State's Config -}
getConfig :: State -> (Config -> b) -> b
getConfig state key = key $ config state