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:
parent
490a3a828c
commit
d1071bd1fe
6 changed files with 54 additions and 38 deletions
21
Annex.hs
21
Annex.hs
|
@ -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
|
||||
|
|
54
Backend.hs
54
Backend.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
6
Types.hs
6
Types.hs
|
@ -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 {
|
||||
|
|
Loading…
Reference in a new issue