packages feed

minici 0.1.7 → 0.1.8

raw patch · 14 files changed

+312/−47 lines, 14 files

Files

CHANGELOG.md view
@@ -1,5 +1,12 @@ # Revision history for MiniCI +## 0.1.8 -- 2025-07-06++* Added `shell` command to open a shell prepared for given job+* Support whole directories as artifacts+* Automatically run dependencies of jobs specified on command line+* Fix getting (sub)directory in a bare repository+ ## 0.1.7 -- 2025-05-28  * Added `log` command to show job log
minici.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               minici-version:            0.1.7+version:            0.1.8 synopsis:           Minimalist CI framework to run checks on local machine description:     Runs defined jobs, for example to build and test a project, for each git@@ -53,6 +53,8 @@         Command.JobId         Command.Log         Command.Run+        Command.Shell+        Command.Subtree         Config         Eval         Job
src/Command/Extract.hs view
@@ -14,6 +14,7 @@  import Command import Eval+import Job import Job.Types  @@ -78,7 +79,7 @@             _     -> return False      forM_ extractArtifacts $ \( ref, ArtifactName aname ) -> do-        jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId) =<<+        jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId . fst) =<<             liftIO (runEval (evalJobReference ref) einput)          let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids@@ -103,4 +104,4 @@             liftIO (doesPathExist tpath) >>= \case                 True -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists"                 False -> return ()-        liftIO $ copyFile (adir </> afile) tpath+        liftIO $ copyRecursiveForce (adir </> afile) tpath
src/Command/JobId.hs view
@@ -52,7 +52,7 @@ cmdJobId (JobIdCommand JobIdOptions {..} ref) = do     einput <- getEvalInput     out <- getOutput-    JobId ids <- either (tfail . textEvalError) (return . jobId) =<<+    JobId ids <- either (tfail . textEvalError) (return . jobId . fst) =<<         liftIO (runEval (evalJobReference ref) einput)      outputMessage out $ textJobId $ JobId ids
src/Command/Log.hs view
@@ -37,7 +37,7 @@ cmdLog :: LogCommand -> CommandExec () cmdLog (LogCommand ref) = do     einput <- getEvalInput-    jid <- either (tfail . textEvalError) (return . jobId) =<<+    jid <- either (tfail . textEvalError) (return . jobId . fst) =<<         liftIO (runEval (evalJobReference ref) einput)     output <- getOutput     storageDir <- getStorageDir
src/Command/Run.hs view
@@ -126,7 +126,7 @@ argumentJobSource :: [ JobName ] -> CommandExec JobSource argumentJobSource [] = emptyJobSource argumentJobSource names = do-    ( config, jobsetCommit ) <- getJobRoot >>= \case+    ( config, jcommit ) <- getJobRoot >>= \case         JobRootConfig config -> do             commit <- sequence . fmap createWipCommit =<< tryGetDefaultRepo             return ( config, commit )@@ -135,29 +135,46 @@             config <- either fail return =<< loadConfigForCommit =<< getCommitTree commit             return ( config, Just commit ) -    jobtree <- case jobsetCommit of+    jobtree <- case jcommit of         Just commit -> (: []) <$> getCommitTree commit         Nothing -> return []     let cidPart = map (JobIdTree Nothing "" . treeId) jobtree-    jobsetJobsEither <- fmap Right $ forM names $ \name ->+    forM_ names $ \name ->         case find ((name ==) . jobName) (configJobs config) of-            Just job -> return job+            Just _  -> return ()             Nothing -> tfail $ "job ‘" <> textJobName name <> "’ not found"-    oneshotJobSource . (: []) =<<-        cmdEvalWith (\ei -> ei { eiCurrentIdRev = cidPart ++ eiCurrentIdRev ei })-        (evalJobSet (map ( Nothing, ) jobtree) JobSet {..}) +    jset <- cmdEvalWith (\ei -> ei { eiCurrentIdRev = cidPart ++ eiCurrentIdRev ei }) $ do+        fullSet <- evalJobSet (map ( Nothing, ) jobtree) JobSet+            { jobsetId = ()+            , jobsetCommit = jcommit+            , jobsetJobsEither = Right (configJobs config)+            }+        let selectedSet = fullSet { jobsetJobsEither = fmap (filter ((`elem` names) . jobName)) (jobsetJobsEither fullSet) }+        fillInDependencies selectedSet+    oneshotJobSource [ jset ]+ refJobSource :: [ JobRef ] -> CommandExec JobSource refJobSource [] = emptyJobSource refJobSource refs = do-    jobs <- cmdEvalWith id $ mapM evalJobReference refs-    oneshotJobSource . map (JobSet Nothing . Right . (: [])) $ jobs+    jobs <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs)+    sets <- cmdEvalWith id $ do+        forM jobs $ \( sid, js ) -> do+            fillInDependencies $ JobSet sid Nothing (Right $ reverse js)+    oneshotJobSource sets+  where+    addJobToList :: [ ( JobSetId, [ Job ] ) ] -> ( Job, JobSetId ) -> [ ( JobSetId, [ Job ] ) ]+    addJobToList (( sid, js ) : rest ) ( job, jsid )+        | sid == jsid             = ( sid, job : js ) : rest+        | otherwise               = ( sid, js ) : addJobToList rest ( job, jsid )+    addJobToList [] ( job, jsid ) = [ ( jsid, [ job ] ) ]  loadJobSetFromRoot :: (MonadIO m, MonadFail m) => JobRoot -> Commit -> m DeclaredJobSet loadJobSetFromRoot root commit = case root of     JobRootRepo _ -> loadJobSetForCommit commit     JobRootConfig config -> return JobSet-        { jobsetCommit = Just commit+        { jobsetId = ()+        , jobsetCommit = Just commit         , jobsetJobsEither = Right $ configJobs config         } 
+ src/Command/Shell.hs view
@@ -0,0 +1,46 @@+module Command.Shell (+    ShellCommand,+) where++import Control.Monad+import Control.Monad.IO.Class++import Data.Maybe+import Data.Text (Text)+import Data.Text qualified as T++import System.Environment+import System.Process hiding (ShellCommand)++import Command+import Eval+import Job+import Job.Types+++data ShellCommand = ShellCommand JobRef++instance Command ShellCommand where+    commandName _ = "shell"+    commandDescription _ = "Open a shell prepared for given job"++    type CommandArguments ShellCommand = Text++    commandUsage _ = T.unlines $+        [ "Usage: minici shell <job ref>"+        ]++    commandInit _ _ = ShellCommand . parseJobRef+    commandExec = cmdShell+++cmdShell :: ShellCommand -> CommandExec ()+cmdShell (ShellCommand ref) = do+    einput <- getEvalInput+    job <- either (tfail . textEvalError) (return . fst) =<<+        liftIO (runEval (evalJobReference ref) einput)+    sh <- fromMaybe "/bin/sh" <$> liftIO (lookupEnv "SHELL")+    storageDir <- getStorageDir+    prepareJob storageDir job $ \checkoutPath _ -> do+        liftIO $ withCreateProcess (proc sh []) { cwd = Just checkoutPath } $ \_ _ _ ph -> do+            void $ waitForProcess ph
+ src/Command/Subtree.hs view
@@ -0,0 +1,47 @@+module Command.Subtree (+    SubtreeCommand,+) where++import Data.Text (Text)+import Data.Text qualified as T++import Command+import Output+import Repo+++data SubtreeCommand = SubtreeCommand SubtreeOptions [ Text ]++data SubtreeOptions = SubtreeOptions++instance Command SubtreeCommand where+    commandName _ = "subtree"+    commandDescription _ = "Resolve subdirectory of given repo tree"++    type CommandArguments SubtreeCommand = [ Text ]++    commandUsage _ = T.pack $ unlines $+        [ "Usage: minici subtree <tree> <path>"+        ]++    type CommandOptions SubtreeCommand = SubtreeOptions+    defaultCommandOptions _ = SubtreeOptions++    commandInit _ opts = SubtreeCommand opts+    commandExec = cmdSubtree+++cmdSubtree :: SubtreeCommand -> CommandExec ()+cmdSubtree (SubtreeCommand SubtreeOptions args) = do+    [ treeParam, path ] <- return args+    out <- getOutput+    repo <- getDefaultRepo++    let ( tree, subdir ) =+            case T.splitOn "(" treeParam of+                (t : param : _) -> ( t, T.unpack $ T.takeWhile (/= ')') param )+                _ -> ( treeParam, "" )++    subtree <- getSubtree Nothing (T.unpack path) =<< readTree repo subdir tree+    outputMessage out $ textTreeId $ treeId subtree+    outputEvent out $ TestMessage $ "path " <> T.pack (treeSubdir subtree)
src/Config.hs view
@@ -173,6 +173,7 @@ loadJobSetForCommit commit = return . toJobSet =<< loadConfigForCommit =<< getCommitTree commit   where     toJobSet configEither = JobSet-        { jobsetCommit = Just commit+        { jobsetId = ()+        , jobsetCommit = Just commit         , jobsetJobsEither = fmap configJobs configEither         }
src/Eval.hs view
@@ -6,6 +6,9 @@     evalJob,     evalJobSet,     evalJobReference,++    loadJobSetById,+    fillInDependencies, ) where  import Control.Monad@@ -14,6 +17,7 @@  import Data.List import Data.Maybe+import Data.Set qualified as S import Data.Text (Text) import Data.Text qualified as T @@ -78,7 +82,7 @@     return $ map (\r -> ( r, commonSubdir r )) . nub . map jcRepo $ checkouts  -evalJob :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> DeclaredJob -> Eval Job+evalJob :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> DeclaredJob -> Eval ( Job, JobSetId ) evalJob revisionOverrides dset decl = do     EvalInput {..} <- ask     otherRepos <- collectOtherRepos dset decl@@ -102,20 +106,27 @@             }      let otherRepoIds = map (\( repo, ( subtree, tree )) -> JobIdTree (fst <$> repo) subtree (treeId tree)) otherRepoTrees-    return Job-        { jobId = JobId $ reverse $ reverse otherRepoIds ++ JobIdName (jobId decl) : eiCurrentIdRev-        , jobName = jobName decl-        , jobCheckout = checkouts-        , jobRecipe = jobRecipe decl-        , jobArtifacts = jobArtifacts decl-        , jobUses = jobUses decl-        }+    return+        ( Job+            { jobId = JobId $ reverse $ reverse otherRepoIds ++ JobIdName (jobId decl) : eiCurrentIdRev+            , jobName = jobName decl+            , jobCheckout = checkouts+            , jobRecipe = jobRecipe decl+            , jobArtifacts = jobArtifacts decl+            , jobUses = jobUses decl+            }+        , JobSetId $ reverse $ reverse otherRepoIds ++ eiCurrentIdRev+        )  evalJobSet :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> Eval JobSet evalJobSet revisionOverrides decl = do-    jobs <- either (return . Left) (handleToEither . mapM (evalJob revisionOverrides decl)) $ jobsetJobsEither decl+    EvalInput {..} <- ask+    jobs <- fmap (fmap (map fst))+        $ either (return . Left) (handleToEither . mapM (evalJob revisionOverrides decl))+        $ jobsetJobsEither decl     return JobSet-        { jobsetCommit = jobsetCommit decl+        { jobsetId = JobSetId $ reverse $ eiCurrentIdRev+        , jobsetCommit = jobsetCommit decl         , jobsetJobsEither = jobs         }   where@@ -130,10 +141,10 @@     Nothing -> throwError $ OtherEvalError $ "repo ‘" <> textRepoName name <> "’ not defined"  -canonicalJobName :: [ Text ] -> Config -> Maybe Tree -> Eval Job+canonicalJobName :: [ Text ] -> Config -> Maybe Tree -> Eval ( Job, JobSetId ) canonicalJobName (r : rs) config mbDefaultRepo = do     let name = JobName r-        dset = JobSet Nothing $ Right $ configJobs config+        dset = JobSet () Nothing $ Right $ configJobs config     case find ((name ==) . jobName) (configJobs config) of         Just djob -> do             otherRepos <- collectOtherRepos dset djob@@ -157,17 +168,100 @@             Nothing -> throwError $ OtherEvalError $ "failed to resolve ‘" <> r <> "’ to a commit or tree in " <> T.pack (show repo) readTreeFromIdRef [] _ _ = throwError $ OtherEvalError $ "expected commit or tree reference" -canonicalCommitConfig :: [ Text ] -> Repo -> Eval Job+canonicalCommitConfig :: [ Text ] -> Repo -> Eval ( Job, JobSetId ) canonicalCommitConfig rs repo = do     ( tree, rs' ) <- readTreeFromIdRef rs "" repo     config <- either fail return =<< loadConfigForCommit tree     local (\ei -> ei { eiCurrentIdRev = JobIdTree Nothing "" (treeId tree) : eiCurrentIdRev ei }) $         canonicalJobName rs' config (Just tree) -evalJobReference :: JobRef -> Eval Job+evalJobReference :: JobRef -> Eval ( Job, JobSetId ) evalJobReference (JobRef rs) =     asks eiJobRoot >>= \case         JobRootRepo defRepo -> do             canonicalCommitConfig rs defRepo         JobRootConfig config -> do             canonicalJobName rs config Nothing+++jobsetFromConfig :: [ JobIdPart ] -> Config -> Maybe Tree -> Eval ( DeclaredJobSet, [ JobIdPart ], [ ( Maybe RepoName, Tree ) ] )+jobsetFromConfig sid config _ = do+    EvalInput {..} <- ask+    let dset = JobSet () Nothing $ Right $ configJobs config+    otherRepos <- forM sid $ \case+        JobIdName name -> do+            throwError $ OtherEvalError $ "expected tree id, not a job name ‘" <> textJobName name <> "’"+        JobIdCommit name cid -> do+            repo <- evalRepo name+            tree <- getCommitTree =<< readCommitId repo cid+            return ( name, tree )+        JobIdTree name path tid -> do+            repo <- evalRepo name+            tree <- readTreeId repo path tid+            return ( name, tree )+    return ( dset, eiCurrentIdRev, otherRepos )++jobsetFromCommitConfig :: [ JobIdPart ] -> Repo -> Eval ( DeclaredJobSet, [ JobIdPart ], [ ( Maybe RepoName, Tree ) ] )+jobsetFromCommitConfig (JobIdTree name path tid : sid) repo = do+    when (isJust name) $ do+        throwError $ OtherEvalError $ "expected default repo commit or tree id"+    when (not (null path)) $ do+        throwError $ OtherEvalError $ "expected root commit or tree id"+    tree <- readTreeId repo path tid+    config <- either fail return =<< loadConfigForCommit tree+    local (\ei -> ei { eiCurrentIdRev = JobIdTree Nothing "" (treeId tree) : eiCurrentIdRev ei }) $ do+        ( dset, idRev, otherRepos ) <- jobsetFromConfig sid config (Just tree)+        return ( dset, idRev, ( Nothing, tree ) : otherRepos )++jobsetFromCommitConfig (JobIdCommit name cid : sid) repo = do+    when (isJust name) $ do+        throwError $ OtherEvalError $ "expected default repo commit or tree id"+    tree <- getCommitTree =<< readCommitId repo cid+    jobsetFromCommitConfig (JobIdTree name "" (treeId tree) : sid) repo++jobsetFromCommitConfig (JobIdName name : _) _ = do+    throwError $ OtherEvalError $ "expected commit or tree id, not a job name ‘" <> textJobName name <> "’"++jobsetFromCommitConfig [] _ = do+    throwError $ OtherEvalError $ "expected commit or tree id"++loadJobSetById :: JobSetId -> Eval ( DeclaredJobSet, [ JobIdPart ], [ ( Maybe RepoName, Tree ) ] )+loadJobSetById (JobSetId sid) = do+    asks eiJobRoot >>= \case+        JobRootRepo defRepo -> do+            jobsetFromCommitConfig sid defRepo+        JobRootConfig config -> do+            jobsetFromConfig sid config Nothing++fillInDependencies :: JobSet -> Eval JobSet+fillInDependencies jset = do+    ( dset, idRev, otherRepos ) <- local (\ei -> ei { eiCurrentIdRev = [] }) $ do+        loadJobSetById (jobsetId jset)+    origJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither jset+    declJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither dset+    deps <- gather declJobs S.empty (map jobName origJobs)++    jobs <- local (\ei -> ei { eiCurrentIdRev = idRev }) $ do+        fmap catMaybes $ forM declJobs $ \djob -> if+            | Just job <- find ((jobName djob ==) . jobName) origJobs+            -> return (Just job)++            | jobName djob `S.member` deps+            -> Just . fst <$> evalJob otherRepos dset djob++            | otherwise+            -> return Nothing++    return $ jset { jobsetJobsEither = Right jobs }+  where+    gather djobs cur ( name : rest )+        | name `S.member` cur+        = gather djobs cur rest++        | Just djob <- find ((name ==) . jobName) djobs+        = gather djobs (S.insert name cur) $ map fst (jobUses djob) ++ rest++        | otherwise+        = throwError $ OtherEvalError $ "dependency ‘" <> textJobName name <> "’ not found"++    gather _ cur [] = return cur
src/Job.hs view
@@ -8,7 +8,11 @@     jobStatusFinished, jobStatusFailed,     JobManager(..), newJobManager, cancelAllJobs,     runJobs,+    prepareJob,     jobStorageSubdir,++    copyRecursive,+    copyRecursiveForce, ) where  import Control.Concurrent@@ -90,12 +94,17 @@     JobWaiting _ -> "waiting"     JobRunning -> "running"     JobSkipped -> "skipped"-    JobError err -> "error\n" <> footnoteText err+    JobError _ -> "error"     JobFailed -> "failed"     JobCancelled -> "cancelled"     JobDone _ -> "done" +textJobStatusDetails :: JobStatus a -> Text+textJobStatusDetails = \case+    JobError err -> footnoteText err <> "\n"+    _ -> "" + data JobManager = JobManager     { jmSemaphore :: TVar Int     , jmDataDir :: FilePath@@ -282,7 +291,7 @@             status <- readTVar outVar             when (Just status == prev) retry             return status-        T.writeFile path $ textJobStatus status <> "\n"+        T.writeFile path $ textJobStatus status <> "\n" <> textJobStatusDetails status         when (not (jobStatusFinished status)) $ loop $ Just status  jobStorageSubdir :: JobId -> FilePath@@ -304,7 +313,7 @@     liftIO $ forM_ uses $ \aout -> do         let target = checkoutPath </> aoutWorkPath aout         createDirectoryIfMissing True $ takeDirectory target-        copyFile (aoutStorePath aout) target+        copyRecursive (aoutStorePath aout) target      bracket (liftIO $ openFile (jdir </> "log") WriteMode) (liftIO . hClose) $ \logs -> do         forM_ (jobRecipe job) $ \p -> do@@ -333,7 +342,7 @@             let target = adir </> T.unpack tname </> takeFileName path             liftIO $ do                 createDirectoryIfMissing True $ takeDirectory target-                copyFile path target+                copyRecursiveForce path target             return $ ArtifactOutput                 { aoutName = name                 , aoutWorkPath = makeRelative checkoutPath path@@ -344,3 +353,22 @@             { outName = jobName job             , outArtifacts = artifacts             }+++copyRecursive :: FilePath -> FilePath -> IO ()+copyRecursive from to = do+    doesDirectoryExist from >>= \case+        False -> do+            copyFile from to+        True -> do+            createDirectory to+            content <- listDirectory from+            forM_ content $ \name -> do+                copyRecursive  (from </> name) (to </> name)++copyRecursiveForce :: FilePath -> FilePath -> IO ()+copyRecursiveForce from to = do+    doesDirectoryExist to >>= \case+        False -> return ()+        True  -> removeDirectoryRecursive to+    copyRecursive from to
src/Job/Types.hs view
@@ -55,18 +55,26 @@   data JobSet' d = JobSet-    { jobsetCommit :: Maybe Commit+    { jobsetId :: JobSetId' d+    , jobsetCommit :: Maybe Commit     , jobsetJobsEither :: Either String [ Job' d ]     }  type JobSet = JobSet' Evaluated type DeclaredJobSet = JobSet' Declared +type family JobSetId' d :: Type where+    JobSetId' Declared = ()+    JobSetId' Evaluated = JobSetId+ jobsetJobs :: JobSet -> [ Job ] jobsetJobs = either (const []) id . jobsetJobsEither   newtype JobId = JobId [ JobIdPart ]+    deriving (Eq, Ord)++newtype JobSetId = JobSetId [ JobIdPart ]     deriving (Eq, Ord)  data JobIdPart
src/Main.hs view
@@ -25,6 +25,8 @@ import Command.JobId import Command.Log import Command.Run+import Command.Shell+import Command.Subtree import Config import Output import Repo@@ -92,6 +94,8 @@     , SC $ Proxy @ExtractCommand     , SC $ Proxy @JobIdCommand     , SC $ Proxy @LogCommand+    , SC $ Proxy @ShellCommand+    , SC $ Proxy @SubtreeCommand     ]  lookupCommand :: String -> Maybe SomeCommandType
src/Repo.hs view
@@ -9,8 +9,8 @@     Tag(..),      openRepo,-    readCommit, tryReadCommit,-    readTree, tryReadTree,+    readCommit, readCommitId, tryReadCommit,+    readTree, readTreeId, tryReadTree,     readBranch,     readTag,     listCommits,@@ -175,6 +175,9 @@ 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 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 @@ 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 ()