diff options
| -rw-r--r-- | Backend.hs | 55 | ||||
| -rw-r--r-- | BackendFile.hs | 15 | ||||
| -rw-r--r-- | BackendUrl.hs | 15 | ||||
| -rw-r--r-- | GitRepo.hs | 11 | ||||
| -rw-r--r-- | LocationLog.hs | 12 | ||||
| -rw-r--r-- | git-annex.hs | 1 |
6 files changed, 79 insertions, 30 deletions
diff --git a/Backend.hs b/Backend.hs index cb91325c6..c55634a68 100644 --- a/Backend.hs +++ b/Backend.hs @@ -18,24 +18,60 @@ module Backend where -import GitRepo import System.Directory +import GitRepo +import Utility + +type Key = String data Backend = Backend { - name :: String, -- name of this backend - keyvalue :: FilePath -> Maybe String, -- maps from key to value - retrievekey :: IO String -> IO (Bool) -- retrieves value given key + -- name of this backend + name :: String, + -- converts a filename to a key + getKey :: FilePath -> IO (Maybe Key), + -- stores a file's contents to a key + storeFileKey :: FilePath -> Key -> IO (Bool), + -- retrieves a key's contents to a file + retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) } +instance Show Backend where + show backend = "Backend { name =\"" ++ (name backend) ++ "\" }" + {- Name of state file that holds the key for an annexed file, - using a given backend. -} backendFile :: Backend -> GitRepo -> FilePath -> String backendFile backend repo file = gitStateDir repo ++ (gitRelative repo file) ++ "." ++ (name backend) +{- Attempts to Stores a file in one of the backends. -} +storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool) +storeFile [] _ _ = return False +storeFile (b:bs) repo file = do + try <- (getKey b) (gitRelative repo file) + case (try) of + Nothing -> storeFile bs repo file + Just key -> do + (storeFileKey b) file key + createDirectoryIfMissing True (parentDir backendfile) + writeFile backendfile key + return True + where backendfile = backendFile b repo file + +{- Attempts to retrieve an file from one of the backends, saving it to + - a specified location. -} +retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool) +retrieveFile backends repo file dest = do + result <- lookupBackend backends repo file + case (result) of + Nothing -> return False + Just b -> (retrieveKeyFile b) key dest + where + key = readFile (backendFile b repo file) + {- Looks up the backend used for an already annexed file. -} lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) -lookupBackend [] repo file = return Nothing +lookupBackend [] _ _ = return Nothing lookupBackend (b:bs) repo file = do present <- checkBackend b repo file if present @@ -47,12 +83,3 @@ lookupBackend (b:bs) repo file = do {- Checks if a file is available via a given backend. -} checkBackend :: Backend -> GitRepo -> FilePath -> IO (Bool) checkBackend backend repo file = doesFileExist $ backendFile backend repo file - -{- Attempts to retrieve an annexed file from one of the backends. -} -retrieveFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool) -retrieveFile backends repo file = do - result <- lookupBackend backends repo file - case (result) of - Nothing -> return False - Just b -> (retrievekey b) key - where key = readFile (backendFile b repo file) diff --git a/BackendFile.hs b/BackendFile.hs index b1a3be58a..324a4d8cd 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -7,11 +7,18 @@ import Backend backend = Backend { name = "file", - keyvalue = keyValue, - retrievekey = copyFile + getKey = keyValue, + storeFileKey = moveToAnnex, + retrieveKeyFile = copyFromOtherRepo } -- direct mapping from filename to key -keyValue k = Just $ id k +keyValue :: FilePath -> IO (Maybe Key) +keyValue k = return $ Just $ id k + +moveToAnnex :: FilePath -> Key -> IO (Bool) +moveToAnnex file key = return False + +copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) +copyFromOtherRepo key file = return False -copyFile f = error "unimplemented" diff --git a/BackendUrl.hs b/BackendUrl.hs index f95c53bbf..9b4c83d61 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -7,11 +7,18 @@ import Backend backend = Backend { name = "url", - keyvalue = keyValue, - retrievekey = downloadUrl + getKey = keyValue, + storeFileKey = dummyStore, + retrieveKeyFile = downloadUrl } -- cannot generate url from filename -keyValue k = Nothing +keyValue :: FilePath -> IO (Maybe Key) +keyValue k = return Nothing -downloadUrl k = error "unimplemented" +-- cannot store to urls +dummyStore :: FilePath -> Key -> IO (Bool) +dummyStore file url = return False + +downloadUrl :: IO Key -> FilePath -> IO (Bool) +downloadUrl url file = error "unimplemented" diff --git a/GitRepo.hs b/GitRepo.hs index 8974d9db6..690782f0d 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -57,15 +57,22 @@ gitPrep repo = do attributes <- gitAttributes repo exists <- doesFileExist attributes if (not exists) - then writeFile attributes $ attrLine ++ "\n" + then do + writeFile attributes $ attrLine ++ "\n" + gitAdd repo attributes else do content <- readFile attributes if (all (/= attrLine) (lines content)) then do appendFile attributes $ attrLine ++ "\n" - -- TODO check attributes file into git? + gitAdd repo attributes else return () +{- Stages a changed file in git's index. -} +gitAdd repo file = do + -- TODO + return () + {- Finds the top of the current git repository, which may be in a parent - directory. -} repoTop :: IO GitRepo diff --git a/LocationLog.hs b/LocationLog.hs index f9421cd9a..32af82461 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -84,6 +84,7 @@ appendLog file line = do createDirectoryIfMissing True (parentDir file) withFileLocked file AppendMode $ \h -> hPutStrLn h $ show line + -- TODO git add log {- Writes a set of lines to a log file -} writeLog :: FilePath -> [LogLine] -> IO () @@ -99,17 +100,16 @@ logNow status repo = do return $ LogLine now status repo {- Returns the filename of the log file for a given annexed file. -} -logFile :: FilePath -> IO String -logFile annexedFile = do - repo <- repoTop +logFile :: GitRepo -> FilePath -> IO String +logFile repo annexedFile = do return $ (gitStateDir repo) ++ (gitRelative repo annexedFile) ++ ".log" {- Returns a list of repositories that, according to the log, have - the content of a file -} -fileLocations :: FilePath -> IO [String] -fileLocations file = do - log <- logFile file +fileLocations :: GitRepo -> FilePath -> IO [String] +fileLocations thisrepo file = do + log <- logFile thisrepo file lines <- readLog log return $ map repo (filterPresent lines) diff --git a/git-annex.hs b/git-annex.hs index 77faea2b7..556e0607e 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -4,6 +4,7 @@ import LocationLog import GitRepo import Backend +import Annex -- When adding a new backend, import it here and add it to the backends list. import qualified BackendFile |