diff options
Diffstat (limited to 'src/Repo.hs')
| -rw-r--r-- | src/Repo.hs | 34 |
1 files changed, 22 insertions, 12 deletions
diff --git a/src/Repo.hs b/src/Repo.hs index 98178e6..c878b1e 100644 --- a/src/Repo.hs +++ b/src/Repo.hs @@ -9,8 +9,8 @@ module Repo ( Tag(..), openRepo, - readCommit, tryReadCommit, - readTree, tryReadTree, + readCommit, readCommitId, tryReadCommit, + readTree, readTreeId, tryReadTree, readBranch, readTag, listCommits, @@ -72,7 +72,7 @@ getRepoWorkDir GitRepo {..} = takeDirectory gitDir data DeclaredRepo = DeclaredRepo { repoName :: RepoName - , repoPath :: FilePath + , repoPath :: Maybe FilePath } newtype RepoName = RepoName Text @@ -175,6 +175,9 @@ readCommit :: (MonadIO m, MonadFail m) => Repo -> Text -> m Commit readCommit repo@GitRepo {..} ref = maybe (fail err) return =<< tryReadCommit repo ref where err = "revision ‘" <> T.unpack ref <> "’ not found in ‘" <> gitDir <> "’" +readCommitId :: (MonadIO m, MonadFail m) => Repo -> CommitId -> m Commit +readCommitId repo cid = readCommit repo (textCommitId cid) + tryReadCommit :: (MonadIO m, MonadFail m) => Repo -> Text -> m (Maybe Commit) tryReadCommit repo ref = sequence . fmap (mkCommit repo . CommitId) =<< tryReadObjectId repo "commit" ref @@ -182,6 +185,9 @@ readTree :: (MonadIO m, MonadFail m) => Repo -> FilePath -> Text -> m Tree readTree repo@GitRepo {..} subdir ref = maybe (fail err) return =<< tryReadTree repo subdir ref where err = "tree ‘" <> T.unpack ref <> "’ not found in ‘" <> gitDir <> "’" +readTreeId :: (MonadIO m, MonadFail m) => Repo -> FilePath -> TreeId -> m Tree +readTreeId repo subdir tid = readTree repo subdir $ textTreeId tid + tryReadTree :: (MonadIO m, MonadFail m) => Repo -> FilePath -> Text -> m (Maybe Tree) tryReadTree treeRepo treeSubdir ref = do fmap (fmap TreeId) (tryReadObjectId treeRepo "tree" ref) >>= \case @@ -280,15 +286,19 @@ getCommitMessage = fmap commitMessage . getCommitDetails getSubtree :: (MonadIO m, MonadFail m) => Maybe Commit -> FilePath -> Tree -> m Tree getSubtree mbCommit path tree = liftIO $ do let GitRepo {..} = treeRepo tree - readProcessWithExitCode "git" [ "--git-dir=" <> gitDir, "rev-parse", "--verify", "--quiet", showTreeId (treeId tree) <> ":./" <> path <> "/" ] "" >>= \case - ( ExitSuccess, out, _ ) | tid : _ <- lines out -> do - return Tree - { treeRepo = treeRepo tree - , treeId = TreeId (BC.pack tid) - , treeSubdir = treeSubdir tree </> path - } - _ -> do - fail $ "subtree ‘" <> path <> "’ not found" <> maybe "" ((" in revision ‘" <>) . (<> "’") . showCommitId . commitId) mbCommit + dirs = dropWhile (`elem` [ ".", "/" ]) $ splitDirectories path + + case dirs of + [] -> return tree + _ -> readProcessWithExitCode "git" [ "--git-dir=" <> gitDir, "rev-parse", "--verify", "--quiet", showTreeId (treeId tree) <> ":" <> joinPath dirs ] "" >>= \case + ( ExitSuccess, out, _ ) | tid : _ <- lines out -> do + return Tree + { treeRepo = treeRepo tree + , treeId = TreeId (BC.pack tid) + , treeSubdir = joinPath $ treeSubdir tree : dirs + } + _ -> do + fail $ "subtree ‘" <> path <> "’ not found" <> maybe "" ((" in revision ‘" <>) . (<> "’") . showCommitId . commitId) mbCommit checkoutAt :: (MonadIO m, MonadFail m) => Tree -> FilePath -> m () |