diff options
Diffstat (limited to 'src/Command')
| -rw-r--r-- | src/Command/Extract.hs | 107 | ||||
| -rw-r--r-- | src/Command/JobId.hs | 52 | ||||
| -rw-r--r-- | src/Command/Log.hs | 45 | ||||
| -rw-r--r-- | src/Command/Run.hs | 170 | ||||
| -rw-r--r-- | src/Command/Shell.hs | 46 | ||||
| -rw-r--r-- | src/Command/Subtree.hs | 47 |
6 files changed, 417 insertions, 50 deletions
diff --git a/src/Command/Extract.hs b/src/Command/Extract.hs new file mode 100644 index 0000000..b21c63c --- /dev/null +++ b/src/Command/Extract.hs @@ -0,0 +1,107 @@ +module Command.Extract ( + ExtractCommand, +) where + +import Control.Monad +import Control.Monad.Except +import Control.Monad.IO.Class + +import Data.Text qualified as T + +import System.Console.GetOpt +import System.Directory +import System.FilePath + +import Command +import Eval +import Job +import Job.Types + + +data ExtractCommand = ExtractCommand ExtractOptions ExtractArguments + +data ExtractArguments = ExtractArguments + { extractArtifacts :: [ ( JobRef, ArtifactName ) ] + , extractDestination :: FilePath + } + +instance CommandArgumentsType ExtractArguments where + argsFromStrings = \case + args@(_:_:_) -> do + extractArtifacts <- mapM toArtifactRef (init args) + extractDestination <- return (last args) + return ExtractArguments {..} + where + toArtifactRef tref = case T.breakOnEnd "." (T.pack tref) of + (jobref', aref) | Just ( jobref, '.' ) <- T.unsnoc jobref' + -> return ( parseJobRef jobref, ArtifactName aref ) + _ -> throwError $ "too few parts in artifact ref ‘" <> tref <> "’" + _ -> throwError "too few arguments" + +data ExtractOptions = ExtractOptions + { extractForce :: Bool + } + +instance Command ExtractCommand where + commandName _ = "extract" + commandDescription _ = "Extract artifacts generated by jobs" + + type CommandArguments ExtractCommand = ExtractArguments + + commandUsage _ = T.pack $ unlines $ + [ "Usage: minici jobid [<option>...] <job ref>.<artifact>... <destination>" + ] + + type CommandOptions ExtractCommand = ExtractOptions + defaultCommandOptions _ = ExtractOptions + { extractForce = False + } + + commandOptions _ = + [ Option [ 'f' ] [ "force" ] + (NoArg $ \opts -> opts { extractForce = True }) + "owerwrite existing files" + ] + + commandInit _ = ExtractCommand + commandExec = cmdExtract + + +cmdExtract :: ExtractCommand -> CommandExec () +cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do + einput <- getEvalInput + storageDir <- getStorageDir + + isdir <- liftIO (doesDirectoryExist extractDestination) >>= \case + True -> return True + False -> case extractArtifacts of + _:_:_ -> tfail $ "destination ‘" <> T.pack extractDestination <> "’ is not a directory" + _ -> return False + + forM_ extractArtifacts $ \( ref, ArtifactName aname ) -> do + jid@(JobId ids) <- either (tfail . textEvalError) (return . jobId . fst) =<< + liftIO (runEval (evalJobReference ref) einput) + + let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids + adir = jdir </> "artifacts" </> T.unpack aname + + liftIO (doesDirectoryExist jdir) >>= \case + True -> return () + False -> tfail $ "job ‘" <> textJobId jid <> "’ not yet executed" + + liftIO (doesDirectoryExist adir) >>= \case + True -> return () + False -> tfail $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found" + + afile <- liftIO (listDirectory adir) >>= \case + [ file ] -> return file + [] -> tfail $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found" + _:_:_ -> tfail $ "unexpected files in ‘" <> T.pack adir <> "’" + + let tpath | isdir = extractDestination </> afile + | otherwise = extractDestination + when (not extractForce) $ do + liftIO (doesPathExist tpath) >>= \case + True -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists" + False -> return () + liftIO $ copyRecursiveForce (adir </> afile) tpath diff --git a/src/Command/JobId.hs b/src/Command/JobId.hs index 9f531d6..096ed56 100644 --- a/src/Command/JobId.hs +++ b/src/Command/JobId.hs @@ -2,18 +2,26 @@ module Command.JobId ( JobIdCommand, ) where +import Control.Monad import Control.Monad.IO.Class import Data.Text (Text) import Data.Text qualified as T -import Data.Text.IO qualified as T + +import System.Console.GetOpt import Command import Eval import Job.Types +import Output +import Repo + +data JobIdCommand = JobIdCommand JobIdOptions JobRef -data JobIdCommand = JobIdCommand JobRef +data JobIdOptions = JobIdOptions + { joVerbose :: Bool + } instance Command JobIdCommand where commandName _ = "jobid" @@ -22,18 +30,44 @@ instance Command JobIdCommand where type CommandArguments JobIdCommand = Text commandUsage _ = T.pack $ unlines $ - [ "Usage: minici jobid <job ref>" + [ "Usage: minici jobid [<option>...] <job ref>" + ] + + type CommandOptions JobIdCommand = JobIdOptions + defaultCommandOptions _ = JobIdOptions + { joVerbose = False + } + + commandOptions _ = + [ Option [ 'v' ] [ "verbose" ] + (NoArg $ \opts -> opts { joVerbose = True }) + "show detals of the ID" ] - commandInit _ _ = JobIdCommand . JobRef . T.splitOn "." + commandInit _ opts = JobIdCommand opts . parseJobRef commandExec = cmdJobId cmdJobId :: JobIdCommand -> CommandExec () -cmdJobId (JobIdCommand ref) = do - config <- getConfig +cmdJobId (JobIdCommand JobIdOptions {..} ref) = do einput <- getEvalInput - JobId ids <- either (tfail . textEvalError) return =<< - liftIO (runEval (evalJobReference config ref) einput) + out <- getOutput + JobId ids <- either (tfail . textEvalError) (return . jobId . fst) =<< + liftIO (runEval (evalJobReference ref) einput) - liftIO $ T.putStrLn $ T.intercalate "." $ map textJobIdPart ids + outputMessage out $ textJobId $ JobId ids + when joVerbose $ do + outputMessage out "" + forM_ ids $ \case + JobIdName name -> outputMessage out $ textJobName name <> " (job name)" + JobIdCommit mbrepo cid -> outputMessage out $ T.concat + [ textCommitId cid, " (commit" + , maybe "" (\name -> " from ‘" <> textRepoName name <> "’ repo") mbrepo + , ")" + ] + JobIdTree mbrepo subtree cid -> outputMessage out $ T.concat + [ textTreeId cid, " (tree" + , maybe "" (\name -> " from ‘" <> textRepoName name <> "’ repo") mbrepo + , if not (null subtree) then ", subtree ‘" <> T.pack subtree <> "’" else "" + , ")" + ] diff --git a/src/Command/Log.hs b/src/Command/Log.hs new file mode 100644 index 0000000..e48ce8f --- /dev/null +++ b/src/Command/Log.hs @@ -0,0 +1,45 @@ +module Command.Log ( + LogCommand, +) where + +import Control.Monad.IO.Class + +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.IO qualified as TL + +import System.FilePath + +import Command +import Eval +import Job +import Job.Types +import Output + + +data LogCommand = LogCommand JobRef + +instance Command LogCommand where + commandName _ = "log" + commandDescription _ = "Show log for the given job" + + type CommandArguments LogCommand = Text + + commandUsage _ = T.pack $ unlines $ + [ "Usage: minici log <job ref>" + ] + + commandInit _ _ = LogCommand . parseJobRef + commandExec = cmdLog + + +cmdLog :: LogCommand -> CommandExec () +cmdLog (LogCommand ref) = do + einput <- getEvalInput + jid <- either (tfail . textEvalError) (return . jobId . fst) =<< + liftIO (runEval (evalJobReference ref) einput) + output <- getOutput + storageDir <- getStorageDir + liftIO $ mapM_ (outputEvent output . OutputMessage . TL.toStrict) . TL.lines =<< + TL.readFile (storageDir </> jobStorageSubdir jid </> "log") diff --git a/src/Command/Run.hs b/src/Command/Run.hs index 905204e..a80e15d 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -10,6 +10,7 @@ import Control.Monad.IO.Class import Data.Either import Data.List +import Data.Maybe import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as T @@ -22,6 +23,8 @@ import Command import Config import Eval import Job +import Job.Types +import Output import Repo import Terminal @@ -123,26 +126,76 @@ mergeSources sources = do argumentJobSource :: [ JobName ] -> CommandExec JobSource argumentJobSource [] = emptyJobSource argumentJobSource names = do - config <- getConfig - einput <- getEvalInput - jobsetJobsEither <- fmap Right $ forM names $ \name -> + ( config, jcommit ) <- getJobRoot >>= \case + JobRootConfig config -> do + commit <- sequence . fmap createWipCommit =<< tryGetDefaultRepo + return ( config, commit ) + JobRootRepo repo -> do + commit <- createWipCommit repo + config <- either fail return =<< loadConfigForCommit =<< getCommitTree commit + return ( config, Just commit ) + + jobtree <- case jcommit of + Just commit -> (: []) <$> getCommitTree commit + Nothing -> return [] + let cidPart = map (JobIdTree Nothing "" . treeId) jobtree + forM_ names $ \name -> case find ((name ==) . jobName) (configJobs config) of - Just job -> return job - Nothing -> tfail $ "job `" <> textJobName name <> "' not found" - jobsetCommit <- sequence . fmap createWipCommit =<< tryGetDefaultRepo - oneshotJobSource [ evalJobSet einput JobSet {..} ] + Just _ -> return () + Nothing -> tfail $ "job ‘" <> textJobName name <> "’ not found" + + 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 <- 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 + { jobsetId = () + , jobsetCommit = Just commit + , jobsetJobsEither = Right $ configJobs config + } rangeSource :: Text -> Text -> CommandExec JobSource rangeSource base tip = do + root <- getJobRoot repo <- getDefaultRepo - einput <- getEvalInput commits <- listCommits repo (base <> ".." <> tip) - oneshotJobSource . map (evalJobSet einput) =<< mapM loadJobSetForCommit commits + jobsets <- forM commits $ \commit -> do + tree <- getCommitTree commit + cmdEvalWith (\ei -> ei + { eiCurrentIdRev = JobIdTree Nothing (treeSubdir tree) (treeId tree) : eiCurrentIdRev ei + }) . evalJobSet [ ( Nothing, tree) ] =<< loadJobSetFromRoot root commit + oneshotJobSource jobsets + watchBranchSource :: Text -> CommandExec JobSource watchBranchSource branch = do + root <- getJobRoot repo <- getDefaultRepo - einput <- getEvalInput + einputBase <- getEvalInput getCurrentTip <- watchBranch repo branch let go prev tmvar = do cur <- atomically $ do @@ -153,7 +206,13 @@ watchBranchSource branch = do Nothing -> retry commits <- listCommits repo (textCommitId (commitId prev) <> ".." <> textCommitId (commitId cur)) - jobsets <- map (evalJobSet einput) <$> mapM loadJobSetForCommit commits + jobsets <- forM commits $ \commit -> do + tree <- getCommitTree commit + let einput = einputBase + { eiCurrentIdRev = JobIdTree Nothing (treeSubdir tree) (treeId tree) : eiCurrentIdRev einputBase + } + either (fail . T.unpack . textEvalError) return =<< + flip runEval einput . evalJobSet [ ( Nothing, tree ) ] =<< loadJobSetFromRoot root commit nextvar <- newEmptyTMVarIO atomically $ putTMVar tmvar $ Just ( jobsets, JobSource nextvar ) go cur nextvar @@ -164,20 +223,26 @@ watchBranchSource branch = do Just commit -> void $ forkIO $ go commit tmvar Nothing -> do - T.hPutStrLn stderr $ "Branch `" <> branch <> "' not found" + T.hPutStrLn stderr $ "Branch ‘" <> branch <> "’ not found" atomically $ putTMVar tmvar Nothing return $ JobSource tmvar watchTagSource :: Pattern -> CommandExec JobSource watchTagSource pat = do + root <- getJobRoot chan <- watchTags =<< getDefaultRepo - einput <- getEvalInput + einputBase <- getEvalInput let go tmvar = do tag <- atomically $ readTChan chan if match pat $ T.unpack $ tagTag tag then do - jobset <- evalJobSet einput <$> loadJobSetForCommit (tagObject tag) + tree <- getCommitTree $ tagObject tag + let einput = einputBase + { eiCurrentIdRev = JobIdTree Nothing (treeSubdir tree) (treeId tree) : eiCurrentIdRev einputBase + } + jobset <- either (fail . T.unpack . textEvalError) return =<< + flip runEval einput . evalJobSet [ ( Nothing, tree ) ] =<< loadJobSetFromRoot root (tagObject tag) nextvar <- newEmptyTMVarIO atomically $ putTMVar tmvar $ Just ( [ jobset ], JobSource nextvar ) go nextvar @@ -192,33 +257,41 @@ watchTagSource pat = do cmdRun :: RunCommand -> CommandExec () cmdRun (RunCommand RunOptions {..} args) = do CommonOptions {..} <- getCommonOptions - tout <- getTerminalOutput + output <- getOutput storageDir <- getStorageDir ( rangeOptions, jobOptions ) <- partitionEithers . concat <$> sequence [ forM roRanges $ \range -> case T.splitOn ".." range of - [ base, tip ] -> return $ Left ( Just base, tip ) + [ base, tip ] + | not (T.null base) && not (T.null tip) + -> return $ Left ( Just base, tip ) _ -> tfail $ "invalid range: " <> range , forM roSinceUpstream $ return . Left . ( Nothing, ) , forM args $ \arg -> case T.splitOn ".." arg of - [ base, tip ] -> return $ Left ( Just base, tip ) - [ _ ] -> do - config <- getConfig - if any ((JobName arg ==) . jobName) (configJobs config) - then return $ Right $ JobName arg - else do - liftIO $ T.hPutStrLn stderr $ "standalone `" <> arg <> "' argument deprecated, use `--since-upstream=" <> arg <> "' instead" - return $ Left ( Nothing, arg ) + [ base, tip ] + | not (T.null base) && not (T.null tip) + -> return $ Left ( Just base, tip ) + [ _ ] -> return $ Right arg _ -> tfail $ "invalid argument: " <> arg ] - argumentJobs <- argumentJobSource jobOptions + let ( refOptions, nameOptions ) = partition (T.elem '.') jobOptions + + argumentJobs <- argumentJobSource $ map JobName nameOptions + refJobs <- refJobSource $ map parseJobRef refOptions - let rangeOptions' - | null rangeOptions, null roNewCommitsOn, null roNewTags, null jobOptions = [ ( Nothing, "HEAD" ) ] - | otherwise = rangeOptions + defaultSource <- getJobRoot >>= \case + _ | not (null rangeOptions && null roNewCommitsOn && null roNewTags && null jobOptions) -> do + emptyJobSource - ranges <- forM rangeOptions' $ \( mbBase, paramTip ) -> do + JobRootRepo repo -> do + Just base <- findUpstreamRef repo "HEAD" + rangeSource base "HEAD" + + JobRootConfig config -> do + argumentJobSource (jobName <$> configJobs config) + + ranges <- forM rangeOptions $ \( mbBase, paramTip ) -> do ( base, tip ) <- case mbBase of Just base -> return ( base, paramTip ) Nothing -> do @@ -232,8 +305,8 @@ cmdRun (RunCommand RunOptions {..} args) = do liftIO $ do mngr <- newJobManager storageDir optJobs - source <- mergeSources $ concat [ [ argumentJobs ], ranges, branches, tags ] - headerLine <- newLine tout "" + source <- mergeSources $ concat [ [ defaultSource, argumentJobs, refJobs ], ranges, branches, tags ] + mbHeaderLine <- mapM (flip newLine "") (outputTerminal output) threadCount <- newTVarIO (0 :: Int) let changeCount f = atomically $ do @@ -248,9 +321,10 @@ cmdRun (RunCommand RunOptions {..} args) = do loop pnames (Just ( jobset : rest, next )) = do let names = nub $ (pnames ++) $ map jobName $ jobsetJobs jobset when (names /= pnames) $ do - redrawLine headerLine $ T.concat $ - T.replicate (8 + 50) " " : - map ((" " <>) . fitToLength 7 . textJobName) names + forM_ mbHeaderLine $ \headerLine -> do + redrawLine headerLine $ T.concat $ + T.replicate (8 + 50) " " : + map ((" " <>) . fitToLength 7 . textJobName) names let commit = jobsetCommit jobset shortCid = T.pack $ take 7 $ maybe (repeat ' ') (showCommitId . commitId) commit @@ -258,23 +332,30 @@ cmdRun (RunCommand RunOptions {..} args) = do case jobsetJobsEither jobset of Right jobs -> do - outs <- runJobs mngr tout commit jobs + outs <- runJobs mngr output jobs let findJob name = snd <$> find ((name ==) . jobName . fst) outs - line <- newLine tout "" + statuses = map findJob names + forM_ (outputTerminal output) $ \tout -> do + line <- newLine tout "" + void $ forkIO $ do + displayStatusLine tout line shortCid (" " <> shortDesc) statuses mask $ \restore -> do changeCount (+ 1) - void $ forkIO $ (>> changeCount (subtract 1)) $ - try @SomeException $ restore $ do - displayStatusLine tout line shortCid (" " <> shortDesc) $ map findJob names + void $ forkIO $ do + void $ try @SomeException $ restore $ waitForJobStatuses statuses + changeCount (subtract 1) Left err -> do - void $ newLine tout $ + forM_ (outputTerminal output) $ flip newLine $ "\ESC[91m" <> shortCid <> "\ESC[0m" <> " " <> shortDesc <> " \ESC[91m" <> T.pack err <> "\ESC[0m" + outputEvent output $ TestMessage $ "jobset-fail " <> T.pack err + outputEvent output $ LogMessage $ "Jobset failed: " <> shortCid <> " " <> T.pack err loop names (Just ( rest, next )) handle @SomeException (\_ -> cancelAllJobs mngr) $ do loop [] =<< atomically (takeJobSource source) waitForJobs waitForJobs + outputEvent output $ TestMessage "run-finish" fitToLength :: Int -> Text -> Text @@ -288,7 +369,7 @@ showStatus blink = \case JobWaiting uses -> "\ESC[94m~" <> fitToLength 6 (T.intercalate "," (map textJobName uses)) <> "\ESC[0m" JobSkipped -> "\ESC[0m-\ESC[0m " JobRunning -> "\ESC[96m" <> (if blink then "*" else "•") <> "\ESC[0m " - JobError fnote -> "\ESC[91m" <> fitToLength 7 ("!! [" <> T.pack (show (footnoteNumber fnote)) <> "]") <> "\ESC[0m" + JobError fnote -> "\ESC[91m" <> fitToLength 7 ("!! [" <> T.pack (maybe "?" (show . tfNumber) (footnoteTerminal fnote)) <> "]") <> "\ESC[0m" JobFailed -> "\ESC[91m✗\ESC[0m " JobCancelled -> "\ESC[0mC\ESC[0m " JobDone _ -> "\ESC[92m✓\ESC[0m " @@ -320,3 +401,10 @@ displayStatusLine tout line prefix1 prefix2 statuses = do if all (maybe True jobStatusFinished) ss then return () else go cur + +waitForJobStatuses :: [ Maybe (TVar (JobStatus a)) ] -> IO () +waitForJobStatuses mbstatuses = do + let statuses = catMaybes mbstatuses + atomically $ do + ss <- mapM readTVar statuses + when (any (not . jobStatusFinished) ss) retry diff --git a/src/Command/Shell.hs b/src/Command/Shell.hs new file mode 100644 index 0000000..4cd2b7e --- /dev/null +++ b/src/Command/Shell.hs @@ -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 diff --git a/src/Command/Subtree.hs b/src/Command/Subtree.hs new file mode 100644 index 0000000..15cb2db --- /dev/null +++ b/src/Command/Subtree.hs @@ -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) |