simplify some function signatures using state

This commit is contained in:
Joey Hess 2010-10-12 16:20:41 -04:00
parent 20acda0423
commit 603e01e96c
3 changed files with 28 additions and 28 deletions

View file

@ -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

View file

@ -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

View 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