more Wall cleaning
This commit is contained in:
parent
1576c48c80
commit
2d893b3331
1 changed files with 23 additions and 25 deletions
48
Backend.hs
48
Backend.hs
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue