more Wall cleaning

This commit is contained in:
Joey Hess 2010-10-31 14:39:53 -04:00
parent 1576c48c80
commit 2d893b3331

View file

@ -28,15 +28,12 @@ module Backend (
import Control.Monad.State import Control.Monad.State
import Control.Exception.Extensible import Control.Exception.Extensible
import System.Directory
import System.FilePath import System.FilePath
import Data.String.Utils
import System.Posix.Files import System.Posix.Files
import Locations import Locations
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Annex import qualified Annex
import Utility
import Types import Types
import qualified TypeInternals as Internals import qualified TypeInternals as Internals
@ -47,28 +44,28 @@ list = do
if (not $ null l) if (not $ null l)
then return l then return l
else do else do
all <- Annex.supportedBackends bs <- Annex.supportedBackends
g <- Annex.gitRepo g <- Annex.gitRepo
let l = parseBackendList all $ Git.configGet g "annex.backends" "" let defaults = parseBackendList bs $ Git.configGet g "annex.backends" ""
backendflag <- Annex.flagGet "backend" backendflag <- Annex.flagGet "backend"
let l' = if (not $ null backendflag) let l' = if (not $ null backendflag)
then (lookupBackendName all backendflag):l then (lookupBackendName bs backendflag):defaults
else l else defaults
Annex.backendsChange $ l' Annex.backendsChange $ l'
return l' return l'
where where
parseBackendList all s = parseBackendList bs s =
if (null s) if (null s)
then all then bs
else map (lookupBackendName all) $ words s else map (lookupBackendName bs) $ words s
{- Looks up a backend in a list -} {- Looks up a backend in a list -}
lookupBackendName :: [Backend] -> String -> Backend lookupBackendName :: [Backend] -> String -> Backend
lookupBackendName all s = lookupBackendName bs s =
if ((length matches) /= 1) if ((length matches) /= 1)
then error $ "unknown backend " ++ s then error $ "unknown backend " ++ s
else matches !! 0 else matches !! 0
where matches = filter (\b -> s == Internals.name b) all where matches = filter (\b -> s == Internals.name b) bs
{- Attempts to store a file in one of the backends. -} {- Attempts to store a file in one of the backends. -}
storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) storeFileKey :: FilePath -> Annex (Maybe (Key, Backend))
@ -77,10 +74,11 @@ storeFileKey file = do
let relfile = Git.relative g file let relfile = Git.relative g file
b <- list b <- list
storeFileKey' b file relfile storeFileKey' b file relfile
storeFileKey' :: [Backend] -> FilePath -> FilePath -> Annex (Maybe (Key, Backend))
storeFileKey' [] _ _ = return Nothing storeFileKey' [] _ _ = return Nothing
storeFileKey' (b:bs) file relfile = do storeFileKey' (b:bs) file relfile = do
try <- (Internals.getKey b) relfile result <- (Internals.getKey b) relfile
case (try) of case (result) of
Nothing -> nextbackend Nothing -> nextbackend
Just key -> do Just key -> do
stored <- (Internals.storeFileKey b) file key stored <- (Internals.storeFileKey b) file key
@ -103,23 +101,23 @@ removeKey backend key = (Internals.removeKey backend) key
{- Checks if a backend has its key. -} {- Checks if a backend has its key. -}
hasKey :: Key -> Annex Bool hasKey :: Key -> Annex Bool
hasKey key = do hasKey key = do
all <- Annex.supportedBackends bs <- Annex.supportedBackends
(Internals.hasKey (lookupBackendName all $ backendName key)) key (Internals.hasKey (lookupBackendName bs $ backendName key)) key
{- Looks up the key and backend corresponding to an annexed file, {- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -} - by examining what the file symlinks to. -}
lookupFile :: FilePath -> Annex (Maybe (Key, Backend)) lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
lookupFile file = do lookupFile file = do
all <- Annex.supportedBackends bs <- Annex.supportedBackends
result <- liftIO $ (try (lookup all)::IO (Either SomeException (Maybe (Key, Backend)))) result <- liftIO $ (try (find bs)::IO (Either SomeException (Maybe (Key, Backend))))
case (result) of case (result) of
Left err -> return Nothing Left _ -> return Nothing
Right succ -> return succ Right val -> return val
where where
lookup all = do find bs = do
l <- readSymbolicLink file l <- readSymbolicLink file
return $ Just $ pair all $ takeFileName l return $ Just $ pair bs $ takeFileName l
pair all file = (k, b) pair bs f = (k, b)
where where
k = fileKey file k = fileKey f
b = lookupBackendName all $ backendName k b = lookupBackendName bs $ backendName k