type alias cleanup
This commit is contained in:
parent
a2ec2d3760
commit
4a02c2ea62
38 changed files with 129 additions and 122 deletions
4
Annex.hs
4
Annex.hs
|
@ -67,8 +67,8 @@ data OutputType = NormalOutput | QuietOutput | JSONOutput
|
|||
-- internal state storage
|
||||
data AnnexState = AnnexState
|
||||
{ repo :: Git.Repo
|
||||
, backends :: [Backend Annex]
|
||||
, remotes :: [Types.Remote.Remote Annex]
|
||||
, backends :: [BackendA Annex]
|
||||
, remotes :: [Types.Remote.RemoteA Annex]
|
||||
, repoqueue :: Git.Queue.Queue
|
||||
, output :: OutputType
|
||||
, force :: Bool
|
||||
|
|
16
Backend.hs
16
Backend.hs
|
@ -31,11 +31,11 @@ import qualified Backend.SHA
|
|||
import qualified Backend.WORM
|
||||
import qualified Backend.URL
|
||||
|
||||
list :: [Backend Annex]
|
||||
list :: [Backend]
|
||||
list = Backend.SHA.backends ++ Backend.WORM.backends ++ Backend.URL.backends
|
||||
|
||||
{- List of backends in the order to try them when storing a new key. -}
|
||||
orderedList :: Annex [Backend Annex]
|
||||
orderedList :: Annex [Backend]
|
||||
orderedList = do
|
||||
l <- Annex.getState Annex.backends -- list is cached here
|
||||
if not $ null l
|
||||
|
@ -54,12 +54,12 @@ orderedList = do
|
|||
|
||||
{- Generates a key for a file, trying each backend in turn until one
|
||||
- accepts it. -}
|
||||
genKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
|
||||
genKey :: FilePath -> Maybe Backend -> Annex (Maybe (Key, Backend))
|
||||
genKey file trybackend = do
|
||||
bs <- orderedList
|
||||
let bs' = maybe bs (: bs) trybackend
|
||||
genKey' bs' file
|
||||
genKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
|
||||
genKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend))
|
||||
genKey' [] _ = return Nothing
|
||||
genKey' (b:bs) file = do
|
||||
r <- (B.getKey b) file
|
||||
|
@ -75,7 +75,7 @@ genKey' (b:bs) file = do
|
|||
|
||||
{- Looks up the key and backend corresponding to an annexed file,
|
||||
- by examining what the file symlinks to. -}
|
||||
lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex))
|
||||
lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
|
||||
lookupFile file = do
|
||||
tl <- liftIO $ try getsymlink
|
||||
case tl of
|
||||
|
@ -94,7 +94,7 @@ lookupFile file = do
|
|||
bname ++ ")"
|
||||
return Nothing
|
||||
|
||||
type BackendFile = (Maybe (Backend Annex), FilePath)
|
||||
type BackendFile = (Maybe Backend, 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.
|
||||
|
@ -110,11 +110,11 @@ chooseBackends fs = Annex.getState Annex.forcebackend >>= go
|
|||
return $ map (\f -> (Just $ Prelude.head l, f)) fs
|
||||
|
||||
{- Looks up a backend by name. May fail if unknown. -}
|
||||
lookupBackendName :: String -> Backend Annex
|
||||
lookupBackendName :: String -> Backend
|
||||
lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
|
||||
where
|
||||
unknown = error $ "unknown backend " ++ s
|
||||
maybeLookupBackendName :: String -> Maybe (Backend Annex)
|
||||
maybeLookupBackendName :: String -> Maybe Backend
|
||||
maybeLookupBackendName s = headMaybe matches
|
||||
where
|
||||
matches = filter (\b -> s == B.name b) list
|
||||
|
|
|
@ -21,21 +21,21 @@ type SHASize = Int
|
|||
sizes :: [Int]
|
||||
sizes = [256, 1, 512, 224, 384]
|
||||
|
||||
backends :: [Backend Annex]
|
||||
backends :: [Backend]
|
||||
backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes
|
||||
|
||||
genBackend :: SHASize -> Maybe (Backend Annex)
|
||||
genBackend :: SHASize -> Maybe Backend
|
||||
genBackend size
|
||||
| isNothing (shaCommand size) = Nothing
|
||||
| otherwise = Just b
|
||||
where
|
||||
b = Types.Backend.Backend
|
||||
b = Backend
|
||||
{ name = shaName size
|
||||
, getKey = keyValue size
|
||||
, fsckKey = checkKeyChecksum size
|
||||
}
|
||||
|
||||
genBackendE :: SHASize -> Maybe (Backend Annex)
|
||||
genBackendE :: SHASize -> Maybe Backend
|
||||
genBackendE size =
|
||||
case genBackend size of
|
||||
Nothing -> Nothing
|
||||
|
|
|
@ -14,11 +14,11 @@ import Common.Annex
|
|||
import Types.Backend
|
||||
import Types.Key
|
||||
|
||||
backends :: [Backend Annex]
|
||||
backends :: [Backend]
|
||||
backends = [backend]
|
||||
|
||||
backend :: Backend Annex
|
||||
backend = Types.Backend.Backend {
|
||||
backend :: Backend
|
||||
backend = Backend {
|
||||
name = "URL",
|
||||
getKey = const (return Nothing),
|
||||
fsckKey = const (return True)
|
||||
|
|
|
@ -11,11 +11,11 @@ import Common.Annex
|
|||
import Types.Backend
|
||||
import Types.Key
|
||||
|
||||
backends :: [Backend Annex]
|
||||
backends :: [Backend]
|
||||
backends = [backend]
|
||||
|
||||
backend :: Backend Annex
|
||||
backend = Types.Backend.Backend {
|
||||
backend :: Backend
|
||||
backend = Backend {
|
||||
name = "WORM",
|
||||
getKey = keyValue,
|
||||
fsckKey = const (return True)
|
||||
|
|
|
@ -77,10 +77,10 @@ doCommand = start
|
|||
|
||||
{- Modifies an action to only act on files that are already annexed,
|
||||
- and passes the key and backend on to it. -}
|
||||
whenAnnexed :: (FilePath -> (Key, Backend Annex) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
|
||||
whenAnnexed :: (FilePath -> (Key, Backend) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
|
||||
whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
|
||||
|
||||
ifAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex a) -> Annex a -> Annex a
|
||||
ifAnnexed :: FilePath -> ((Key, Backend) -> Annex a) -> Annex a -> Annex a
|
||||
ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file
|
||||
|
||||
notBareRepo :: Annex a -> Annex a
|
||||
|
|
|
@ -21,6 +21,6 @@ seek = [withNumCopies $ \n -> whenAnnexed $ start n]
|
|||
|
||||
-- A copy is just a move that does not delete the source file.
|
||||
-- However, --auto mode avoids unnecessary copies.
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start numcopies file (key, backend) = autoCopies key (<) numcopies $
|
||||
Command.Move.start False file (key, backend)
|
||||
|
|
|
@ -24,7 +24,7 @@ def = [dontCheck fromOpt $ command "drop" paramPaths seek
|
|||
seek :: [CommandSeek]
|
||||
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
|
||||
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start numcopies file (key, _) = autoCopies key (>) numcopies $ do
|
||||
from <- Annex.getState Annex.fromremote
|
||||
case from of
|
||||
|
@ -41,7 +41,7 @@ startLocal file numcopies key = stopUnless (inAnnex key) $ do
|
|||
showStart "drop" file
|
||||
next $ performLocal key numcopies
|
||||
|
||||
startRemote :: FilePath -> Maybe Int -> Key -> Remote.Remote Annex -> CommandStart
|
||||
startRemote :: FilePath -> Maybe Int -> Key -> Remote -> CommandStart
|
||||
startRemote file numcopies key remote = do
|
||||
showStart "drop" file
|
||||
next $ performRemote key numcopies remote
|
||||
|
@ -55,7 +55,7 @@ performLocal key numcopies = lockContent key $ do
|
|||
whenM (inAnnex key) $ removeAnnex key
|
||||
next $ cleanupLocal key
|
||||
|
||||
performRemote :: Key -> Maybe Int -> Remote.Remote Annex -> CommandPerform
|
||||
performRemote :: Key -> Maybe Int -> Remote -> CommandPerform
|
||||
performRemote key numcopies remote = lockContent key $ do
|
||||
-- Filter the remote it's being dropped from out of the lists of
|
||||
-- places assumed to have the key, and places to check.
|
||||
|
@ -79,7 +79,7 @@ cleanupLocal key = do
|
|||
logStatus key InfoMissing
|
||||
return True
|
||||
|
||||
cleanupRemote :: Key -> Remote.Remote Annex -> Bool -> CommandCleanup
|
||||
cleanupRemote :: Key -> Remote -> Bool -> CommandCleanup
|
||||
cleanupRemote key remote ok = do
|
||||
-- better safe than sorry: assume the remote dropped the key
|
||||
-- even if it seemed to fail; the failure could have occurred
|
||||
|
@ -90,7 +90,7 @@ cleanupRemote key remote ok = do
|
|||
{- Checks specified remotes to verify that enough copies of a key exist to
|
||||
- allow it to be safely removed (with no data loss). Can be provided with
|
||||
- some locations where the key is known/assumed to be present. -}
|
||||
canDropKey :: Key -> Maybe Int -> [UUID] -> [Remote.Remote Annex] -> [UUID] -> Annex Bool
|
||||
canDropKey :: Key -> Maybe Int -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
|
||||
canDropKey key numcopiesM have check skip = do
|
||||
force <- Annex.getState Annex.force
|
||||
if force || numcopiesM == Just 0
|
||||
|
@ -99,7 +99,7 @@ canDropKey key numcopiesM have check skip = do
|
|||
need <- getNumCopies numcopiesM
|
||||
findCopies key need skip have check
|
||||
|
||||
findCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote.Remote Annex] -> Annex Bool
|
||||
findCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
|
||||
findCopies key need skip = helper []
|
||||
where
|
||||
helper bad have []
|
||||
|
@ -116,7 +116,7 @@ findCopies key need skip = helper []
|
|||
(False, Left _) -> helper (r:bad) have rs
|
||||
_ -> helper bad have rs
|
||||
|
||||
notEnoughCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote.Remote Annex] -> Annex Bool
|
||||
notEnoughCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
|
||||
notEnoughCopies key need have skip bad = do
|
||||
unsafe
|
||||
showLongNote $
|
||||
|
|
|
@ -24,7 +24,7 @@ def = [command "find" paramPaths seek "lists available files"]
|
|||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit $ whenAnnexed start]
|
||||
|
||||
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: FilePath -> (Key, Backend) -> CommandStart
|
||||
start file (key, _) = do
|
||||
-- only files inAnnex are shown, unless the user has requested
|
||||
-- others via a limit
|
||||
|
|
|
@ -20,7 +20,7 @@ seek :: [CommandSeek]
|
|||
seek = [withFilesInGit $ whenAnnexed start]
|
||||
|
||||
{- Fixes the symlink to an annexed file. -}
|
||||
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: FilePath -> (Key, Backend) -> CommandStart
|
||||
start file (key, _) = do
|
||||
link <- calcGitLink file key
|
||||
stopUnless ((/=) link <$> liftIO (readSymbolicLink file)) $ do
|
||||
|
|
|
@ -30,12 +30,12 @@ seek =
|
|||
, withBarePresentKeys startBare
|
||||
]
|
||||
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start numcopies file (key, backend) = do
|
||||
showStart "fsck" file
|
||||
next $ perform key file backend numcopies
|
||||
|
||||
perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform
|
||||
perform :: Key -> FilePath -> Backend -> Maybe Int -> CommandPerform
|
||||
perform key file backend numcopies = check
|
||||
-- order matters
|
||||
[ verifyLocationLog key file
|
||||
|
@ -64,7 +64,7 @@ startBare key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName ke
|
|||
{- Note that numcopies cannot be checked in a bare repository, because
|
||||
- getting the numcopies value requires a working copy with .gitattributes
|
||||
- files. -}
|
||||
performBare :: Key -> Backend Annex -> CommandPerform
|
||||
performBare :: Key -> Backend -> CommandPerform
|
||||
performBare key backend = check
|
||||
[ verifyLocationLog key (show key)
|
||||
, checkKeySize key
|
||||
|
@ -136,7 +136,7 @@ checkKeySize key = do
|
|||
return False
|
||||
|
||||
|
||||
checkBackend :: Backend Annex -> Key -> Annex Bool
|
||||
checkBackend :: Backend -> Key -> Annex Bool
|
||||
checkBackend = Types.Backend.fsckKey
|
||||
|
||||
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
|
||||
|
|
|
@ -21,7 +21,7 @@ def = [dontCheck fromOpt $ command "get" paramPaths seek
|
|||
seek :: [CommandSeek]
|
||||
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
|
||||
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
|
||||
autoCopies key (<) numcopies $ do
|
||||
from <- Annex.getState Annex.fromremote
|
||||
|
|
|
@ -42,7 +42,7 @@ start (name:ws) = do
|
|||
where
|
||||
config = Logs.Remote.keyValToConfig ws
|
||||
|
||||
perform :: R.RemoteType Annex -> UUID -> R.RemoteConfig -> CommandPerform
|
||||
perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform
|
||||
perform t u c = do
|
||||
c' <- R.setup t u c
|
||||
next $ cleanup u c'
|
||||
|
@ -77,7 +77,7 @@ remoteNames = do
|
|||
return $ mapMaybe (M.lookup nameKey . snd) $ M.toList m
|
||||
|
||||
{- find the specified remote type -}
|
||||
findType :: R.RemoteConfig -> Annex (R.RemoteType Annex)
|
||||
findType :: R.RemoteConfig -> Annex RemoteType
|
||||
findType config = maybe unspecified specified $ M.lookup typeKey config
|
||||
where
|
||||
unspecified = error "Specify the type of remote with type="
|
||||
|
|
|
@ -21,7 +21,7 @@ def = [command "migrate" paramPaths seek "switch data to different backend"]
|
|||
seek :: [CommandSeek]
|
||||
seek = [withBackendFilesInGit $ \(b, f) -> whenAnnexed (start b) f]
|
||||
|
||||
start :: Maybe (Backend Annex) -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: Maybe Backend -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start b file (key, oldbackend) = do
|
||||
exists <- inAnnex key
|
||||
newbackend <- choosebackend b
|
||||
|
@ -47,7 +47,7 @@ upgradableKey key = isNothing $ Types.Key.keySize key
|
|||
- backends that allow the filename to influence the keys they
|
||||
- generate.
|
||||
-}
|
||||
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
|
||||
perform :: FilePath -> Key -> Backend -> CommandPerform
|
||||
perform file oldkey newbackend = do
|
||||
src <- inRepo $ gitAnnexLocation oldkey
|
||||
tmp <- fromRepo gitAnnexTmpDir
|
||||
|
|
|
@ -23,7 +23,7 @@ def = [dontCheck toOpt $ dontCheck fromOpt $
|
|||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit $ whenAnnexed $ start True]
|
||||
|
||||
start :: Bool -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: Bool -> FilePath -> (Key, Backend) -> CommandStart
|
||||
start move file (key, _) = do
|
||||
noAuto
|
||||
to <- Annex.getState Annex.toremote
|
||||
|
@ -54,7 +54,7 @@ showMoveAction False file = showStart "copy" file
|
|||
- A file's content can be moved even if there are insufficient copies to
|
||||
- allow it to be dropped.
|
||||
-}
|
||||
toStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
|
||||
toStart :: Remote -> Bool -> FilePath -> Key -> CommandStart
|
||||
toStart dest move file key = do
|
||||
u <- getUUID
|
||||
ishere <- inAnnex key
|
||||
|
@ -63,7 +63,7 @@ toStart dest move file key = do
|
|||
else do
|
||||
showMoveAction move file
|
||||
next $ toPerform dest move key
|
||||
toPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
|
||||
toPerform :: Remote -> Bool -> Key -> CommandPerform
|
||||
toPerform dest move key = moveLock move key $ do
|
||||
-- Checking the remote is expensive, so not done in the start step.
|
||||
-- In fast mode, location tracking is assumed to be correct,
|
||||
|
@ -105,7 +105,7 @@ toPerform dest move key = moveLock move key $ do
|
|||
- If the current repository already has the content, it is still removed
|
||||
- from the remote.
|
||||
-}
|
||||
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
|
||||
fromStart :: Remote -> Bool -> FilePath -> Key -> CommandStart
|
||||
fromStart src move file key
|
||||
| move = go
|
||||
| otherwise = stopUnless (not <$> inAnnex key) go
|
||||
|
@ -113,12 +113,12 @@ fromStart src move file key
|
|||
go = stopUnless (fromOk src key) $ do
|
||||
showMoveAction move file
|
||||
next $ fromPerform src move key
|
||||
fromOk :: Remote.Remote Annex -> Key -> Annex Bool
|
||||
fromOk :: Remote -> Key -> Annex Bool
|
||||
fromOk src key = do
|
||||
u <- getUUID
|
||||
remotes <- Remote.keyPossibilities key
|
||||
return $ u /= Remote.uuid src && any (== src) remotes
|
||||
fromPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
|
||||
fromPerform :: Remote -> Bool -> Key -> CommandPerform
|
||||
fromPerform src move key = moveLock move key $ do
|
||||
ishere <- inAnnex key
|
||||
if ishere
|
||||
|
|
|
@ -33,7 +33,7 @@ start (src:dest:[])
|
|||
next $ whenAnnexed (perform src) dest
|
||||
start _ = error "specify a src file and a dest file"
|
||||
|
||||
perform :: FilePath -> FilePath -> (Key, Backend Annex) -> CommandPerform
|
||||
perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
|
||||
perform src _dest (key, backend) = do
|
||||
unlessM move $ error "mv failed!"
|
||||
next $ cleanup key backend
|
||||
|
@ -45,7 +45,7 @@ perform src _dest (key, backend) = do
|
|||
move = getViaTmp key $ \tmp ->
|
||||
liftIO $ boolSystem "mv" [File src, File tmp]
|
||||
|
||||
cleanup :: Key -> Backend Annex -> CommandCleanup
|
||||
cleanup :: Key -> Backend -> CommandCleanup
|
||||
cleanup key backend = do
|
||||
logStatus key InfoPresent
|
||||
|
||||
|
|
|
@ -47,10 +47,10 @@ seek rs = do
|
|||
syncBranch :: Git.Ref -> Git.Ref
|
||||
syncBranch = Git.Ref.under "refs/heads/synced/"
|
||||
|
||||
remoteBranch :: Remote.Remote Annex -> Git.Ref -> Git.Ref
|
||||
remoteBranch :: Remote -> Git.Ref -> Git.Ref
|
||||
remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote
|
||||
|
||||
syncRemotes :: [String] -> Annex [Remote.Remote Annex]
|
||||
syncRemotes :: [String] -> Annex [Remote]
|
||||
syncRemotes rs = do
|
||||
fast <- Annex.getState Annex.fast
|
||||
if fast
|
||||
|
@ -106,7 +106,7 @@ updateBranch syncbranch =
|
|||
, Param $ show $ Git.Ref.base syncbranch
|
||||
]
|
||||
|
||||
pullRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
|
||||
pullRemote :: Remote -> Git.Ref -> CommandStart
|
||||
pullRemote remote branch = do
|
||||
showStart "pull" (Remote.name remote)
|
||||
next $ do
|
||||
|
@ -121,13 +121,13 @@ pullRemote remote branch = do
|
|||
- Which to merge from? Well, the master has whatever latest changes
|
||||
- were committed, while the synced/master may have changes that some
|
||||
- other remote synced to this remote. So, merge them both. -}
|
||||
mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandCleanup
|
||||
mergeRemote :: Remote -> Git.Ref -> CommandCleanup
|
||||
mergeRemote remote branch = all id <$> (mapM merge =<< tomerge)
|
||||
where
|
||||
merge = mergeFrom . remoteBranch remote
|
||||
tomerge = filterM (changed remote) [branch, syncBranch branch]
|
||||
|
||||
pushRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
|
||||
pushRemote :: Remote -> Git.Ref -> CommandStart
|
||||
pushRemote remote branch = go =<< needpush
|
||||
where
|
||||
needpush = anyM (newer remote) [syncbranch, Annex.Branch.name]
|
||||
|
@ -154,7 +154,7 @@ mergeFrom branch = do
|
|||
showOutput
|
||||
inRepo $ Git.Command.runBool "merge" [Param $ show branch]
|
||||
|
||||
changed :: Remote.Remote Annex -> Git.Ref -> Annex Bool
|
||||
changed :: Remote -> Git.Ref -> Annex Bool
|
||||
changed remote b = do
|
||||
let r = remoteBranch remote b
|
||||
e <- inRepo $ Git.Ref.exists r
|
||||
|
@ -162,7 +162,7 @@ changed remote b = do
|
|||
then inRepo $ Git.Branch.changed b r
|
||||
else return False
|
||||
|
||||
newer :: Remote.Remote Annex -> Git.Ref -> Annex Bool
|
||||
newer :: Remote -> Git.Ref -> Annex Bool
|
||||
newer remote b = do
|
||||
let r = remoteBranch remote b
|
||||
e <- inRepo $ Git.Ref.exists r
|
||||
|
|
|
@ -22,7 +22,7 @@ def = [command "unannex" paramPaths seek "undo accidential add command"]
|
|||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit $ whenAnnexed start]
|
||||
|
||||
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: FilePath -> (Key, Backend) -> CommandStart
|
||||
start file (key, _) = stopUnless (inAnnex key) $ do
|
||||
showStart "unannex" file
|
||||
next $ perform file key
|
||||
|
|
|
@ -36,7 +36,7 @@ check = do
|
|||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit $ whenAnnexed startUnannex, withNothing start]
|
||||
|
||||
startUnannex :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
startUnannex :: FilePath -> (Key, Backend) -> CommandStart
|
||||
startUnannex file info = do
|
||||
-- Force fast mode before running unannex. This way, if multiple
|
||||
-- files link to a key, it will be left in the annex and hardlinked
|
||||
|
|
|
@ -26,7 +26,7 @@ seek = [withFilesInGit $ whenAnnexed start]
|
|||
|
||||
{- The unlock subcommand replaces the symlink with a copy of the file's
|
||||
- content. -}
|
||||
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: FilePath -> (Key, Backend) -> CommandStart
|
||||
start file (key, _) = do
|
||||
showStart "unlock" file
|
||||
next $ perform file key
|
||||
|
|
|
@ -66,7 +66,7 @@ checkRemoteUnused name = do
|
|||
checkRemoteUnused' =<< Remote.byName name
|
||||
next $ return True
|
||||
|
||||
checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
|
||||
checkRemoteUnused' :: Remote -> Annex ()
|
||||
checkRemoteUnused' r = do
|
||||
showAction "checking for unused data"
|
||||
remotehas <- loggedKeysFor (Remote.uuid r)
|
||||
|
@ -112,14 +112,14 @@ unusedMsg' u header trailer = unlines $
|
|||
["(To see where data was previously used, try: git log --stat -S'KEY')"] ++
|
||||
trailer
|
||||
|
||||
remoteUnusedMsg :: Remote.Remote Annex -> [(Int, Key)] -> String
|
||||
remoteUnusedMsg :: Remote -> [(Int, Key)] -> String
|
||||
remoteUnusedMsg r u = unusedMsg' u
|
||||
["Some annexed data on " ++ name ++ " is not used by any files:"]
|
||||
[dropMsg $ Just r]
|
||||
where
|
||||
name = Remote.name r
|
||||
|
||||
dropMsg :: Maybe (Remote.Remote Annex) -> String
|
||||
dropMsg :: Maybe Remote -> String
|
||||
dropMsg Nothing = dropMsg' ""
|
||||
dropMsg (Just r) = dropMsg' $ " --from " ++ Remote.name r
|
||||
dropMsg' :: String -> String
|
||||
|
|
|
@ -20,7 +20,7 @@ def = [command "whereis" paramPaths seek
|
|||
seek :: [CommandSeek]
|
||||
seek = [withFilesInGit $ whenAnnexed start]
|
||||
|
||||
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||
start :: FilePath -> (Key, Backend) -> CommandStart
|
||||
start file (key, _) = do
|
||||
showStart "whereis" file
|
||||
next $ perform key
|
||||
|
|
24
Remote.hs
24
Remote.hs
|
@ -54,7 +54,7 @@ import qualified Remote.Rsync
|
|||
import qualified Remote.Web
|
||||
import qualified Remote.Hook
|
||||
|
||||
remoteTypes :: [RemoteType Annex]
|
||||
remoteTypes :: [RemoteType]
|
||||
remoteTypes =
|
||||
[ Remote.Git.remote
|
||||
, Remote.S3.remote
|
||||
|
@ -67,7 +67,7 @@ remoteTypes =
|
|||
|
||||
{- Builds a list of all available Remotes.
|
||||
- Since doing so can be expensive, the list is cached. -}
|
||||
remoteList :: Annex [Remote Annex]
|
||||
remoteList :: Annex [Remote]
|
||||
remoteList = do
|
||||
rs <- Annex.getState Annex.remotes
|
||||
if null rs
|
||||
|
@ -87,7 +87,7 @@ remoteList = do
|
|||
generate t r u (M.lookup u m)
|
||||
|
||||
{- All remotes that are not ignored. -}
|
||||
enabledRemoteList :: Annex [Remote Annex]
|
||||
enabledRemoteList :: Annex [Remote]
|
||||
enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
|
||||
|
||||
{- Map of UUIDs of Remotes and their names. -}
|
||||
|
@ -96,13 +96,13 @@ remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> remoteList
|
|||
|
||||
{- Looks up a remote by name. (Or by UUID.) Only finds currently configured
|
||||
- git remotes. -}
|
||||
byName :: String -> Annex (Remote Annex)
|
||||
byName :: String -> Annex (Remote)
|
||||
byName n = do
|
||||
res <- byName' n
|
||||
case res of
|
||||
Left e -> error e
|
||||
Right r -> return r
|
||||
byName' :: String -> Annex (Either String (Remote Annex))
|
||||
byName' :: String -> Annex (Either String Remote)
|
||||
byName' "" = return $ Left "no remote specified"
|
||||
byName' n = do
|
||||
match <- filter matching <$> remoteList
|
||||
|
@ -168,16 +168,16 @@ prettyPrintUUIDs desc uuids = do
|
|||
]
|
||||
|
||||
{- Filters a list of remotes to ones that have the listed uuids. -}
|
||||
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
|
||||
remotesWithUUID :: [Remote] -> [UUID] -> [Remote]
|
||||
remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
|
||||
|
||||
{- Filters a list of remotes to ones that do not have the listed uuids. -}
|
||||
remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
|
||||
remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote]
|
||||
remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
|
||||
|
||||
{- Cost ordered lists of remotes that the Logs.Location indicate may have a key.
|
||||
-}
|
||||
keyPossibilities :: Key -> Annex [Remote Annex]
|
||||
keyPossibilities :: Key -> Annex [Remote]
|
||||
keyPossibilities key = fst <$> keyPossibilities' False key
|
||||
|
||||
{- Cost ordered lists of remotes that the Logs.Location indicate may have a key.
|
||||
|
@ -185,10 +185,10 @@ keyPossibilities key = fst <$> keyPossibilities' False key
|
|||
- Also returns a list of UUIDs that are trusted to have the key
|
||||
- (some may not have configured remotes).
|
||||
-}
|
||||
keyPossibilitiesTrusted :: Key -> Annex ([Remote Annex], [UUID])
|
||||
keyPossibilitiesTrusted :: Key -> Annex ([Remote], [UUID])
|
||||
keyPossibilitiesTrusted = keyPossibilities' True
|
||||
|
||||
keyPossibilities' :: Bool -> Key -> Annex ([Remote Annex], [UUID])
|
||||
keyPossibilities' :: Bool -> Key -> Annex ([Remote], [UUID])
|
||||
keyPossibilities' withtrusted key = do
|
||||
u <- getUUID
|
||||
trusted <- if withtrusted then trustGet Trusted else return []
|
||||
|
@ -224,7 +224,7 @@ showLocations key exclude = do
|
|||
message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
|
||||
message rs us = message rs [] ++ message [] us
|
||||
|
||||
showTriedRemotes :: [Remote Annex] -> Annex ()
|
||||
showTriedRemotes :: [Remote] -> Annex ()
|
||||
showTriedRemotes [] = return ()
|
||||
showTriedRemotes remotes =
|
||||
showLongNote $ "Unable to access these remotes: " ++
|
||||
|
@ -240,7 +240,7 @@ forceTrust level remotename = do
|
|||
- in the local repo, not on the remote. The process of transferring the
|
||||
- key to the remote, or removing the key from it *may* log the change
|
||||
- on the remote, but this cannot always be relied on. -}
|
||||
logStatus :: Remote Annex -> Key -> Bool -> Annex ()
|
||||
logStatus :: Remote -> Key -> Bool -> Annex ()
|
||||
logStatus remote key present = logChange key (uuid remote) status
|
||||
where
|
||||
status = if present then InfoPresent else InfoMissing
|
||||
|
|
|
@ -26,7 +26,7 @@ import Crypto
|
|||
|
||||
type BupRepo = String
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "bup",
|
||||
enumerate = findSpecialRemotes "buprepo",
|
||||
|
@ -34,7 +34,7 @@ remote = RemoteType {
|
|||
setup = bupSetup
|
||||
}
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||
gen r u c = do
|
||||
buprepo <- getConfig r "buprepo" (error "missing buprepo")
|
||||
cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost)
|
||||
|
|
|
@ -20,7 +20,7 @@ import Remote.Helper.Special
|
|||
import Remote.Helper.Encryptable
|
||||
import Crypto
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "directory",
|
||||
enumerate = findSpecialRemotes "directory",
|
||||
|
@ -28,7 +28,7 @@ remote = RemoteType {
|
|||
setup = directorySetup
|
||||
}
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||
gen r u c = do
|
||||
dir <- getConfig r "directory" (error "missing directory")
|
||||
cst <- remoteCost r cheapRemoteCost
|
||||
|
|
|
@ -28,7 +28,7 @@ import Utility.TempFile
|
|||
import Config
|
||||
import Init
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "git",
|
||||
enumerate = list,
|
||||
|
@ -50,7 +50,7 @@ list = do
|
|||
Git.Construct.remoteNamed n $
|
||||
Git.Construct.fromRemoteLocation url g
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||
gen r u _ = do
|
||||
{- It's assumed to be cheap to read the config of non-URL remotes,
|
||||
- so this is done each time git-annex is run. Conversely,
|
||||
|
|
|
@ -41,8 +41,8 @@ encryptableRemote
|
|||
:: Maybe RemoteConfig
|
||||
-> ((Cipher, Key) -> Key -> Annex Bool)
|
||||
-> ((Cipher, Key) -> FilePath -> Annex Bool)
|
||||
-> Remote Annex
|
||||
-> Remote Annex
|
||||
-> Remote
|
||||
-> Remote
|
||||
encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
|
||||
r {
|
||||
storeKey = store,
|
||||
|
|
|
@ -20,7 +20,7 @@ import Remote.Helper.Special
|
|||
import Remote.Helper.Encryptable
|
||||
import Crypto
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "hook",
|
||||
enumerate = findSpecialRemotes "hooktype",
|
||||
|
@ -28,7 +28,7 @@ remote = RemoteType {
|
|||
setup = hookSetup
|
||||
}
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||
gen r u c = do
|
||||
hooktype <- getConfig r "hooktype" (error "missing hooktype")
|
||||
cst <- remoteCost r expensiveRemoteCost
|
||||
|
|
|
@ -27,7 +27,7 @@ data RsyncOpts = RsyncOpts {
|
|||
rsyncOptions :: [CommandParam]
|
||||
}
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "rsync",
|
||||
enumerate = findSpecialRemotes "rsyncurl",
|
||||
|
@ -35,7 +35,7 @@ remote = RemoteType {
|
|||
setup = rsyncSetup
|
||||
}
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||
gen r u c = do
|
||||
o <- genRsyncOpts r
|
||||
cst <- remoteCost r expensiveRemoteCost
|
||||
|
|
|
@ -28,7 +28,7 @@ import Crypto
|
|||
import Annex.Content
|
||||
import Utility.Base64
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "S3",
|
||||
enumerate = findSpecialRemotes "s3",
|
||||
|
@ -36,11 +36,11 @@ remote = RemoteType {
|
|||
setup = s3Setup
|
||||
}
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||
gen r u c = do
|
||||
cst <- remoteCost r expensiveRemoteCost
|
||||
return $ gen' r u c cst
|
||||
gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote Annex
|
||||
gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote
|
||||
gen' r u c cst =
|
||||
encryptableRemote c
|
||||
(storeEncrypted this)
|
||||
|
@ -111,13 +111,13 @@ s3Setup u c = handlehost $ M.lookup "host" c
|
|||
-- be human-readable
|
||||
M.delete "bucket" defaults
|
||||
|
||||
store :: Remote Annex -> Key -> Annex Bool
|
||||
store :: Remote -> Key -> Annex Bool
|
||||
store r k = s3Action r False $ \(conn, bucket) -> do
|
||||
dest <- inRepo $ gitAnnexLocation k
|
||||
res <- liftIO $ storeHelper (conn, bucket) r k dest
|
||||
s3Bool res
|
||||
|
||||
storeEncrypted :: Remote Annex -> (Cipher, Key) -> Key -> Annex Bool
|
||||
storeEncrypted :: Remote -> (Cipher, Key) -> Key -> Annex Bool
|
||||
storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
|
||||
-- To get file size of the encrypted content, have to use a temp file.
|
||||
-- (An alternative would be chunking to to a constant size.)
|
||||
|
@ -127,7 +127,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
|
|||
res <- liftIO $ storeHelper (conn, bucket) r enck tmp
|
||||
s3Bool res
|
||||
|
||||
storeHelper :: (AWSConnection, String) -> Remote Annex -> Key -> FilePath -> IO (AWSResult ())
|
||||
storeHelper :: (AWSConnection, String) -> Remote -> Key -> FilePath -> IO (AWSResult ())
|
||||
storeHelper (conn, bucket) r k file = do
|
||||
content <- liftIO $ L.readFile file
|
||||
-- size is provided to S3 so the whole content does not need to be
|
||||
|
@ -149,7 +149,7 @@ storeHelper (conn, bucket) r k file = do
|
|||
xheaders = filter isxheader $ M.assocs $ fromJust $ config r
|
||||
isxheader (h, _) = "x-amz-" `isPrefixOf` h
|
||||
|
||||
retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool
|
||||
retrieve :: Remote -> Key -> FilePath -> Annex Bool
|
||||
retrieve r k f = s3Action r False $ \(conn, bucket) -> do
|
||||
res <- liftIO $ getObject conn $ bucketKey r bucket k
|
||||
case res of
|
||||
|
@ -158,7 +158,7 @@ retrieve r k f = s3Action r False $ \(conn, bucket) -> do
|
|||
return True
|
||||
Left e -> s3Warning e
|
||||
|
||||
retrieveEncrypted :: Remote Annex -> (Cipher, Key) -> FilePath -> Annex Bool
|
||||
retrieveEncrypted :: Remote -> (Cipher, Key) -> FilePath -> Annex Bool
|
||||
retrieveEncrypted r (cipher, enck) f = s3Action r False $ \(conn, bucket) -> do
|
||||
res <- liftIO $ getObject conn $ bucketKey r bucket enck
|
||||
case res of
|
||||
|
@ -168,12 +168,12 @@ retrieveEncrypted r (cipher, enck) f = s3Action r False $ \(conn, bucket) -> do
|
|||
return True
|
||||
Left e -> s3Warning e
|
||||
|
||||
remove :: Remote Annex -> Key -> Annex Bool
|
||||
remove :: Remote -> Key -> Annex Bool
|
||||
remove r k = s3Action r False $ \(conn, bucket) -> do
|
||||
res <- liftIO $ deleteObject conn $ bucketKey r bucket k
|
||||
s3Bool res
|
||||
|
||||
checkPresent :: Remote Annex -> Key -> Annex (Either String Bool)
|
||||
checkPresent :: Remote -> Key -> Annex (Either String Bool)
|
||||
checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
|
||||
showAction $ "checking " ++ name r
|
||||
res <- liftIO $ getObjectInfo conn $ bucketKey r bucket k
|
||||
|
@ -196,7 +196,7 @@ s3Bool :: AWSResult () -> Annex Bool
|
|||
s3Bool (Right _) = return True
|
||||
s3Bool (Left e) = s3Warning e
|
||||
|
||||
s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
|
||||
s3Action :: Remote -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
|
||||
s3Action r noconn action = do
|
||||
when (isNothing $ config r) $
|
||||
error $ "Missing configuration for special remote " ++ name r
|
||||
|
@ -206,14 +206,14 @@ s3Action r noconn action = do
|
|||
(Just b, Just c) -> action (c, b)
|
||||
_ -> return noconn
|
||||
|
||||
bucketFile :: Remote Annex -> Key -> FilePath
|
||||
bucketFile :: Remote -> Key -> FilePath
|
||||
bucketFile r = munge . show
|
||||
where
|
||||
munge s = case M.lookup "mungekeys" $ fromJust $ config r of
|
||||
Just "ia" -> iaMunge s
|
||||
_ -> s
|
||||
|
||||
bucketKey :: Remote Annex -> String -> Key -> S3Object
|
||||
bucketKey :: Remote -> String -> Key -> S3Object
|
||||
bucketKey r bucket k = S3Object bucket (bucketFile r k) "" [] L.empty
|
||||
|
||||
{- Internet Archive limits filenames to a subset of ascii,
|
||||
|
|
|
@ -4,7 +4,7 @@ module Remote.S3 (remote) where
|
|||
import Types.Remote
|
||||
import Types
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "S3",
|
||||
enumerate = return [],
|
||||
|
|
|
@ -15,7 +15,7 @@ import Config
|
|||
import Logs.Web
|
||||
import qualified Utility.Url as Url
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
typename = "web",
|
||||
enumerate = list,
|
||||
|
@ -31,7 +31,7 @@ list = do
|
|||
r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
|
||||
return [r]
|
||||
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||
gen r _ _ =
|
||||
return Remote {
|
||||
uuid = webUUID,
|
||||
|
|
9
Types.hs
9
Types.hs
|
@ -9,10 +9,17 @@ module Types (
|
|||
Annex,
|
||||
Backend,
|
||||
Key,
|
||||
UUID(..)
|
||||
UUID(..),
|
||||
Remote,
|
||||
RemoteType
|
||||
) where
|
||||
|
||||
import Annex
|
||||
import Types.Backend
|
||||
import Types.Key
|
||||
import Types.UUID
|
||||
import Types.Remote
|
||||
|
||||
type Backend = BackendA Annex
|
||||
type Remote = RemoteA Annex
|
||||
type RemoteType = RemoteTypeA Annex
|
||||
|
|
|
@ -11,7 +11,7 @@ module Types.Backend where
|
|||
|
||||
import Types.Key
|
||||
|
||||
data Backend a = Backend {
|
||||
data BackendA a = Backend {
|
||||
-- name of this backend
|
||||
name :: String,
|
||||
-- converts a filename to a key
|
||||
|
@ -20,8 +20,8 @@ data Backend a = Backend {
|
|||
fsckKey :: Key -> a Bool
|
||||
}
|
||||
|
||||
instance Show (Backend a) where
|
||||
instance Show (BackendA a) where
|
||||
show backend = "Backend { name =\"" ++ name backend ++ "\" }"
|
||||
|
||||
instance Eq (Backend a) where
|
||||
instance Eq (BackendA a) where
|
||||
a == b = name a == name b
|
||||
|
|
|
@ -19,22 +19,22 @@ import Types.UUID
|
|||
type RemoteConfig = M.Map String String
|
||||
|
||||
{- There are different types of remotes. -}
|
||||
data RemoteType a = RemoteType {
|
||||
data RemoteTypeA a = RemoteType {
|
||||
-- human visible type name
|
||||
typename :: String,
|
||||
-- enumerates remotes of this type
|
||||
enumerate :: a [Git.Repo],
|
||||
-- generates a remote of this type
|
||||
generate :: Git.Repo -> UUID -> Maybe RemoteConfig -> a (Remote a),
|
||||
generate :: Git.Repo -> UUID -> Maybe RemoteConfig -> a (RemoteA a),
|
||||
-- initializes or changes a remote
|
||||
setup :: UUID -> RemoteConfig -> a RemoteConfig
|
||||
}
|
||||
|
||||
instance Eq (RemoteType a) where
|
||||
instance Eq (RemoteTypeA a) where
|
||||
x == y = typename x == typename y
|
||||
|
||||
{- An individual remote. -}
|
||||
data Remote a = Remote {
|
||||
data RemoteA a = Remote {
|
||||
-- each Remote has a unique uuid
|
||||
uuid :: UUID,
|
||||
-- each Remote has a human visible name
|
||||
|
@ -58,16 +58,16 @@ data Remote a = Remote {
|
|||
-- git configuration for the remote
|
||||
repo :: Git.Repo,
|
||||
-- the type of the remote
|
||||
remotetype :: RemoteType a
|
||||
remotetype :: RemoteTypeA a
|
||||
}
|
||||
|
||||
instance Show (Remote a) where
|
||||
instance Show (RemoteA a) where
|
||||
show remote = "Remote { name =\"" ++ name remote ++ "\" }"
|
||||
|
||||
-- two remotes are the same if they have the same uuid
|
||||
instance Eq (Remote a) where
|
||||
instance Eq (RemoteA a) where
|
||||
x == y = uuid x == uuid y
|
||||
|
||||
-- order remotes by cost
|
||||
instance Ord (Remote a) where
|
||||
instance Ord (RemoteA a) where
|
||||
compare = comparing cost
|
||||
|
|
|
@ -33,7 +33,7 @@ keyFile0 :: Key -> FilePath
|
|||
keyFile0 = Upgrade.V1.keyFile1
|
||||
fileKey0 :: FilePath -> Key
|
||||
fileKey0 = Upgrade.V1.fileKey1
|
||||
lookupFile0 :: FilePath -> Annex (Maybe (Key, Backend Annex))
|
||||
lookupFile0 :: FilePath -> Annex (Maybe (Key, Backend))
|
||||
lookupFile0 = Upgrade.V1.lookupFile1
|
||||
|
||||
getKeysPresent0 :: FilePath -> Annex [Key]
|
||||
|
|
|
@ -181,7 +181,7 @@ writeLog1 file ls = viaTmp writeFile file (showLog ls)
|
|||
readLog1 :: FilePath -> IO [LogLine]
|
||||
readLog1 file = catchDefaultIO (parseLog <$> readFileStrict file) []
|
||||
|
||||
lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend Annex))
|
||||
lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend))
|
||||
lookupFile1 file = do
|
||||
tl <- liftIO $ try getsymlink
|
||||
case tl of
|
||||
|
|
10
test.hs
10
test.hs
|
@ -850,7 +850,7 @@ checklocationlog f expected = do
|
|||
expected (thisuuid `elem` uuids)
|
||||
_ -> assertFailure $ f ++ " failed to look up key"
|
||||
|
||||
checkbackend :: FilePath -> Types.Backend Types.Annex -> Assertion
|
||||
checkbackend :: FilePath -> Types.Backend -> Assertion
|
||||
checkbackend file expected = do
|
||||
r <- annexeval $ Backend.lookupFile file
|
||||
let b = snd $ fromJust r
|
||||
|
@ -936,14 +936,14 @@ changecontent f = writeFile f $ changedcontent f
|
|||
changedcontent :: FilePath -> String
|
||||
changedcontent f = (content f) ++ " (modified)"
|
||||
|
||||
backendSHA1 :: Types.Backend Types.Annex
|
||||
backendSHA1 :: Types.Backend
|
||||
backendSHA1 = backend_ "SHA1"
|
||||
|
||||
backendSHA256 :: Types.Backend Types.Annex
|
||||
backendSHA256 :: Types.Backend
|
||||
backendSHA256 = backend_ "SHA256"
|
||||
|
||||
backendWORM :: Types.Backend Types.Annex
|
||||
backendWORM :: Types.Backend
|
||||
backendWORM = backend_ "WORM"
|
||||
|
||||
backend_ :: String -> Types.Backend Types.Annex
|
||||
backend_ :: String -> Types.Backend
|
||||
backend_ name = Backend.lookupBackendName name
|
||||
|
|
Loading…
Reference in a new issue