tweak
This commit is contained in:
parent
35145202d2
commit
5ff04bf2af
7 changed files with 18 additions and 12 deletions
|
@ -6,6 +6,7 @@
|
|||
-}
|
||||
|
||||
module Backend (
|
||||
BackendFile,
|
||||
list,
|
||||
orderedList,
|
||||
genKey,
|
||||
|
@ -101,20 +102,22 @@ lookupFile file = do
|
|||
skip = "skipping " ++ file ++
|
||||
" (unknown backend " ++ bname ++ ")"
|
||||
|
||||
type BackendFile = (Maybe (Backend Annex), FilePath)
|
||||
|
||||
{- Looks up the backends that should be used for each file in a list.
|
||||
- That can be configured on a per-file basis in the gitattributes file.
|
||||
-}
|
||||
chooseBackends :: [FilePath] -> Annex [(FilePath, Maybe (Backend Annex))]
|
||||
chooseBackends :: [FilePath] -> Annex [BackendFile]
|
||||
chooseBackends fs = do
|
||||
g <- Annex.gitRepo
|
||||
forced <- Annex.getState Annex.forcebackend
|
||||
if forced /= Nothing
|
||||
then do
|
||||
l <- orderedList
|
||||
return $ map (\f -> (f, Just $ head l)) fs
|
||||
return $ map (\f -> (Just $ head l, f)) fs
|
||||
else do
|
||||
pairs <- liftIO $ Git.checkAttr g "annex.backend" fs
|
||||
return $ map (\(f,b) -> (f, maybeLookupBackendName b)) pairs
|
||||
return $ map (\(f,b) -> (maybeLookupBackendName b, f)) pairs
|
||||
|
||||
{- Looks up a backend by name. May fail if unknown. -}
|
||||
lookupBackendName :: String -> Backend Annex
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
{- git-annex commands
|
||||
{- git-annex command infrastructure
|
||||
-
|
||||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
|
@ -29,6 +29,7 @@ import Types.Key
|
|||
import Trust
|
||||
import LocationLog
|
||||
import Config
|
||||
import Backend
|
||||
|
||||
{- A command runs in four stages.
|
||||
-
|
||||
|
@ -49,8 +50,6 @@ type CommandPerform = Annex (Maybe CommandCleanup)
|
|||
- returns the overall success/fail of the command. -}
|
||||
type CommandCleanup = Annex Bool
|
||||
|
||||
type BackendFile = (FilePath, Maybe (Backend Annex))
|
||||
|
||||
data Command = Command {
|
||||
cmdusesrepo :: Bool,
|
||||
cmdname :: String,
|
||||
|
|
|
@ -27,6 +27,7 @@ import Utility.Conditional
|
|||
import Utility.Touch
|
||||
import Utility.SafeCommand
|
||||
import Locations
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "add" paramPaths seek "add files to annex"]
|
||||
|
@ -39,7 +40,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
|
|||
- moving it into the annex directory and setting up the symlink pointing
|
||||
- to its content. -}
|
||||
start :: BackendFile -> CommandStart
|
||||
start p@(file, _) = notAnnexed file $ do
|
||||
start p@(_, file) = notAnnexed file $ do
|
||||
s <- liftIO $ getSymbolicLinkStatus file
|
||||
if isSymbolicLink s || not (isRegularFile s)
|
||||
then stop
|
||||
|
@ -48,7 +49,7 @@ start p@(file, _) = notAnnexed file $ do
|
|||
next $ perform p
|
||||
|
||||
perform :: BackendFile -> CommandPerform
|
||||
perform (file, backend) = do
|
||||
perform (backend, file) = do
|
||||
k <- Backend.genKey file backend
|
||||
case k of
|
||||
Nothing -> stop
|
||||
|
|
|
@ -59,7 +59,7 @@ download url file = do
|
|||
ok <- Url.download url tmp
|
||||
if ok
|
||||
then do
|
||||
[(_, backend)] <- Backend.chooseBackends [file]
|
||||
[(backend, _)] <- Backend.chooseBackends [file]
|
||||
k <- Backend.genKey tmp backend
|
||||
case k of
|
||||
Nothing -> stop
|
||||
|
|
|
@ -14,6 +14,7 @@ import Command
|
|||
import Messages
|
||||
import qualified AnnexQueue
|
||||
import Utility.SafeCommand
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "lock" paramPaths seek "undo unlock command"]
|
||||
|
@ -23,7 +24,7 @@ seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start]
|
|||
|
||||
{- Undo unlock -}
|
||||
start :: BackendFile -> CommandStart
|
||||
start (file, _) = do
|
||||
start (_, file) = do
|
||||
showStart "lock" file
|
||||
next $ perform file
|
||||
|
||||
|
|
|
@ -23,6 +23,7 @@ import Content
|
|||
import Messages
|
||||
import Utility.Conditional
|
||||
import qualified Command.Add
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "migrate" paramPaths seek
|
||||
|
@ -32,7 +33,7 @@ seek :: [CommandSeek]
|
|||
seek = [withBackendFilesInGit start]
|
||||
|
||||
start :: BackendFile -> CommandStart
|
||||
start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
|
||||
start (b, file) = isAnnexed file $ \(key, oldbackend) -> do
|
||||
exists <- inAnnex key
|
||||
newbackend <- choosebackend b
|
||||
if (newbackend /= oldbackend || upgradableKey key) && exists
|
||||
|
|
|
@ -10,6 +10,7 @@ module Command.PreCommit where
|
|||
import Command
|
||||
import qualified Command.Add
|
||||
import qualified Command.Fix
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "pre-commit" paramPaths seek "run by git pre-commit hook"]
|
||||
|
@ -24,7 +25,7 @@ start :: BackendFile -> CommandStart
|
|||
start p = next $ perform p
|
||||
|
||||
perform :: BackendFile -> CommandPerform
|
||||
perform pair@(file, _) = do
|
||||
perform pair@(_, file) = do
|
||||
ok <- doCommand $ Command.Add.start pair
|
||||
if ok
|
||||
then next $ return True
|
||||
|
|
Loading…
Reference in a new issue