diff options
38 files changed, 129 insertions, 122 deletions
@@ -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 diff --git a/Backend.hs b/Backend.hs index 2f788fcd0..003d62bfc 100644 --- a/Backend.hs +++ b/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 diff --git a/Backend/SHA.hs b/Backend/SHA.hs index eca312944..a1124dfe2 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -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 diff --git a/Backend/URL.hs b/Backend/URL.hs index 32a72335a..7f621b00f 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -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) diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 5a3e2d694..ae9833e30 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -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) diff --git a/Command.hs b/Command.hs index 813a239cb..dea6a97a3 100644 --- a/Command.hs +++ b/Command.hs @@ -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 diff --git a/Command/Copy.hs b/Command/Copy.hs index 16de423ac..77beb4b4f 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -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) diff --git a/Command/Drop.hs b/Command/Drop.hs index 0a4c9dfd6..89e7c8e42 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -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 $ diff --git a/Command/Find.hs b/Command/Find.hs index 1961e6b74..0c96369ee 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -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 diff --git a/Command/Fix.hs b/Command/Fix.hs index f264106c3..c4f981381 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -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 diff --git a/Command/Fsck.hs b/Command/Fsck.hs index a803207e2..4e83455e1 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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 diff --git a/Command/Get.hs b/Command/Get.hs index b7023e2de..f2b70baeb 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -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 diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 1e6bc2ef1..698d60455 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -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=" diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 8778743ff..f6467463d 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -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 diff --git a/Command/Move.hs b/Command/Move.hs index 85fdff739..bd1490b0c 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -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 diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 0648e90fc..480806e11 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -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 diff --git a/Command/Sync.hs b/Command/Sync.hs index 9426b1c00..759df36ea 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -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 diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 66611cbd7..fee67429d 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -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 diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 21ad4c7df..cef89a5cf 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -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 diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 673a7038a..afee10145 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -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 diff --git a/Command/Unused.hs b/Command/Unused.hs index ef398b01e..8d45c51cb 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -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 diff --git a/Command/Whereis.hs b/Command/Whereis.hs index eb2ae3d4e..9e57f361b 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -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 @@ -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 diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 9311d18e5..04cd49026 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -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) diff --git a/Remote/Directory.hs b/Remote/Directory.hs index e1b17c241..8ca2a2875 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -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 diff --git a/Remote/Git.hs b/Remote/Git.hs index 2f2be5bee..e790d01a7 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -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, diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 99f48fe7b..3abea7bc6 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -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, diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 08be1a0ee..6c4a044ac 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -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 diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 91a72e88e..2fe302ba5 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -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 diff --git a/Remote/S3real.hs b/Remote/S3real.hs index 23a589726..bef89b553 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -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, diff --git a/Remote/S3stub.hs b/Remote/S3stub.hs index d91a222e8..31e8a339e 100644 --- a/Remote/S3stub.hs +++ b/Remote/S3stub.hs @@ -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 [], diff --git a/Remote/Web.hs b/Remote/Web.hs index c0d54132a..93e5770f0 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -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,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 diff --git a/Types/Backend.hs b/Types/Backend.hs index 4f8226704..c9daa4671 100644 --- a/Types/Backend.hs +++ b/Types/Backend.hs @@ -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 diff --git a/Types/Remote.hs b/Types/Remote.hs index 3a8a23f31..e44e2a9de 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -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 diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs index eae5c87ce..c5310c641 100644 --- a/Upgrade/V0.hs +++ b/Upgrade/V0.hs @@ -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] diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 80554dc3b..add50fcf3 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -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 @@ -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 |