simplify some function signatures using state
This commit is contained in:
parent
20acda0423
commit
603e01e96c
3 changed files with 28 additions and 28 deletions
11
Annex.hs
11
Annex.hs
|
@ -2,7 +2,6 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Annex (
|
module Annex (
|
||||||
State,
|
|
||||||
startAnnex,
|
startAnnex,
|
||||||
annexFile,
|
annexFile,
|
||||||
unannexFile,
|
unannexFile,
|
||||||
|
@ -45,12 +44,12 @@ startAnnex = do
|
||||||
- the annex directory and setting up the symlink pointing to its content. -}
|
- the annex directory and setting up the symlink pointing to its content. -}
|
||||||
annexFile :: State -> FilePath -> IO ()
|
annexFile :: State -> FilePath -> IO ()
|
||||||
annexFile state file = do
|
annexFile state file = do
|
||||||
alreadyannexed <- lookupBackend (backends state) state file
|
alreadyannexed <- lookupBackend state file
|
||||||
case (alreadyannexed) of
|
case (alreadyannexed) of
|
||||||
Just _ -> error $ "already annexed: " ++ file
|
Just _ -> error $ "already annexed: " ++ file
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
checkLegal file
|
checkLegal file
|
||||||
stored <- storeFile (backends state) state file
|
stored <- storeFile state file
|
||||||
case (stored) of
|
case (stored) of
|
||||||
Nothing -> error $ "no backend could store: " ++ file
|
Nothing -> error $ "no backend could store: " ++ file
|
||||||
Just key -> symlink key
|
Just key -> symlink key
|
||||||
|
@ -70,11 +69,11 @@ annexFile state file = do
|
||||||
{- Inverse of annexFile. -}
|
{- Inverse of annexFile. -}
|
||||||
unannexFile :: State -> FilePath -> IO ()
|
unannexFile :: State -> FilePath -> IO ()
|
||||||
unannexFile state file = do
|
unannexFile state file = do
|
||||||
alreadyannexed <- lookupBackend (backends state) state file
|
alreadyannexed <- lookupBackend state file
|
||||||
case (alreadyannexed) of
|
case (alreadyannexed) of
|
||||||
Nothing -> error $ "not annexed " ++ file
|
Nothing -> error $ "not annexed " ++ file
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
mkey <- dropFile (backends state) state file
|
mkey <- dropFile state file
|
||||||
case (mkey) of
|
case (mkey) of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just key -> do
|
Just key -> do
|
||||||
|
@ -86,7 +85,7 @@ unannexFile state file = do
|
||||||
{- Transfers the file from a remote. -}
|
{- Transfers the file from a remote. -}
|
||||||
annexGetFile :: State -> FilePath -> IO ()
|
annexGetFile :: State -> FilePath -> IO ()
|
||||||
annexGetFile state file = do
|
annexGetFile state file = do
|
||||||
alreadyannexed <- lookupBackend (backends state) state file
|
alreadyannexed <- lookupBackend state file
|
||||||
case (alreadyannexed) of
|
case (alreadyannexed) of
|
||||||
Nothing -> error $ "not annexed " ++ file
|
Nothing -> error $ "not annexed " ++ file
|
||||||
Just _ -> do error "not implemented" -- TODO
|
Just _ -> do error "not implemented" -- TODO
|
||||||
|
|
44
Backend.hs
44
Backend.hs
|
@ -17,8 +17,6 @@
|
||||||
- -}
|
- -}
|
||||||
|
|
||||||
module Backend (
|
module Backend (
|
||||||
Key,
|
|
||||||
Backend, -- note only data type is exported, not destructors
|
|
||||||
lookupBackend,
|
lookupBackend,
|
||||||
storeFile,
|
storeFile,
|
||||||
dropFile
|
dropFile
|
||||||
|
@ -32,16 +30,17 @@ import Types
|
||||||
|
|
||||||
{- Name of state file that holds the key for an annexed file,
|
{- Name of state file that holds the key for an annexed file,
|
||||||
- using a given backend. -}
|
- using a given backend. -}
|
||||||
backendFile :: Backend -> State -> FilePath -> String
|
backendFile :: State -> Backend -> FilePath -> String
|
||||||
backendFile backend state file =
|
backendFile state backend file =
|
||||||
gitStateDir (repo state) ++ (gitRelative (repo state) file) ++
|
gitStateDir (repo state) ++ (gitRelative (repo state) file) ++
|
||||||
"." ++ (name backend)
|
"." ++ (name backend)
|
||||||
|
|
||||||
{- Attempts to store a file in one of the backends, and returns
|
{- Attempts to store a file in one of the backends, and returns
|
||||||
- its key. -}
|
- its key. -}
|
||||||
storeFile :: [Backend] -> State -> FilePath -> IO (Maybe Key)
|
storeFile :: State -> FilePath -> IO (Maybe Key)
|
||||||
storeFile [] _ _ = return Nothing
|
storeFile state file = storeFile' (backends state) state file
|
||||||
storeFile (b:bs) state file = do
|
storeFile' [] _ _ = return Nothing
|
||||||
|
storeFile' (b:bs) state file = do
|
||||||
try <- (getKey b) state (gitRelative (repo state) file)
|
try <- (getKey b) state (gitRelative (repo state) file)
|
||||||
case (try) of
|
case (try) of
|
||||||
Nothing -> nextbackend
|
Nothing -> nextbackend
|
||||||
|
@ -53,17 +52,17 @@ storeFile (b:bs) state file = do
|
||||||
bookkeeping key
|
bookkeeping key
|
||||||
return $ Just key
|
return $ Just key
|
||||||
where
|
where
|
||||||
nextbackend = storeFile bs state file
|
nextbackend = storeFile' bs state file
|
||||||
backendfile = backendFile b state file
|
backendfile = backendFile state b file
|
||||||
bookkeeping key = do
|
bookkeeping key = do
|
||||||
createDirectoryIfMissing True (parentDir backendfile)
|
createDirectoryIfMissing True (parentDir backendfile)
|
||||||
writeFile backendfile key
|
writeFile backendfile key
|
||||||
|
|
||||||
{- Attempts to retrieve an file from one of the backends, saving it to
|
{- Attempts to retrieve an file from one of the backends, saving it to
|
||||||
- a specified location. -}
|
- a specified location. -}
|
||||||
retrieveFile :: [Backend] -> State -> FilePath -> FilePath -> IO Bool
|
retrieveFile :: State -> FilePath -> FilePath -> IO Bool
|
||||||
retrieveFile backends state file dest = do
|
retrieveFile state file dest = do
|
||||||
result <- lookupBackend backends state file
|
result <- lookupBackend state file
|
||||||
case (result) of
|
case (result) of
|
||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
Just b -> do
|
Just b -> do
|
||||||
|
@ -71,32 +70,33 @@ retrieveFile backends state file dest = do
|
||||||
(retrieveKeyFile b) state key dest
|
(retrieveKeyFile b) state key dest
|
||||||
|
|
||||||
{- Drops the key for a file from the backend that has it. -}
|
{- Drops the key for a file from the backend that has it. -}
|
||||||
dropFile :: [Backend] -> State -> FilePath -> IO (Maybe Key)
|
dropFile :: State -> FilePath -> IO (Maybe Key)
|
||||||
dropFile backends state file = do
|
dropFile state file = do
|
||||||
result <- lookupBackend backends state file
|
result <- lookupBackend state file
|
||||||
case (result) of
|
case (result) of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
Just b -> do
|
Just b -> do
|
||||||
key <- lookupKey b state file
|
key <- lookupKey b state file
|
||||||
(removeKey b) state key
|
(removeKey b) state key
|
||||||
removeFile $ backendFile b state file
|
removeFile $ backendFile state b file
|
||||||
return $ Just key
|
return $ Just key
|
||||||
|
|
||||||
{- Looks up the key a backend uses for an already annexed file. -}
|
{- Looks up the key a backend uses for an already annexed file. -}
|
||||||
lookupKey :: Backend -> State -> FilePath -> IO Key
|
lookupKey :: Backend -> State -> FilePath -> IO Key
|
||||||
lookupKey backend state file = readFile (backendFile backend state file)
|
lookupKey backend state file = readFile (backendFile state backend file)
|
||||||
|
|
||||||
{- Looks up the backend used for an already annexed file. -}
|
{- Looks up the backend used for an already annexed file. -}
|
||||||
lookupBackend :: [Backend] -> State -> FilePath -> IO (Maybe Backend)
|
lookupBackend :: State -> FilePath -> IO (Maybe Backend)
|
||||||
lookupBackend [] _ _ = return Nothing
|
lookupBackend state file = lookupBackend' (backends state) state file
|
||||||
lookupBackend (b:bs) state file = do
|
lookupBackend' [] _ _ = return Nothing
|
||||||
|
lookupBackend' (b:bs) state file = do
|
||||||
present <- checkBackend b state file
|
present <- checkBackend b state file
|
||||||
if present
|
if present
|
||||||
then
|
then
|
||||||
return $ Just b
|
return $ Just b
|
||||||
else
|
else
|
||||||
lookupBackend bs state file
|
lookupBackend' bs state file
|
||||||
|
|
||||||
{- Checks if a file is available via a given backend. -}
|
{- Checks if a file is available via a given backend. -}
|
||||||
checkBackend :: Backend -> State -> FilePath -> IO (Bool)
|
checkBackend :: Backend -> State -> FilePath -> IO (Bool)
|
||||||
checkBackend backend state file = doesFileExist $ backendFile backend state file
|
checkBackend backend state file = doesFileExist $ backendFile state backend file
|
||||||
|
|
|
@ -10,6 +10,7 @@ module CmdLine (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Console.GetOpt
|
import System.Console.GetOpt
|
||||||
|
import Types
|
||||||
import Annex
|
import Annex
|
||||||
|
|
||||||
data Mode = Add | Push | Pull | Want | Get | Drop | Unannex
|
data Mode = Add | Push | Pull | Want | Get | Drop | Unannex
|
||||||
|
|
Loading…
Reference in a new issue