From b2295603ac1a8e333079fe1a87c04b27bd4ce157 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 7 Mar 2025 22:00:57 +0100
Subject: Subtree checkout option

---
 src/Repo.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

(limited to 'src/Repo.hs')

diff --git a/src/Repo.hs b/src/Repo.hs
index 0720179..ef95b36 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -19,6 +19,8 @@ module Repo (
     getCommitTitle,
     getCommitMessage,
 
+    getSubtree,
+
     checkoutAt,
     readCommittedFile,
 
@@ -245,6 +247,19 @@ getCommitMessage :: (MonadIO m, MonadFail m) => Commit -> m Text
 getCommitMessage = fmap commitMessage . getCommitDetails
 
 
+getSubtree :: MonadIO m => FilePath -> Tree -> m (Maybe Tree)
+getSubtree 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 $ Just Tree
+                { treeRepo = treeRepo tree
+                , treeId = TreeId (BC.pack tid)
+                }
+        _ -> do
+            return Nothing
+
+
 checkoutAt :: (MonadIO m, MonadFail m) => Tree -> FilePath -> m ()
 checkoutAt Tree {..} dest = do
     let GitRepo {..} = treeRepo
-- 
cgit v1.2.3