minici 0.1.7 → 0.1.8
raw patch · 14 files changed
+312/−47 lines, 14 files
Files
- CHANGELOG.md +7/−0
- minici.cabal +3/−1
- src/Command/Extract.hs +3/−2
- src/Command/JobId.hs +1/−1
- src/Command/Log.hs +1/−1
- src/Command/Run.hs +27/−10
- src/Command/Shell.hs +46/−0
- src/Command/Subtree.hs +47/−0
- src/Config.hs +2/−1
- src/Eval.hs +109/−15
- src/Job.hs +32/−4
- src/Job/Types.hs +9/−1
- src/Main.hs +4/−0
- src/Repo.hs +21/−11
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 ()