From bf460a0a98d7e4c7f4eac525fcf300629db582b6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Nov 2011 15:34:10 -0400 Subject: reorder repo parameters last Many functions took the repo as their first parameter. Changing it consistently to be the last parameter allows doing some useful things with currying, that reduce boilerplate. In particular, g <- gitRepo is almost never needed now, instead use inRepo to run an IO action in the repo, and fromRepo to get a value from the repo. This also provides more opportunities to use monadic and applicative combinators. --- Command/Add.hs | 4 ++-- Command/AddUrl.hs | 3 +-- Command/DropUnused.hs | 8 +++----- Command/Fsck.hs | 20 ++++++++++---------- Command/Map.hs | 3 +-- Command/Migrate.hs | 7 +++---- Command/SendKey.hs | 3 +-- Command/Unannex.hs | 16 ++++++++-------- Command/Uninit.hs | 17 +++++++---------- Command/Unlock.hs | 5 ++--- Command/Unused.hs | 20 ++++++++------------ 11 files changed, 46 insertions(+), 60 deletions(-) (limited to 'Command') 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 [] -- cgit v1.2.3