diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/Add.hs | 4 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 3 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 8 | ||||
| -rw-r--r-- | Command/Fsck.hs | 20 | ||||
| -rw-r--r-- | Command/Map.hs | 3 | ||||
| -rw-r--r-- | Command/Migrate.hs | 7 | ||||
| -rw-r--r-- | Command/SendKey.hs | 3 | ||||
| -rw-r--r-- | Command/Unannex.hs | 16 | ||||
| -rw-r--r-- | Command/Uninit.hs | 17 | ||||
| -rw-r--r-- | Command/Unlock.hs | 5 | ||||
| -rw-r--r-- | Command/Unused.hs | 20 |
11 files changed, 46 insertions, 60 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index a633db7b3..ab104b53c 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -60,8 +60,8 @@ undo file key e = do -- fromAnnex could fail if the file ownership is weird tryharder :: IOException -> Annex () tryharder _ = do - g <- gitRepo - liftIO $ renameFile (gitAnnexLocation g key) file + src <- fromRepo $ gitAnnexLocation key + liftIO $ renameFile src file cleanup :: FilePath -> Key -> Bool -> CommandCleanup cleanup file key hascontent = do diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index b717e271d..945848e9f 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -41,10 +41,9 @@ perform url file = do download :: String -> FilePath -> CommandPerform download url file = do - g <- gitRepo showAction $ "downloading " ++ url ++ " " let dummykey = Backend.URL.fromUrl url - let tmp = gitAnnexTmpLocation g dummykey + tmp <- fromRepo $ gitAnnexTmpLocation dummykey liftIO $ createDirectoryIfMissing True (parentDir tmp) ok <- liftIO $ Url.download url tmp if ok diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 70dcc4cc7..55c21f83b 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -58,17 +58,15 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote next $ Command.Drop.cleanupRemote key r droplocal = Command.Drop.performLocal key (Just 0) -- force drop -performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform +performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther filespec key = do - g <- gitRepo - let f = filespec g key + f <- fromRepo $ filespec key liftIO $ whenM (doesFileExist f) $ removeFile f next $ return True readUnusedLog :: FilePath -> Annex UnusedMap readUnusedLog prefix = do - g <- gitRepo - let f = gitAnnexUnusedLog prefix g + f <- fromRepo $ gitAnnexUnusedLog prefix e <- liftIO $ doesFileExist f if e then M.fromList . map parse . lines <$> liftIO (readFile f) diff --git a/Command/Fsck.hs b/Command/Fsck.hs index d1abb29e3..3feabeb9e 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -79,26 +79,26 @@ check = sequence >=> dispatch in this repository only. -} verifyLocationLog :: Key -> String -> Annex Bool verifyLocationLog key desc = do - g <- gitRepo present <- inAnnex key -- Since we're checking that a key's file is present, throw -- in a permission fixup here too. - when present $ liftIO $ do - let f = gitAnnexLocation g key - preventWrite f - preventWrite (parentDir f) + when present $ do + f <- fromRepo $ gitAnnexLocation key + liftIO $ do + preventWrite f + preventWrite (parentDir f) u <- getUUID uuids <- keyLocations key case (present, u `elem` uuids) of (True, False) -> do - fix g u InfoPresent + fix u InfoPresent -- There is no data loss, so do not fail. return True (False, True) -> do - fix g u InfoMissing + fix u InfoMissing warning $ "** Based on the location log, " ++ desc ++ "\n** was expected to be present, " ++ @@ -107,16 +107,16 @@ verifyLocationLog key desc = do _ -> return True where - fix g u s = do + fix u s = do showNote "fixing location log" + g <- gitRepo logChange g key u s {- The size of the data for a key is checked against the size encoded in - the key's metadata, if available. -} checkKeySize :: Key -> Annex Bool checkKeySize key = do - g <- gitRepo - let file = gitAnnexLocation g key + file <- fromRepo $ gitAnnexLocation key present <- liftIO $ doesFileExist file case (present, Types.Key.keySize key) of (_, Nothing) -> return True diff --git a/Command/Map.hs b/Command/Map.hs index 11808ed63..f72cb107a 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -31,8 +31,7 @@ seek = [withNothing start] start :: CommandStart start = do - g <- gitRepo - rs <- spider g + rs <- spider =<< gitRepo umap <- uuidMap trusted <- trustGet Trusted diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 2d4d24a22..a823466dc 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -42,14 +42,13 @@ upgradableKey key = isNothing $ Types.Key.keySize key perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform file oldkey newbackend = do - g <- gitRepo - -- Store the old backend's cached key in the new backend -- (the file can't be stored as usual, because it's already a symlink). -- The old backend's key is not dropped from it, because there may -- be other files still pointing at that key. - let src = gitAnnexLocation g oldkey - let tmpfile = gitAnnexTmpDir g </> takeFileName file + src <- fromRepo $ gitAnnexLocation oldkey + tmp <- fromRepo $ gitAnnexTmpDir + let tmpfile = tmp </> takeFileName file liftIO $ createLink src tmpfile k <- Backend.genKey tmpfile $ Just newbackend liftIO $ cleantmp tmpfile diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 318ea56d0..573747867 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -21,8 +21,7 @@ seek = [withKeys start] start :: Key -> CommandStart start key = do - g <- gitRepo - let file = gitAnnexLocation g key + file <- fromRepo $ gitAnnexLocation key whenM (inAnnex key) $ liftIO $ rsyncServerSend file -- does not return warning "requested key is not present" diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 825f81939..d24f921a9 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -31,8 +31,8 @@ start file = isAnnexed file $ \(key, _) -> do then do force <- Annex.getState Annex.force unless force $ do - g <- gitRepo - staged <- liftIO $ LsFiles.staged g [Git.workTree g] + top <- fromRepo Git.workTree + staged <- inRepo $ LsFiles.staged [top] unless (null staged) $ error "This command cannot be run when there are already files staged for commit." Annex.changeState $ \s -> s { Annex.force = True } @@ -46,19 +46,19 @@ perform file key = next $ cleanup file key cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do - g <- gitRepo - liftIO $ removeFile file - liftIO $ Git.run g "rm" [Params "--quiet --", File file] + inRepo $ Git.run "rm" [Params "--quiet --", File file] -- git rm deletes empty directories; put them back liftIO $ createDirectoryIfMissing True (parentDir file) fast <- Annex.getState Annex.fast if fast - then liftIO $ do + then do -- fast mode: hard link to content in annex - createLink (gitAnnexLocation g key) file - allowWrite file + src <- fromRepo $ gitAnnexLocation key + liftIO $ do + createLink src file + allowWrite file else do fromAnnex key file logStatus key InfoMissing diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 5a6ee0be2..f317b7620 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -28,11 +28,9 @@ check = do when (b == Annex.Branch.name) $ error $ "cannot uninit when the " ++ b ++ " branch is checked out" where - current_branch = do - g <- gitRepo - b <- liftIO $ - Git.pipeRead g [Params "rev-parse --abbrev-ref HEAD"] - return $ head $ lines $ B.unpack b + current_branch = head . lines . B.unpack <$> revhead + revhead = inRepo $ Git.pipeRead + [Params "rev-parse --abbrev-ref HEAD"] seek :: [CommandSeek] seek = [withFilesInGit startUnannex, withNothing start] @@ -53,12 +51,11 @@ perform = next cleanup cleanup :: CommandCleanup cleanup = do - g <- gitRepo + annexdir <- fromRepo $ gitAnnexDir uninitialize mapM_ removeAnnex =<< getKeysPresent - liftIO $ removeDirectoryRecursive (gitAnnexDir g) + liftIO $ removeDirectoryRecursive annexdir -- avoid normal shutdown saveState - liftIO $ do - Git.run g "branch" [Param "-D", Param Annex.Branch.name] - exitSuccess + inRepo $ Git.run "branch" [Param "-D", Param Annex.Branch.name] + liftIO $ exitSuccess diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 7ecaf0b7f..590b75311 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -37,9 +37,8 @@ perform dest key = do checkDiskSpace key - g <- gitRepo - let src = gitAnnexLocation g key - let tmpdest = gitAnnexTmpLocation g key + src <- fromRepo $ gitAnnexLocation key + tmpdest <- fromRepo $ gitAnnexTmpLocation key liftIO $ createDirectoryIfMissing True (parentDir tmpdest) showAction "copying" ok <- liftIO $ copyFileExternal src tmpdest diff --git a/Command/Unused.hs b/Command/Unused.hs index 7e9ffa01f..9d56d1ff1 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -75,8 +75,8 @@ checkRemoteUnused' r = do writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex () writeUnusedFile prefix l = do - g <- gitRepo - liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $ + logfile <- fromRepo $ gitAnnexUnusedLog prefix + liftIO $ viaTmp writeFile logfile $ unlines $ map (\(n, k) -> show n ++ " " ++ show k) l table :: [(Int, Key)] -> [String] @@ -147,8 +147,7 @@ unusedKeys = do excludeReferenced :: [Key] -> Annex [Key] excludeReferenced [] = return [] -- optimisation excludeReferenced l = do - g <- gitRepo - c <- liftIO $ Git.pipeRead g [Param "show-ref"] + c <- inRepo $ Git.pipeRead [Param "show-ref"] removewith (getKeysReferenced : map getKeysReferencedInGit (refs c)) (S.fromList l) where @@ -183,8 +182,8 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller {- List of keys referenced by symlinks in the git repo. -} getKeysReferenced :: Annex [Key] getKeysReferenced = do - g <- gitRepo - files <- liftIO $ LsFiles.inRepo g [Git.workTree g] + top <- fromRepo Git.workTree + files <- inRepo $ LsFiles.inRepo [top] keypairs <- mapM Backend.lookupFile files return $ map fst $ catMaybes keypairs @@ -192,8 +191,7 @@ getKeysReferenced = do getKeysReferencedInGit :: String -> Annex [Key] getKeysReferencedInGit ref = do showAction $ "checking " ++ Git.refDescribe ref - g <- gitRepo - findkeys [] =<< liftIO (LsTree.lsTree g ref) + findkeys [] =<< inRepo (LsTree.lsTree ref) where findkeys c [] = return c findkeys c (l:ls) @@ -217,16 +215,14 @@ staleKeysPrune dirspec present = do let stale = contents `exclude` present let dups = contents `exclude` stale - g <- gitRepo - let dir = dirspec g + dir <- fromRepo dirspec liftIO $ forM_ dups $ \t -> removeFile $ dir </> keyFile t return stale staleKeys :: (Git.Repo -> FilePath) -> Annex [Key] staleKeys dirspec = do - g <- gitRepo - let dir = dirspec g + dir <- fromRepo dirspec exists <- liftIO $ doesDirectoryExist dir if not exists then return [] |