error handling
This commit is contained in:
parent
d1071bd1fe
commit
4b801b265a
2 changed files with 34 additions and 67 deletions
32
Annex.hs
32
Annex.hs
|
@ -45,10 +45,9 @@ startAnnex = do
|
|||
- the annex directory and setting up the symlink pointing to its content. -}
|
||||
annexFile :: State -> FilePath -> IO ()
|
||||
annexFile state file = do
|
||||
-- TODO check if already annexed
|
||||
let alreadyannexed = Nothing
|
||||
case (alreadyannexed) of
|
||||
Just _ -> error $ "already annexed: " ++ file
|
||||
r <- lookupFile file
|
||||
case (r) of
|
||||
Just _ -> error $ "already annexed " ++ file
|
||||
Nothing -> do
|
||||
checkLegal file
|
||||
stored <- storeFile state file
|
||||
|
@ -84,16 +83,14 @@ annexFile state file = do
|
|||
{- Inverse of annexFile. -}
|
||||
unannexFile :: State -> FilePath -> IO ()
|
||||
unannexFile state file = do
|
||||
-- TODO check if already annexed
|
||||
let alreadyannexed = Just 1
|
||||
case (alreadyannexed) of
|
||||
r <- lookupFile file
|
||||
case (r) of
|
||||
Nothing -> error $ "not annexed " ++ file
|
||||
Just _ -> do
|
||||
key <- fileKey file
|
||||
dropped <- dropFile state key
|
||||
case (dropped) of
|
||||
Nothing -> return ()
|
||||
Just (key, backend) -> do
|
||||
dropped <- dropFile state backend key
|
||||
if (not dropped)
|
||||
then error $ "backend refused to drop " ++ file
|
||||
else do
|
||||
let src = annexLocation state backend key
|
||||
removeFile file
|
||||
gitRun (repo state) ["rm", file]
|
||||
|
@ -110,20 +107,17 @@ unannexFile state file = do
|
|||
{- Transfers the file from a remote. -}
|
||||
annexGetFile :: State -> FilePath -> IO ()
|
||||
annexGetFile state file = do
|
||||
-- TODO check if already annexed
|
||||
let alreadyannexed = Just 1
|
||||
case (alreadyannexed) of
|
||||
r <- lookupFile file
|
||||
case (r) of
|
||||
Nothing -> error $ "not annexed " ++ file
|
||||
Just _ -> do
|
||||
key <- fileKey file
|
||||
backend <- fileBackend file
|
||||
Just (key, backend) -> do
|
||||
inannex <- inAnnex state backend key
|
||||
if (inannex)
|
||||
then return ()
|
||||
else do
|
||||
let dest = annexLocation state backend key
|
||||
createDirectoryIfMissing True (parentDir dest)
|
||||
success <- retrieveFile state key dest
|
||||
success <- retrieveFile state backend key dest
|
||||
if (success)
|
||||
then do
|
||||
logStatus state key ValuePresent
|
||||
|
|
67
Backend.hs
67
Backend.hs
|
@ -14,14 +14,13 @@
|
|||
- -}
|
||||
|
||||
module Backend (
|
||||
lookupBackend,
|
||||
storeFile,
|
||||
dropFile,
|
||||
retrieveFile,
|
||||
fileKey,
|
||||
fileBackend
|
||||
lookupFile
|
||||
) where
|
||||
|
||||
import Control.Exception
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import Data.String.Utils
|
||||
|
@ -51,50 +50,24 @@ storeFile' (b:bs) state file = do
|
|||
|
||||
{- Attempts to retrieve an key from one of the backends, saving it to
|
||||
- a specified location. -}
|
||||
retrieveFile :: State -> Key -> FilePath -> IO Bool
|
||||
retrieveFile state key dest = do
|
||||
result <- lookupBackend state key
|
||||
case (result) of
|
||||
Nothing -> return False
|
||||
Just backend -> (retrieveKeyFile backend) state key dest
|
||||
retrieveFile :: State -> Backend -> Key -> FilePath -> IO Bool
|
||||
retrieveFile state backend key dest = (retrieveKeyFile backend) state key dest
|
||||
|
||||
{- 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
|
||||
(removeKey backend) state key
|
||||
return $ Just (key, backend)
|
||||
{- Drops a key from a backend. -}
|
||||
dropFile :: State -> Backend -> Key -> IO Bool
|
||||
dropFile state backend key = (removeKey backend) state key
|
||||
|
||||
{- 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 key = do
|
||||
present <- checkBackend b state key
|
||||
if present
|
||||
then
|
||||
return $ Just b
|
||||
else
|
||||
lookupBackend' bs state key
|
||||
|
||||
{- 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,
|
||||
{- Looks up the key and backend corresponding to an annexed file,
|
||||
- by examining what the file symlinks to. -}
|
||||
fileKey :: FilePath -> IO Key
|
||||
fileKey file = do
|
||||
l <- readSymbolicLink (file)
|
||||
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
|
||||
lookupFile :: FilePath -> IO (Maybe (Key, Backend))
|
||||
lookupFile file = do
|
||||
result <- try (lookup)::IO (Either SomeException (Maybe (Key, Backend)))
|
||||
case (result) of
|
||||
Left err -> return Nothing
|
||||
Right succ -> return succ
|
||||
where
|
||||
lookup = do
|
||||
l <- readSymbolicLink file
|
||||
return $ Just (k l, b l)
|
||||
k l = Key $ takeFileName $ l
|
||||
b l = lookupBackendName $ takeFileName $ parentDir $ l
|
||||
|
|
Loading…
Reference in a new issue