diff options
| -rw-r--r-- | src/Command/Subtree.hs | 1 | ||||
| -rw-r--r-- | src/Repo.hs | 22 | ||||
| -rw-r--r-- | test/script/repo.et | 26 |
3 files changed, 39 insertions, 10 deletions
diff --git a/src/Command/Subtree.hs b/src/Command/Subtree.hs index 8d42d73..15cb2db 100644 --- a/src/Command/Subtree.hs +++ b/src/Command/Subtree.hs @@ -44,3 +44,4 @@ cmdSubtree (SubtreeCommand SubtreeOptions args) = do subtree <- getSubtree Nothing (T.unpack path) =<< readTree repo subdir tree outputMessage out $ textTreeId $ treeId subtree + outputEvent out $ TestMessage $ "path " <> T.pack (treeSubdir subtree) diff --git a/src/Repo.hs b/src/Repo.hs index 98178e6..b154209 100644 --- a/src/Repo.hs +++ b/src/Repo.hs @@ -280,15 +280,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 () diff --git a/test/script/repo.et b/test/script/repo.et index 7a34a1c..d93f700 100644 --- a/test/script/repo.et +++ b/test/script/repo.et @@ -14,52 +14,76 @@ test RepoSubtree: git -C work rev-parse HEAD:first git -C work rev-parse HEAD:first/second + git clone -q --bare work bare.git + expect /([0-9a-f]+)/ from git_init capture commit expect /([0-9a-f]+)/ from git_init capture root expect /([0-9a-f]+)/ from git_init capture sub1 expect /([0-9a-f]+)/ from git_init capture sub2 - for repo in [ "./work" ]: + for repo in [ "./work", "./bare.git" ]: local: spawn as p on n args [ repo, "subtree", commit, "" ] expect from p /msg $root/ + expect from p /path (.*)/ capture path + guard (path == "") local: spawn as p on n args [ repo, "subtree", commit, "." ] expect from p /msg $root/ + expect from p /path (.*)/ capture path + guard (path == "") local: spawn as p on n args [ repo, "subtree", commit, "/" ] expect from p /msg $root/ + expect from p /path (.*)/ capture path + guard (path == "") local: spawn as p on n args [ repo, "subtree", commit, "first" ] expect from p /msg $sub1/ + expect from p /path (.*)/ capture path + guard (path == "first") local: spawn as p on n args [ repo, "subtree", commit, "./first" ] expect from p /msg $sub1/ + expect from p /path (.*)/ capture path + guard (path == "first") local: spawn as p on n args [ repo, "subtree", commit, "/first" ] expect from p /msg $sub1/ + expect from p /path (.*)/ capture path + guard (path == "first") local: spawn as p on n args [ repo, "subtree", commit, "./first/second" ] expect from p /msg $sub2/ + expect from p /path (.*)/ capture path + guard (path == "first/second") local: spawn as p on n args [ repo, "subtree", commit, "/first/second" ] expect from p /msg $sub2/ + expect from p /path (.*)/ capture path + guard (path == "first/second") local: spawn as p on n args [ repo, "subtree", "$sub1(first)", "second" ] expect from p /msg $sub2/ + expect from p /path (.*)/ capture path + guard (path == "first/second") local: spawn as p on n args [ repo, "subtree", "$sub1(first)", "./second" ] expect from p /msg $sub2/ + expect from p /path (.*)/ capture path + guard (path == "first/second") local: spawn as p on n args [ repo, "subtree", "$sub1(first)", "/second/" ] expect from p /msg $sub2/ + expect from p /path (.*)/ capture path + guard (path == "first/second") |