diff options
Diffstat (limited to 'src/Repo.hs')
| -rw-r--r-- | src/Repo.hs | 59 |
1 files changed, 39 insertions, 20 deletions
diff --git a/src/Repo.hs b/src/Repo.hs index f22b211..09e577b 100644 --- a/src/Repo.hs +++ b/src/Repo.hs @@ -1,16 +1,16 @@ module Repo ( - Repo, + Repo, getRepoWorkDir, DeclaredRepo(..), RepoName(..), textRepoName, showRepoName, Commit, commitId, CommitId, textCommitId, showCommitId, - Tree, treeId, treeRepo, + Tree, treeId, treeRepo, treeSubdir, TreeId, textTreeId, showTreeId, Tag(..), openRepo, - readCommit, tryReadCommit, - readTree, tryReadTree, + readCommit, readCommitId, tryReadCommit, + readTree, readTreeId, tryReadTree, readBranch, readTag, listCommits, @@ -67,6 +67,9 @@ data Repo instance Show Repo where show GitRepo {..} = gitDir +getRepoWorkDir :: Repo -> FilePath +getRepoWorkDir GitRepo {..} = takeDirectory gitDir + data DeclaredRepo = DeclaredRepo { repoName :: RepoName , repoPath :: FilePath @@ -98,8 +101,9 @@ data CommitDetails = CommitDetails } data Tree = Tree - { treeRepo :: Repo - , treeId :: TreeId + { treeRepo :: Repo -- ^ Repository in which the tree is tored + , treeId :: TreeId -- ^ Tree ID + , treeSubdir :: FilePath -- ^ Subdirectory represented by this tree (from the repo root) } data Tag a = Tag @@ -169,17 +173,26 @@ mkCommit commitRepo commitId_ = do 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 <> "'" + 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 -readTree :: (MonadIO m, MonadFail m) => Repo -> Text -> m Tree -readTree repo@GitRepo {..} ref = maybe (fail err) return =<< tryReadTree repo ref - where err = "tree `" <> T.unpack ref <> "' not found in `" <> gitDir <> "'" +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 -> Text -> m (Maybe Tree) -tryReadTree repo ref = return . fmap (Tree repo . TreeId) =<< tryReadObjectId repo "tree" ref +tryReadTree :: (MonadIO m, MonadFail m) => Repo -> FilePath -> Text -> m (Maybe Tree) +tryReadTree treeRepo treeSubdir ref = do + fmap (fmap TreeId) (tryReadObjectId treeRepo "tree" ref) >>= \case + Just treeId -> return $ Just Tree {..} + Nothing -> return Nothing tryReadObjectId :: (MonadIO m, MonadFail m) => Repo -> Text -> Text -> m (Maybe ByteString) tryReadObjectId GitRepo {..} otype ref = do @@ -252,6 +265,7 @@ getCommitDetails Commit {..} = do Just treeId <- return $ TreeId . BC.pack <$> lookup "tree" info let treeRepo = commitRepo + treeSubdir = "" let commitTree = Tree {..} let commitTitle = T.pack title let commitMessage = T.pack $ unlines $ dropWhile null message @@ -272,14 +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) - } - _ -> 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 () |