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 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 ()
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
11
Types.hs
11
Types.hs
|
@ -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]
|
||||||
|
}
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue