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 Types
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
- the annex directory and setting up the symlink pointing to its content. -}
annexFile :: [Backend] -> GitRepo -> FilePath -> IO ()
annexFile backends repo file = do
alreadyannexed <- lookupBackend backends repo file
annexFile :: State -> FilePath -> IO ()
annexFile state file = do
alreadyannexed <- lookupBackend (backends state) (repo state) file
case (alreadyannexed) of
Just _ -> error $ "already annexed " ++ file
Nothing -> do
stored <- storeFile backends repo 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 key
dest <- annexDir (repo state) key
createDirectoryIfMissing True (parentDir dest)
renameFile file dest
createSymbolicLink dest file
gitAdd repo file
gitAdd (repo state) file
{- Sets up a git repo for git-annex. May be called repeatedly. -}
gitPrep :: GitRepo -> IO ()

View file

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

View file

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

View file

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

View file

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