autobugfixing!

Converted Key to a real data type and caught all the places where I used
an unconverted filename as a key.

Had to loose some sanity checks around whether something is already
annexed, but I guess I can add those back other ways.
This commit is contained in:
Joey Hess 2010-10-13 02:31:24 -04:00
parent 490a3a828c
commit d1071bd1fe
6 changed files with 54 additions and 38 deletions

View file

@ -45,7 +45,8 @@ startAnnex = do
- the annex directory and setting up the symlink pointing to its content. -}
annexFile :: State -> FilePath -> IO ()
annexFile state file = do
alreadyannexed <- lookupBackend state file
-- TODO check if already annexed
let alreadyannexed = Nothing
case (alreadyannexed) of
Just _ -> error $ "already annexed: " ++ file
Nothing -> do
@ -83,15 +84,17 @@ annexFile state file = do
{- Inverse of annexFile. -}
unannexFile :: State -> FilePath -> IO ()
unannexFile state file = do
alreadyannexed <- lookupBackend state file
-- TODO check if already annexed
let alreadyannexed = Just 1
case (alreadyannexed) of
Nothing -> error $ "not annexed " ++ file
Just _ -> do
mkey <- dropFile state file
case (mkey) of
key <- fileKey file
dropped <- dropFile state key
case (dropped) of
Nothing -> return ()
Just (key, backend) -> do
let src = annexLocation state backend file
let src = annexLocation state backend key
removeFile file
gitRun (repo state) ["rm", file]
gitRun (repo state) ["commit", "-m",
@ -107,18 +110,20 @@ unannexFile state file = do
{- Transfers the file from a remote. -}
annexGetFile :: State -> FilePath -> IO ()
annexGetFile state file = do
alreadyannexed <- lookupBackend state file
-- TODO check if already annexed
let alreadyannexed = Just 1
case (alreadyannexed) of
Nothing -> error $ "not annexed " ++ file
Just backend -> do
Just _ -> do
key <- fileKey file
backend <- fileBackend file
inannex <- inAnnex state backend key
if (inannex)
then return ()
else do
let dest = annexLocation state backend key
createDirectoryIfMissing True (parentDir dest)
success <- retrieveFile state file dest
success <- retrieveFile state key dest
if (success)
then do
logStatus state key ValuePresent

View file

@ -16,15 +16,17 @@
module Backend (
lookupBackend,
storeFile,
dropFile,
retrieveFile,
fileKey,
dropFile
fileBackend
) where
import System.Directory
import System.FilePath
import Data.String.Utils
import System.Posix.Files
import BackendList
import Locations
import GitRepo
import Utility
@ -47,48 +49,52 @@ storeFile' (b:bs) state file = do
where
nextbackend = storeFile' bs state file
{- Attempts to retrieve an file from one of the backends, saving it to
{- Attempts to retrieve an key from one of the backends, saving it to
- a specified location. -}
retrieveFile :: State -> FilePath -> FilePath -> IO Bool
retrieveFile state file dest = do
result <- lookupBackend state file
retrieveFile :: State -> Key -> FilePath -> IO Bool
retrieveFile state key dest = do
result <- lookupBackend state key
case (result) of
Nothing -> return False
Just backend -> do
key <- fileKey file
(retrieveKeyFile backend) state key dest
Just backend -> (retrieveKeyFile backend) state key dest
{- Drops the key for a file from the backend that has it. -}
dropFile :: State -> FilePath -> IO (Maybe (Key, Backend))
dropFile state file = do
result <- lookupBackend state file
{- Drops a key from the backend that has it. -}
dropFile :: State -> Key -> IO (Maybe (Key, Backend))
dropFile state key = do
result <- lookupBackend state key
case (result) of
Nothing -> return Nothing
Just backend -> do
key <- fileKey file
(removeKey backend) state key
return $ Just (key, backend)
{- Looks up the backend used for an already annexed file. -}
lookupBackend :: State -> FilePath -> IO (Maybe Backend)
lookupBackend state file = lookupBackend' (backends state) state file
{- Looks up the backend that has a key. -}
lookupBackend :: State -> Key -> IO (Maybe Backend)
lookupBackend state key = lookupBackend' (backends state) state key
lookupBackend' [] _ _ = return Nothing
lookupBackend' (b:bs) state file = do
present <- checkBackend b state file
lookupBackend' (b:bs) state key = do
present <- checkBackend b state key
if present
then
return $ Just b
else
lookupBackend' bs state file
lookupBackend' bs state key
{- Checks if a file is available via a given backend. -}
checkBackend :: Backend -> State -> FilePath -> IO (Bool)
checkBackend backend state file =
doesFileExist $ annexLocation state backend file
{- Checks if a key is available via a given backend. -}
checkBackend :: Backend -> State -> Key -> IO (Bool)
checkBackend backend state key =
doesFileExist $ annexLocation state backend key
{- Looks up the key corresponding to an annexed file,
- by examining what the file symlinks to. -}
fileKey :: FilePath -> IO Key
fileKey file = do
l <- readSymbolicLink (file)
return $ takeFileName $ l
return $ Key $ takeFileName $ l
{- Looks up the backend corresponding to an annexed file,
- by examining what the file symlinks to. -}
fileBackend :: FilePath -> IO Backend
fileBackend file = do
l <- readSymbolicLink (file)
return $ lookupBackendName $ takeFileName $ parentDir $ l

View file

@ -15,12 +15,13 @@ backend = Backend {
-- direct mapping from filename to key
keyValue :: State -> FilePath -> IO (Maybe Key)
keyValue state file = return $ Just file
keyValue state file = return $ Just $ Key file
{- This backend does not really do any independant data storage,
- it relies on the file contents in .git/annex/ in this repo,
- and other accessible repos. So storing or removing a key is
- a no-op. -}
- a no-op. TODO until support is added for git annex --push otherrepo,
- then these could implement that.. -}
dummyStore :: State -> FilePath -> Key -> IO (Bool)
dummyStore state file key = return True
dummyRemove :: State -> Key -> IO Bool

View file

@ -27,8 +27,8 @@ dummyRemove state url = return False
downloadUrl :: State -> Key -> FilePath -> IO Bool
downloadUrl state url file = do
putStrLn $ "download: " ++ url
result <- try $ rawSystem "curl" ["-#", "-o", file, url]
putStrLn $ "download: " ++ (show url)
result <- try $ rawSystem "curl" ["-#", "-o", file, (show url)]
case (result) of
Left _ -> return False
Right _ -> return True

View file

@ -30,7 +30,7 @@ gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/"
- is one to one.
- -}
keyFile :: Key -> FilePath
keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" key
keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" $ show key
{- An annexed file's content is stored in
- .git/annex/<backend>/<key> ; this allows deriving the key and backend

View file

@ -16,7 +16,11 @@ data State = State {
} deriving (Show)
-- annexed filenames are mapped into keys
type Key = FilePath
data Key = Key String deriving (Eq)
-- show a key to convert it to a string
instance Show Key where
show (Key v) = v
-- this structure represents a key/value backend
data Backend = Backend {