update
This commit is contained in:
parent
e5514e0cb0
commit
026adce5a0
5 changed files with 27 additions and 17 deletions
18
Annex.hs
18
Annex.hs
|
@ -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 ()
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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. -}
|
||||
|
|
11
Types.hs
11
Types.hs
|
@ -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]
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue