This commit is contained in:
Joey Hess 2010-10-10 18:25:31 -04:00
parent e5514e0cb0
commit 026adce5a0
5 changed files with 27 additions and 17 deletions

View file

@ -10,26 +10,32 @@ import Utility
import Locations import Locations
import Types import Types
import Backend import Backend
import BackendList
startAnnex :: IO State
startAnnex = do
r <- currentRepo
return State { repo = r, backends = supportedBackends }
{- Annexes a file, storing it in a backend, and then moving it into {- 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. -} - the annex directory and setting up the symlink pointing to its content. -}
annexFile :: [Backend] -> GitRepo -> FilePath -> IO () annexFile :: State -> FilePath -> IO ()
annexFile backends repo file = do annexFile state file = do
alreadyannexed <- lookupBackend backends repo file alreadyannexed <- lookupBackend (backends state) (repo state) file
case (alreadyannexed) of case (alreadyannexed) of
Just _ -> error $ "already annexed " ++ file Just _ -> error $ "already annexed " ++ file
Nothing -> do Nothing -> do
stored <- storeFile backends repo file stored <- storeFile (backends state) (repo state) file
case (stored) of case (stored) of
Nothing -> error $ "no backend could store " ++ file Nothing -> error $ "no backend could store " ++ file
Just key -> symlink key Just key -> symlink key
where where
symlink key = do symlink key = do
dest <- annexDir repo key dest <- annexDir (repo state) key
createDirectoryIfMissing True (parentDir dest) createDirectoryIfMissing True (parentDir dest)
renameFile file dest renameFile file dest
createSymbolicLink dest file createSymbolicLink dest file
gitAdd repo file gitAdd (repo state) file
{- Sets up a git repo for git-annex. May be called repeatedly. -} {- Sets up a git repo for git-annex. May be called repeatedly. -}
gitPrep :: GitRepo -> IO () gitPrep :: GitRepo -> IO ()

View file

@ -34,8 +34,8 @@ argvToFlags argv = do
(_,n,errs) -> ioError (userError (concat errs ++ usageInfo header options)) (_,n,errs) -> ioError (userError (concat errs ++ usageInfo header options))
where header = "Usage: git-annex [option] file" where header = "Usage: git-annex [option] file"
dispatch :: Flag -> [Backend] -> GitRepo -> IO () dispatch :: Flag -> State -> IO ()
dispatch flag backends repo = do dispatch flag state = do
case (flag) of case (flag) of
Add f -> annexFile backends repo f Add f -> annexFile state f
_ -> error "not implemented" _ -> error "not implemented"

View file

@ -8,7 +8,6 @@ import System.Path
import Data.String.Utils import Data.String.Utils
import Utility import Utility
import Types import Types
import BackendList
{- GitRepo constructor -} {- GitRepo constructor -}
gitRepo :: FilePath -> IO GitRepo gitRepo :: FilePath -> IO GitRepo
@ -16,8 +15,7 @@ gitRepo dir = do
-- TOOD query repo for configuration settings; other repositories; etc -- TOOD query repo for configuration settings; other repositories; etc
return GitRepo { return GitRepo {
top = dir, top = dir,
remotes = [], remotes = []
backends = supportedBackends
} }
{- Path to a repository's gitattributes file. -} {- Path to a repository's gitattributes file. -}

View file

@ -3,8 +3,10 @@
module Types where module Types where
-- annexed filenames are mapped into keys
type Key = String type Key = String
-- this structure represents a key/value backend
data Backend = Backend { data Backend = Backend {
-- name of this backend -- name of this backend
name :: String, name :: String,
@ -16,9 +18,14 @@ data Backend = Backend {
retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) retrieveKeyFile :: IO Key -> FilePath -> IO (Bool)
} }
-- a git repository
data GitRepo = GitRepo { data GitRepo = GitRepo {
top :: FilePath, top :: FilePath,
remotes :: [GitRepo], remotes :: [GitRepo]
backends :: [Backend]
} }
-- git-annex's runtime state
data State = State {
repo :: GitRepo,
backends :: [Backend]
}

View file

@ -11,7 +11,6 @@ main = do
args <- getArgs args <- getArgs
flags <- argvToFlags args flags <- argvToFlags args
repo <- currentRepo state <- startAnnex
gitPrep repo
mapM (\f -> dispatch f supportedBackends repo) flags mapM (\f -> dispatch f state) flags