update
This commit is contained in:
parent
dce9c2e080
commit
e5514e0cb0
12 changed files with 101 additions and 36 deletions
1
Annex.hs
1
Annex.hs
|
@ -8,6 +8,7 @@ import System.Directory
|
||||||
import GitRepo
|
import GitRepo
|
||||||
import Utility
|
import Utility
|
||||||
import Locations
|
import Locations
|
||||||
|
import Types
|
||||||
import Backend
|
import Backend
|
||||||
|
|
||||||
{- 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
|
||||||
|
|
14
Backend.hs
14
Backend.hs
|
@ -22,19 +22,7 @@ import System.Directory
|
||||||
import Locations
|
import Locations
|
||||||
import GitRepo
|
import GitRepo
|
||||||
import Utility
|
import Utility
|
||||||
|
import Types
|
||||||
type Key = String
|
|
||||||
|
|
||||||
data Backend = Backend {
|
|
||||||
-- name of this backend
|
|
||||||
name :: String,
|
|
||||||
-- converts a filename to a key
|
|
||||||
getKey :: GitRepo -> FilePath -> IO (Maybe Key),
|
|
||||||
-- stores a file's contents to a key
|
|
||||||
storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool),
|
|
||||||
-- retrieves a key's contents to a file
|
|
||||||
retrieveKeyFile :: IO Key -> FilePath -> IO (Bool)
|
|
||||||
}
|
|
||||||
|
|
||||||
instance Show Backend where
|
instance Show Backend where
|
||||||
show backend = "Backend { name =\"" ++ (name backend) ++ "\" }"
|
show backend = "Backend { name =\"" ++ (name backend) ++ "\" }"
|
||||||
|
|
|
@ -3,8 +3,7 @@
|
||||||
|
|
||||||
module BackendChecksum (backend) where
|
module BackendChecksum (backend) where
|
||||||
|
|
||||||
import Backend
|
import Types
|
||||||
import GitRepo
|
|
||||||
import qualified BackendFile
|
import qualified BackendFile
|
||||||
import Data.Digest.Pure.SHA
|
import Data.Digest.Pure.SHA
|
||||||
|
|
||||||
|
|
|
@ -3,8 +3,7 @@
|
||||||
|
|
||||||
module BackendFile (backend) where
|
module BackendFile (backend) where
|
||||||
|
|
||||||
import Backend
|
import Types
|
||||||
import GitRepo
|
|
||||||
|
|
||||||
backend = Backend {
|
backend = Backend {
|
||||||
name = "file",
|
name = "file",
|
||||||
|
|
14
BackendList.hs
Normal file
14
BackendList.hs
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
{- git-annex backend list
|
||||||
|
- -}
|
||||||
|
|
||||||
|
module BackendList where
|
||||||
|
|
||||||
|
-- When adding a new backend, import it here and add it to the list.
|
||||||
|
import qualified BackendFile
|
||||||
|
import qualified BackendChecksum
|
||||||
|
import qualified BackendUrl
|
||||||
|
supportedBackends =
|
||||||
|
[ BackendFile.backend
|
||||||
|
, BackendChecksum.backend
|
||||||
|
, BackendUrl.backend
|
||||||
|
]
|
|
@ -3,8 +3,7 @@
|
||||||
|
|
||||||
module BackendUrl (backend) where
|
module BackendUrl (backend) where
|
||||||
|
|
||||||
import Backend
|
import Types
|
||||||
import GitRepo
|
|
||||||
|
|
||||||
backend = Backend {
|
backend = Backend {
|
||||||
name = "url",
|
name = "url",
|
||||||
|
|
41
CmdLine.hs
Normal file
41
CmdLine.hs
Normal file
|
@ -0,0 +1,41 @@
|
||||||
|
{- git-annex command line
|
||||||
|
-
|
||||||
|
- TODO: This is very rough and stupid; I would like to use
|
||||||
|
- System.Console.CmdArgs.Implicit but it is not yet packaged in Debian.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module CmdLine where
|
||||||
|
|
||||||
|
import System.Console.GetOpt
|
||||||
|
import Types
|
||||||
|
import Annex
|
||||||
|
|
||||||
|
data Flag = Add FilePath | Push String | Pull String |
|
||||||
|
Want FilePath | Get (Maybe FilePath) | Drop FilePath
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
options :: [OptDescr Flag]
|
||||||
|
options =
|
||||||
|
[ Option ['a'] ["add"] (ReqArg Add "FILE") "add file to annex"
|
||||||
|
, Option ['p'] ["push"] (ReqArg Push "REPO") "push annex to repo"
|
||||||
|
, Option ['P'] ["pull"] (ReqArg Pull "REPO") "pull annex from repo"
|
||||||
|
, Option ['w'] ["want"] (ReqArg Want "FILE") "request file contents"
|
||||||
|
, Option ['g'] ["get"] (OptArg Get "FILE") "transfer file contents"
|
||||||
|
, Option ['d'] ["drop"] (ReqArg Drop "FILE") "indicate file content not needed"
|
||||||
|
]
|
||||||
|
|
||||||
|
argvToFlags argv = do
|
||||||
|
case getOpt Permute options argv of
|
||||||
|
-- no options? add listed files
|
||||||
|
([],p,[] ) -> return $ map (\f -> Add f) p
|
||||||
|
-- all options parsed, return flags
|
||||||
|
(o,[],[] ) -> return o
|
||||||
|
-- error case
|
||||||
|
(_,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
|
||||||
|
case (flag) of
|
||||||
|
Add f -> annexFile backends repo f
|
||||||
|
_ -> error "not implemented"
|
13
GitRepo.hs
13
GitRepo.hs
|
@ -7,17 +7,18 @@ import System.Directory
|
||||||
import System.Path
|
import System.Path
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
import Utility
|
import Utility
|
||||||
|
import Types
|
||||||
data GitRepo = GitRepo {
|
import BackendList
|
||||||
top :: FilePath,
|
|
||||||
remotes :: [GitRepo]
|
|
||||||
} deriving (Eq, Show, Read)
|
|
||||||
|
|
||||||
{- GitRepo constructor -}
|
{- GitRepo constructor -}
|
||||||
gitRepo :: FilePath -> IO GitRepo
|
gitRepo :: FilePath -> IO GitRepo
|
||||||
gitRepo dir = do
|
gitRepo dir = do
|
||||||
-- TOOD query repo for configuration settings; other repositories; etc
|
-- TOOD query repo for configuration settings; other repositories; etc
|
||||||
return GitRepo { top = dir, remotes = [] }
|
return GitRepo {
|
||||||
|
top = dir,
|
||||||
|
remotes = [],
|
||||||
|
backends = supportedBackends
|
||||||
|
}
|
||||||
|
|
||||||
{- Path to a repository's gitattributes file. -}
|
{- Path to a repository's gitattributes file. -}
|
||||||
gitAttributes :: GitRepo -> IO String
|
gitAttributes :: GitRepo -> IO String
|
||||||
|
|
|
@ -26,6 +26,7 @@ import Data.Char
|
||||||
import GitRepo
|
import GitRepo
|
||||||
import Utility
|
import Utility
|
||||||
import Locations
|
import Locations
|
||||||
|
import Types
|
||||||
|
|
||||||
data LogStatus = FilePresent | FileMissing | Undefined
|
data LogStatus = FilePresent | FileMissing | Undefined
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
|
@ -3,10 +3,11 @@
|
||||||
|
|
||||||
module Locations where
|
module Locations where
|
||||||
|
|
||||||
|
import Types
|
||||||
import GitRepo
|
import GitRepo
|
||||||
|
|
||||||
{- An annexed file's content is stored somewhere under .git/annex/ -}
|
{- An annexed file's content is stored somewhere under .git/annex/ -}
|
||||||
annexDir :: GitRepo -> String -> IO FilePath
|
annexDir :: GitRepo -> Key -> IO FilePath
|
||||||
annexDir repo key = do
|
annexDir repo key = do
|
||||||
dir <- gitDir repo
|
dir <- gitDir repo
|
||||||
return $ dir ++ "/annex/" ++ key
|
return $ dir ++ "/annex/" ++ key
|
||||||
|
|
24
Types.hs
Normal file
24
Types.hs
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
{- git-annex data types
|
||||||
|
- -}
|
||||||
|
|
||||||
|
module Types where
|
||||||
|
|
||||||
|
type Key = String
|
||||||
|
|
||||||
|
data Backend = Backend {
|
||||||
|
-- name of this backend
|
||||||
|
name :: String,
|
||||||
|
-- converts a filename to a key
|
||||||
|
getKey :: GitRepo -> FilePath -> IO (Maybe Key),
|
||||||
|
-- stores a file's contents to a key
|
||||||
|
storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool),
|
||||||
|
-- retrieves a key's contents to a file
|
||||||
|
retrieveKeyFile :: IO Key -> FilePath -> IO (Bool)
|
||||||
|
}
|
||||||
|
|
||||||
|
data GitRepo = GitRepo {
|
||||||
|
top :: FilePath,
|
||||||
|
remotes :: [GitRepo],
|
||||||
|
backends :: [Backend]
|
||||||
|
}
|
||||||
|
|
17
git-annex.hs
17
git-annex.hs
|
@ -1,20 +1,17 @@
|
||||||
{- git-annex main program
|
{- git-annex main program
|
||||||
- -}
|
- -}
|
||||||
|
|
||||||
import LocationLog
|
import System.Environment
|
||||||
import GitRepo
|
import GitRepo
|
||||||
import Backend
|
import CmdLine
|
||||||
import Annex
|
import Annex
|
||||||
|
import BackendList
|
||||||
-- When adding a new backend, import it here and add it to the backends list.
|
|
||||||
import qualified BackendFile
|
|
||||||
import qualified BackendChecksum
|
|
||||||
import qualified BackendUrl
|
|
||||||
backends = [BackendFile.backend, BackendChecksum.backend, BackendUrl.backend]
|
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
flags <- argvToFlags args
|
||||||
|
|
||||||
repo <- currentRepo
|
repo <- currentRepo
|
||||||
gitPrep repo
|
gitPrep repo
|
||||||
|
|
||||||
l <- readLog "demo.log"
|
mapM (\f -> dispatch f supportedBackends repo) flags
|
||||||
writeLog "demo2.log" $ compactLog l
|
|
||||||
|
|
Loading…
Reference in a new issue