diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Command/Subtree.hs | 1 | ||||
| -rw-r--r-- | src/Repo.hs | 22 |
2 files changed, 14 insertions, 9 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 () |