diff options
41 files changed, 3227 insertions, 332 deletions
@@ -1,2 +1,2 @@ -dist-newstyle/ -.minici/ +/dist-newstyle/ +/.minici/ diff --git a/CHANGELOG.md b/CHANGELOG.md index 47e2395..ca09678 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,24 @@ # 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 +* Added `extract` command to extract artifacts +* Added `--terminal-output` and `--log-output` options to set output style +* Run jobs by specifying full job id or reference + +## 0.1.6 -- 2025-03-30 + +* Added `jobid` command resolving job reference to canonical ID +* Fix copying of used artifacts to appropriate working directory + ## 0.1.5 -- 2025-03-20 * Accept job file path on command line diff --git a/erebos-tester.yaml b/erebos-tester.yaml new file mode 100644 index 0000000..2c75d7c --- /dev/null +++ b/erebos-tester.yaml @@ -0,0 +1 @@ +tests: test/script/**/*.et diff --git a/minici.cabal b/minici.cabal index b8fa18a..d209a28 100644 --- a/minici.cabal +++ b/minici.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: minici -version: 0.1.5 +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 @@ -49,12 +49,19 @@ executable minici other-modules: Command Command.Checkout + Command.Extract Command.JobId + Command.Log Command.Run + Command.Shell + Command.Subtree Config + Destination Eval + FileUtils Job Job.Types + Output Paths_minici Repo Terminal @@ -63,6 +70,9 @@ executable minici autogen-modules: Paths_minici + c-sources: + src/FileUtils.c + default-extensions: DefaultSignatures ExistentialQuantification @@ -86,6 +96,7 @@ executable minici TemplateHaskell build-depends: + ansi-terminal ^>= { 0.11, 1.0, 1.1 }, base ^>= { 4.15, 4.16, 4.17, 4.18, 4.19, 4.20, 4.21 }, bytestring ^>= { 0.10, 0.11, 0.12 }, containers ^>= { 0.6, 0.7 }, diff --git a/minici.yaml b/minici.yaml index a3f87f5..d08160d 100644 --- a/minici.yaml +++ b/minici.yaml @@ -1,3 +1,13 @@ job build: shell: - cabal build -fci + - mkdir build + - cp $(cabal list-bin minici) build/minici + artifact bin: + path: build/minici + +job test: + uses: + - build.bin + shell: + - EREBOS_TEST_TOOL='build/minici --test-output' erebos-tester --verbose diff --git a/src/Command.hs b/src/Command.hs index 0d333e8..1ef52ed 100644 --- a/src/Command.hs +++ b/src/Command.hs @@ -9,11 +9,10 @@ module Command ( tfail, CommandInput(..), getCommonOptions, - getConfigPath, - getConfig, + getRootPath, getJobRoot, getRepo, getDefaultRepo, tryGetDefaultRepo, - getEvalInput, - getTerminalOutput, + getEvalInput, cmdEvalWith, + getOutput, getStorageDir, ) where @@ -28,23 +27,25 @@ import Data.Text.IO qualified as T import System.Console.GetOpt import System.Exit -import System.FilePath import System.IO import Config +import Destination import Eval +import Output import Repo -import Terminal data CommonOptions = CommonOptions { optJobs :: Int - , optRepo :: [ DeclaredRepo ] + , optRepo :: [ ( RepoName, FilePath ) ] + , optDestination :: [ ( DestinationName, Text ) ] } defaultCommonOptions :: CommonOptions defaultCommonOptions = CommonOptions { optJobs = 2 , optRepo = [] + , optDestination = [] } class CommandArgumentsType (CommandArguments c) => Command c where @@ -100,34 +101,29 @@ tfail err = liftIO $ do data CommandInput = CommandInput { ciOptions :: CommonOptions - , ciConfigPath :: Maybe FilePath - , ciConfig :: Either String Config + , ciRootPath :: FilePath + , ciJobRoot :: JobRoot , ciContainingRepo :: Maybe Repo , ciOtherRepos :: [ ( RepoName, Repo ) ] - , ciTerminalOutput :: TerminalOutput - , ciStorageDir :: Maybe FilePath + , ciDestinations :: [ ( DestinationName, Destination ) ] + , ciOutput :: Output + , ciStorageDir :: FilePath } getCommonOptions :: CommandExec CommonOptions getCommonOptions = CommandExec (asks ciOptions) -getConfigPath :: CommandExec FilePath -getConfigPath = do - CommandExec (asks ciConfigPath) >>= \case - Nothing -> tfail $ "no job file found" - Just path -> return path +getRootPath :: CommandExec FilePath +getRootPath = CommandExec (asks ciRootPath) -getConfig :: CommandExec Config -getConfig = do - CommandExec (asks ciConfig) >>= \case - Left err -> fail err - Right config -> return config +getJobRoot :: CommandExec JobRoot +getJobRoot = CommandExec (asks ciJobRoot) getRepo :: RepoName -> CommandExec Repo getRepo name = do CommandExec (asks (lookup name . ciOtherRepos)) >>= \case Just repo -> return repo - Nothing -> tfail $ "repo `" <> textRepoName name <> "' not declared" + Nothing -> tfail $ "repo ‘" <> textRepoName name <> "’ not declared" getDefaultRepo :: CommandExec Repo getDefaultRepo = do @@ -140,14 +136,20 @@ tryGetDefaultRepo = CommandExec $ asks ciContainingRepo getEvalInput :: CommandExec EvalInput getEvalInput = CommandExec $ do + eiJobRoot <- asks ciJobRoot + eiRootPath <- asks ciRootPath + eiCurrentIdRev <- return [] eiContainingRepo <- asks ciContainingRepo eiOtherRepos <- asks ciOtherRepos + eiDestinations <- asks ciDestinations return EvalInput {..} -getTerminalOutput :: CommandExec TerminalOutput -getTerminalOutput = CommandExec (asks ciTerminalOutput) +cmdEvalWith :: (EvalInput -> EvalInput) -> Eval a -> CommandExec a +cmdEvalWith f ev = do + either (tfail . textEvalError) return =<< liftIO . runEval ev . f =<< getEvalInput + +getOutput :: CommandExec Output +getOutput = CommandExec (asks ciOutput) getStorageDir :: CommandExec FilePath -getStorageDir = CommandExec (asks ciStorageDir) >>= \case - Just dir -> return dir - Nothing -> ((</> ".minici") . takeDirectory) <$> getConfigPath +getStorageDir = CommandExec (asks ciStorageDir) diff --git a/src/Command/Extract.hs b/src/Command/Extract.hs new file mode 100644 index 0000000..366128c --- /dev/null +++ b/src/Command/Extract.hs @@ -0,0 +1,101 @@ +module Command.Extract ( + ExtractCommand, +) where + +import Control.Monad +import Control.Monad.Except +import Control.Monad.IO.Class + +import Data.Bifunctor +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, aname ) -> do + [ jid ] <- either tfail (return . map jobId) =<< + return . either (Left . textEvalError) (first T.pack . jobsetJobsEither) =<< + liftIO (runEval (evalJobReference ref) einput) + + tpath <- if + | isdir -> do + wpath <- either tfail return =<< runExceptT (getArtifactWorkPath storageDir jid aname) + return $ extractDestination </> takeFileName wpath + | otherwise -> return extractDestination + + liftIO (doesPathExist tpath) >>= \case + True + | extractForce -> liftIO (doesDirectoryExist tpath) >>= \case + True -> liftIO $ removeDirectoryRecursive tpath + False -> liftIO $ removeFile tpath + | otherwise -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists" + False -> return () + + either tfail return =<< runExceptT (copyArtifact storageDir jid aname tpath) diff --git a/src/Command/JobId.hs b/src/Command/JobId.hs index 9f531d6..b349ebe 100644 --- a/src/Command/JobId.hs +++ b/src/Command/JobId.hs @@ -2,18 +2,27 @@ module Command.JobId ( JobIdCommand, ) where +import Control.Monad import Control.Monad.IO.Class +import Data.Bifunctor 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 +31,45 @@ 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 (return . map jobId) =<< + return . either (Left . textEvalError) (first T.pack . jobsetJobsEither) =<< + 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..438c25e --- /dev/null +++ b/src/Command/Log.hs @@ -0,0 +1,47 @@ +module Command.Log ( + LogCommand, +) where + +import Control.Monad.IO.Class + +import Data.Bifunctor +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 (return . map jobId) =<< + return . either (Left . textEvalError) (first T.pack . jobsetJobsEither) =<< + 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..982a07a 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 @@ -29,12 +32,19 @@ import Terminal data RunCommand = RunCommand RunOptions [ Text ] data RunOptions = RunOptions - { roRanges :: [ Text ] + { roRerun :: RerunOption + , roRanges :: [ Text ] , roSinceUpstream :: [ Text ] , roNewCommitsOn :: [ Text ] , roNewTags :: [ Pattern ] } +data RerunOption + = RerunExplicit + | RerunFailed + | RerunAll + | RerunNone + instance Command RunCommand where commandName _ = "run" commandDescription _ = "Execude jobs per minici.yaml for given commits" @@ -54,14 +64,27 @@ instance Command RunCommand where type CommandOptions RunCommand = RunOptions defaultCommandOptions _ = RunOptions - { roRanges = [] + { roRerun = RerunExplicit + , roRanges = [] , roSinceUpstream = [] , roNewCommitsOn = [] , roNewTags = [] } commandOptions _ = - [ Option [] [ "range" ] + [ Option [] [ "rerun-explicit" ] + (NoArg (\opts -> opts { roRerun = RerunExplicit })) + "rerun jobs given explicitly on command line and their failed dependencies (default)" + , Option [] [ "rerun-failed" ] + (NoArg (\opts -> opts { roRerun = RerunFailed })) + "rerun failed jobs only" + , Option [] [ "rerun-all" ] + (NoArg (\opts -> opts { roRerun = RerunAll })) + "rerun all jobs" + , Option [] [ "rerun-none" ] + (NoArg (\opts -> opts { roRerun = RerunNone })) + "do not rerun any job" + , Option [] [ "range" ] (ReqArg (\val opts -> opts { roRanges = T.pack val : roRanges opts }) "<range>") "run jobs for commits in given range" , Option [] [ "since-upstream" ] @@ -123,26 +146,83 @@ mergeSources sources = do argumentJobSource :: [ JobName ] -> CommandExec JobSource argumentJobSource [] = emptyJobSource argumentJobSource names = do - config <- getConfig - einput <- getEvalInput - jobsetJobsEither <- fmap Right $ forM names $ \name -> + jobRoot <- getJobRoot + ( config, jcommit ) <- case jobRoot of + 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 = case jobRoot of + JobRootConfig {} -> [] + JobRootRepo {} -> 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 = () + , jobsetConfig = Just config + , jobsetCommit = jcommit + , jobsetExplicitlyRequested = names + , 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 + jsets <- foldl' addJobToList [] <$> cmdEvalWith id (mapM evalJobReference refs) + sets <- cmdEvalWith id $ do + forM jsets $ \jset -> do + fillInDependencies $ jset { jobsetExplicitlyRequested = either (const []) (map jobId) $ jobsetJobsEither jset } + oneshotJobSource sets + where + addJobToList :: [ JobSet ] -> JobSet -> [ JobSet ] + addJobToList (cur : rest) jset + | jobsetId cur == jobsetId jset = cur { jobsetJobsEither = (++) <$> (fmap reverse $ jobsetJobsEither jset) <*> (jobsetJobsEither cur) } : rest + | otherwise = cur : addJobToList rest jset + addJobToList [] jset = [ jset ] + +loadJobSetFromRoot :: (MonadIO m, MonadFail m) => JobRoot -> Commit -> m DeclaredJobSet +loadJobSetFromRoot root commit = case root of + JobRootRepo _ -> loadJobSetForCommit commit + JobRootConfig config -> return JobSet + { jobsetId = () + , jobsetConfig = Just config + , jobsetCommit = Just commit + , jobsetExplicitlyRequested = [] + , 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 +233,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 +250,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 +284,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,14 +332,16 @@ 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 writeTVar threadCount . f =<< readTVar threadCount - let waitForJobs = atomically $ do - flip when retry . (0 <) =<< readTVar threadCount + let waitForJobs = do + atomically $ do + flip when retry . (0 <) =<< readTVar threadCount + waitForRemainingTasks mngr let loop _ Nothing = return () loop names (Just ( [], next )) = do @@ -248,9 +350,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 +361,34 @@ cmdRun (RunCommand RunOptions {..} args) = do case jobsetJobsEither jobset of Right jobs -> do - outs <- runJobs mngr tout commit jobs + outs <- runJobs mngr output jobs $ case roRerun of + RerunExplicit -> \jid status -> jid `elem` jobsetExplicitlyRequested jobset || jobStatusFailed status + RerunFailed -> \_ status -> jobStatusFailed status + RerunAll -> \_ _ -> True + RerunNone -> \_ _ -> False 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 @@ -284,22 +398,26 @@ fitToLength maxlen str | len <= maxlen = str <> T.replicate (maxlen - len) " " showStatus :: Bool -> JobStatus a -> Text showStatus blink = \case - JobQueued -> "\ESC[94m…\ESC[0m " + JobQueued -> " \ESC[94m…\ESC[0m " 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" - JobFailed -> "\ESC[91m✗\ESC[0m " - JobCancelled -> "\ESC[0mC\ESC[0m " - JobDone _ -> "\ESC[92m✓\ESC[0m " + JobSkipped -> " \ESC[0m-\ESC[0m " + JobRunning -> " \ESC[96m" <> (if blink then "*" else "•") <> "\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 " JobDuplicate _ s -> case s of - JobQueued -> "\ESC[94m^\ESC[0m " - JobWaiting _ -> "\ESC[94m^\ESC[0m " - JobSkipped -> "\ESC[0m-\ESC[0m " - JobRunning -> "\ESC[96m" <> (if blink then "*" else "^") <> "\ESC[0m " + JobQueued -> " \ESC[94m^\ESC[0m " + JobWaiting _ -> " \ESC[94m^\ESC[0m " + JobSkipped -> " \ESC[0m-\ESC[0m " + JobRunning -> " \ESC[96m" <> (if blink then "*" else "^") <> "\ESC[0m " _ -> showStatus blink s + JobPreviousStatus (JobDone _) -> "\ESC[90m«\ESC[32m✓\ESC[0m " + JobPreviousStatus (JobFailed) -> "\ESC[90m«\ESC[31m✗\ESC[0m " + JobPreviousStatus s -> "\ESC[90m«" <> T.init (showStatus blink s) + displayStatusLine :: TerminalOutput -> TerminalLine -> Text -> Text -> [ Maybe (TVar (JobStatus JobOutput)) ] -> IO () displayStatusLine tout line prefix1 prefix2 statuses = do go "\0" @@ -320,3 +438,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..dfff50a --- /dev/null +++ b/src/Command/Shell.hs @@ -0,0 +1,48 @@ +module Command.Shell ( + ShellCommand, +) where + +import Control.Monad +import Control.Monad.IO.Class + +import Data.Bifunctor +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 return =<< + return . either (Left . textEvalError) (first T.pack . jobsetJobsEither) =<< + 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) diff --git a/src/Config.hs b/src/Config.hs index 5631179..fb3a828 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -1,4 +1,5 @@ module Config ( + JobRoot(..), Config(..), findConfig, parseConfig, @@ -12,7 +13,6 @@ import Control.Monad.Combinators import Control.Monad.IO.Class import Data.ByteString.Lazy qualified as BS -import Data.Either import Data.List import Data.Map qualified as M import Data.Maybe @@ -26,6 +26,7 @@ import System.FilePath import System.FilePath.Glob import System.Process +import Destination import Job.Types import Repo @@ -34,21 +35,29 @@ configFileName :: FilePath configFileName = "minici.yaml" +data JobRoot + = JobRootRepo Repo + | JobRootConfig Config + + data Config = Config { configJobs :: [ DeclaredJob ] , configRepos :: [ DeclaredRepo ] + , configDestinations :: [ DeclaredDestination ] } instance Semigroup Config where a <> b = Config { configJobs = configJobs a ++ configJobs b , configRepos = configRepos a ++ configRepos b + , configDestinations = configDestinations a ++ configDestinations b } instance Monoid Config where mempty = Config { configJobs = [] , configRepos = [] + , configDestinations = [] } instance FromYAML Config where @@ -67,37 +76,45 @@ instance FromYAML Config where | [ "repo", name ] <- T.words tag -> do repo <- parseRepo name node return $ config { configRepos = configRepos config ++ [ repo ] } + | [ "destination", name ] <- T.words tag -> do + destination <- parseDestination name node + return $ config { configDestinations = configDestinations config ++ [ destination ] } _ -> return config parseJob :: Text -> Node Pos -> Parser DeclaredJob parseJob name node = flip (withMap "Job") node $ \j -> do let jobName = JobName name - ( jobContainingCheckout, jobOtherCheckout ) <- partitionEithers <$> choice + jobId = jobName + jobRecipe <- choice + [ fmap Just $ cabalJob =<< j .: "cabal" + , fmap Just $ shellJob =<< j .: "shell" + , return Nothing + ] + jobCheckout <- choice [ parseSingleCheckout =<< j .: "checkout" , parseMultipleCheckouts =<< j .: "checkout" , withNull "no checkout" (return []) =<< j .: "checkout" - , return [ Left $ JobCheckout Nothing Nothing ] - ] - jobRecipe <- choice - [ cabalJob =<< j .: "cabal" - , shellJob =<< j .: "shell" + , return $ if isJust jobRecipe + then [ JobCheckout Nothing Nothing Nothing ] + else [] ] jobArtifacts <- parseArtifacts j jobUses <- maybe (return []) parseUses =<< j .:? "uses" + jobPublish <- maybe (return []) (parsePublish jobName) =<< j .:? "publish" return Job {..} -parseSingleCheckout :: Node Pos -> Parser [ Either JobCheckout ( JobRepo Declared, Maybe Text, JobCheckout ) ] +parseSingleCheckout :: Node Pos -> Parser [ JobCheckout Declared ] parseSingleCheckout = withMap "checkout definition" $ \m -> do jcSubtree <- fmap T.unpack <$> m .:? "subtree" jcDestination <- fmap T.unpack <$> m .:? "dest" - let checkout = JobCheckout {..} - m .:? "repo" >>= \case - Nothing -> return [ Left checkout ] + jcRepo <- m .:? "repo" >>= \case + Nothing -> return Nothing Just name -> do revision <- m .:? "revision" - return [ Right ( DeclaredJobRepo (RepoName name), revision, checkout ) ] + return $ Just ( RepoName name, revision ) + return [ JobCheckout {..} ] -parseMultipleCheckouts :: Node Pos -> Parser [ Either JobCheckout ( JobRepo Declared, Maybe Text, JobCheckout ) ] +parseMultipleCheckouts :: Node Pos -> Parser [ JobCheckout Declared ] parseMultipleCheckouts = withSeq "checkout definitions" $ fmap concat . mapM parseSingleCheckout cabalJob :: Node Pos -> Parser [CreateProcess] @@ -130,11 +147,34 @@ parseUses = withSeq "Uses list" $ mapM $ [job, art] <- return $ T.split (== '.') text return (JobName job, ArtifactName art) +parsePublish :: JobName -> Node Pos -> Parser [ JobPublish Declared ] +parsePublish ownName = withSeq "Publish list" $ mapM $ + withMap "Publish specification" $ \m -> do + artifact <- m .: "artifact" + jpArtifact <- case T.split (== '.') artifact of + [ job, art ] -> return ( JobName job, ArtifactName art ) + [ art ] -> return ( ownName, ArtifactName art ) + _ -> mzero + jpDestination <- DestinationName <$> m .: "to" + jpPath <- fmap T.unpack <$> m .:? "path" + return JobPublish {..} + parseRepo :: Text -> Node Pos -> Parser DeclaredRepo -parseRepo name node = flip (withMap "Repo") node $ \r -> DeclaredRepo - <$> pure (RepoName name) - <*> (T.unpack <$> r .: "path") +parseRepo name node = choice + [ flip (withNull "Repo") node $ return $ DeclaredRepo (RepoName name) Nothing + , flip (withMap "Repo") node $ \r -> DeclaredRepo + <$> pure (RepoName name) + <*> (fmap T.unpack <$> r .:? "path") + ] + +parseDestination :: Text -> Node Pos -> Parser DeclaredDestination +parseDestination name node = choice + [ flip (withNull "Destination") node $ return $ DeclaredDestination (DestinationName name) Nothing + , flip (withMap "Destination") node $ \r -> DeclaredDestination + <$> pure (DestinationName name) + <*> (r .:? "url") + ] findConfig :: IO (Maybe FilePath) @@ -167,6 +207,9 @@ loadJobSetForCommit :: (MonadIO m, MonadFail m) => Commit -> m DeclaredJobSet loadJobSetForCommit commit = return . toJobSet =<< loadConfigForCommit =<< getCommitTree commit where toJobSet configEither = JobSet - { jobsetCommit = Just commit + { jobsetId = () + , jobsetConfig = either (const Nothing) Just configEither + , jobsetCommit = Just commit + , jobsetExplicitlyRequested = [] , jobsetJobsEither = fmap configJobs configEither } diff --git a/src/Config.hs-boot b/src/Config.hs-boot new file mode 100644 index 0000000..ee6b0d1 --- /dev/null +++ b/src/Config.hs-boot @@ -0,0 +1,3 @@ +module Config where + +data Config diff --git a/src/Destination.hs b/src/Destination.hs new file mode 100644 index 0000000..4fd8cd8 --- /dev/null +++ b/src/Destination.hs @@ -0,0 +1,54 @@ +module Destination ( + Destination, + DeclaredDestination(..), + DestinationName(..), textDestinationName, showDestinationName, + + openDestination, + copyToDestination, + + copyRecursive, + copyRecursiveForce, +) where + +import Control.Monad.IO.Class + +import Data.Text (Text) +import Data.Text qualified as T + +import System.FilePath +import System.Directory + +import FileUtils + + +data Destination + = FilesystemDestination FilePath + +data DeclaredDestination = DeclaredDestination + { destinationName :: DestinationName + , destinationUrl :: Maybe Text + } + + +newtype DestinationName = DestinationName Text + deriving (Eq, Ord, Show) + +textDestinationName :: DestinationName -> Text +textDestinationName (DestinationName text) = text + +showDestinationName :: DestinationName -> String +showDestinationName = T.unpack . textDestinationName + + +openDestination :: FilePath -> Text -> IO Destination +openDestination baseDir url = do + let path = baseDir </> T.unpack url + createDirectoryIfMissing True path + return $ FilesystemDestination path + +copyToDestination :: MonadIO m => FilePath -> Destination -> FilePath -> m () +copyToDestination source (FilesystemDestination base) inner = do + let target = base </> dropWhile isPathSeparator inner + liftIO $ do + createDirectoryIfMissing True $ takeDirectory target + copyRecursiveForce source target diff --git a/src/Eval.hs b/src/Eval.hs index 1828468..1b0d7dd 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -6,24 +6,35 @@ module Eval ( evalJob, evalJobSet, evalJobReference, + + loadJobSetById, + fillInDependencies, ) where import Control.Monad import Control.Monad.Except import Control.Monad.Reader -import Data.Bifunctor import Data.List +import Data.Maybe +import Data.Set qualified as S import Data.Text (Text) import Data.Text qualified as T +import System.FilePath + import Config +import Destination import Job.Types import Repo data EvalInput = EvalInput - { eiContainingRepo :: Maybe Repo + { eiJobRoot :: JobRoot + , eiRootPath :: FilePath + , eiCurrentIdRev :: [ JobIdPart ] + , eiContainingRepo :: Maybe Repo , eiOtherRepos :: [ ( RepoName, Repo ) ] + , eiDestinations :: [ ( DestinationName, Destination ) ] } data EvalError @@ -39,73 +50,275 @@ runEval :: Eval a -> EvalInput -> IO (Either EvalError a) runEval action einput = runExceptT $ flip runReaderT einput action -evalJob :: EvalInput -> DeclaredJob -> Except EvalError Job -evalJob EvalInput {..} decl = do - otherCheckout <- forM (jobOtherCheckout decl) $ \( DeclaredJobRepo name, revision, checkout ) -> do - repo <- maybe (throwError $ OtherEvalError $ "repo `" <> textRepoName name <> "' not defined") return $ - lookup name eiOtherRepos - return ( EvaluatedJobRepo repo, revision, checkout ) - return Job - { jobName = jobName decl - , jobContainingCheckout = jobContainingCheckout decl - , jobOtherCheckout = otherCheckout - , jobRecipe = jobRecipe decl - , jobArtifacts = jobArtifacts decl - , jobUses = jobUses decl - } +commonPrefix :: Eq a => [ a ] -> [ a ] -> [ a ] +commonPrefix (x : xs) (y : ys) | x == y = x : commonPrefix xs ys +commonPrefix _ _ = [] + +checkIfAlreadyHasDefaultRepoId :: Eval Bool +checkIfAlreadyHasDefaultRepoId = do + asks (any isDefaultRepoId . eiCurrentIdRev) + where + isDefaultRepoId (JobIdName _) = False + isDefaultRepoId (JobIdCommit rname _) = isNothing rname + isDefaultRepoId (JobIdTree rname _ _) = isNothing rname + +collectJobSetRepos :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> Eval [ ( Maybe RepoName, Tree ) ] +collectJobSetRepos revisionOverrides dset = do + jobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither dset + let someJobUsesDefaultRepo = any (any (isNothing . jcRepo) . jobCheckout) jobs + repos = + (if someJobUsesDefaultRepo then (Nothing :) else id) $ + map (Just . repoName) $ maybe [] configRepos $ jobsetConfig dset + forM repos $ \rname -> do + case lookup rname revisionOverrides of + Just tree -> return ( rname, tree ) + Nothing -> do + repo <- evalRepo rname + tree <- getCommitTree =<< readCommit repo "HEAD" + return ( rname, tree ) + +collectOtherRepos :: DeclaredJobSet -> DeclaredJob -> Eval [ ( Maybe ( RepoName, Maybe Text ), FilePath ) ] +collectOtherRepos dset decl = do + jobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither dset + let gatherDependencies seen (d : ds) + | d `elem` seen = gatherDependencies seen ds + | Just job <- find ((d ==) . jobName) jobs + = gatherDependencies (d : seen) (map fst (jobRequiredArtifacts job) ++ ds) + | otherwise = gatherDependencies (d : seen) ds + gatherDependencies seen [] = seen + + let dependencies = gatherDependencies [] [ jobName decl ] + dependencyRepos <- forM dependencies $ \name -> do + job <- maybe (throwError $ OtherEvalError $ "job ‘" <> textJobName name <> "’ not found") return . find ((name ==) . jobName) $ jobs + return $ jobCheckout job + + alreadyHasDefaultRepoId <- checkIfAlreadyHasDefaultRepoId + let checkouts = + (if alreadyHasDefaultRepoId then filter (isJust . jcRepo) else id) $ + concat dependencyRepos -evalJobSet :: EvalInput -> DeclaredJobSet -> JobSet -evalJobSet ei decl = do - JobSet - { jobsetCommit = jobsetCommit decl - , jobsetJobsEither = join $ - fmap (sequence . map (runExceptStr . evalJob ei)) $ - jobsetJobsEither decl + let commonSubdir reporev = joinPath $ foldr1 commonPrefix $ + map (maybe [] splitDirectories . jcSubtree) . filter ((reporev ==) . jcRepo) $ checkouts + let canonicalRepoOrder = Nothing : maybe [] (map (Just . repoName) . configRepos) (jobsetConfig dset) + getCheckoutsForName rname = map (\r -> ( r, commonSubdir r )) $ nub $ filter ((rname ==) . fmap fst) $ map jcRepo checkouts + return $ concatMap getCheckoutsForName canonicalRepoOrder + + +evalJob :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> DeclaredJob -> Eval ( Job, JobSetId ) +evalJob revisionOverrides dset decl = do + EvalInput {..} <- ask + otherRepos <- collectOtherRepos dset decl + otherRepoTrees <- forM otherRepos $ \( mbrepo, commonPath ) -> do + ( mbrepo, ) . ( commonPath, ) <$> do + case lookup (fst <$> mbrepo) revisionOverrides of + Just tree -> return tree + Nothing -> do + repo <- evalRepo (fst <$> mbrepo) + commit <- readCommit repo (fromMaybe "HEAD" $ join $ snd <$> mbrepo) + getSubtree (Just commit) commonPath =<< getCommitTree commit + + checkouts <- forM (jobCheckout decl) $ \dcheckout -> do + return dcheckout + { jcRepo = + fromMaybe (error $ "expecting repo in either otherRepoTrees or revisionOverrides: " <> show (textRepoName . fst <$> jcRepo dcheckout)) $ + msum + [ snd <$> lookup (jcRepo dcheckout) otherRepoTrees + , lookup (fst <$> jcRepo dcheckout) revisionOverrides + ] + } + + destinations <- forM (jobPublish decl) $ \dpublish -> do + case lookup (jpDestination dpublish) eiDestinations of + Just dest -> return $ dpublish { jpDestination = dest } + Nothing -> throwError $ OtherEvalError $ "no url defined for destination ‘" <> textDestinationName (jpDestination dpublish) <> "’" + + let otherRepoIds = flip mapMaybe otherRepoTrees $ \case + ( repo, ( subtree, tree )) -> do + guard $ maybe True (isNothing . snd) repo -- use only checkouts without explicit revision in job id + Just $ JobIdTree (fst <$> repo) subtree (treeId tree) + 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 + , jobPublish = destinations + } + , JobSetId $ reverse $ reverse otherRepoIds ++ eiCurrentIdRev + ) + +evalJobSet :: [ ( Maybe RepoName, Tree ) ] -> DeclaredJobSet -> Eval JobSet +evalJobSet revisionOverrides decl = do + EvalInput {..} <- ask + repos <- collectJobSetRepos revisionOverrides decl + alreadyHasDefaultRepoId <- checkIfAlreadyHasDefaultRepoId + let addedRepoIds = + map (\( mbname, tree ) -> JobIdTree mbname "" (treeId tree)) $ + (if alreadyHasDefaultRepoId then filter (isJust . fst) else id) $ + repos + + jobs <- fmap (fmap (map fst)) + $ either (return . Left) (handleToEither . mapM (evalJob revisionOverrides decl)) + $ jobsetJobsEither decl + let explicit = + case liftM2 zip (jobsetJobsEither decl) jobs of + Left _ -> [] + Right declEval -> catMaybes $ + map (\jid -> jobId . snd <$> find ((jid ==) . jobId . fst) declEval) $ jobsetExplicitlyRequested decl + return JobSet + { jobsetId = JobSetId $ reverse $ reverse addedRepoIds ++ eiCurrentIdRev + , jobsetConfig = jobsetConfig decl + , jobsetCommit = jobsetCommit decl + , jobsetExplicitlyRequested = explicit + , jobsetJobsEither = jobs } where - runExceptStr = first (T.unpack . textEvalError) . runExcept + handleToEither = flip catchError (return . Left . T.unpack . textEvalError) . fmap Right + +evalRepo :: Maybe RepoName -> Eval Repo +evalRepo Nothing = asks eiContainingRepo >>= \case + Just repo -> return repo + Nothing -> throwError $ OtherEvalError $ "no default repo" +evalRepo (Just name) = asks (lookup name . eiOtherRepos) >>= \case + Just repo -> return repo + Nothing -> throwError $ OtherEvalError $ "repo ‘" <> textRepoName name <> "’ not defined" -canonicalJobName :: [ Text ] -> Config -> Eval [ JobIdPart ] -canonicalJobName (r : rs) config = do - einput <- ask +canonicalJobName :: [ Text ] -> Config -> Maybe Tree -> Eval JobSet +canonicalJobName (r : rs) config mbDefaultRepo = do let name = JobName r + dset = JobSet + { jobsetId = () + , jobsetConfig = Just config + , jobsetCommit = Nothing + , jobsetExplicitlyRequested = [] + , jobsetJobsEither = Right $ configJobs config + } case find ((name ==) . jobName) (configJobs config) of Just djob -> do - job <- either throwError return $ runExcept $ evalJob einput djob - let repos = nub $ map (\( EvaluatedJobRepo repo, _, _ ) -> repo) $ jobOtherCheckout job - (JobIdName name :) <$> canonicalOtherCheckouts rs repos + otherRepos <- collectOtherRepos dset djob + ( overrides, rs' ) <- (\f -> foldM f ( [], rs ) otherRepos) $ + \( overrides, crs ) ( mbrepo, path ) -> if + | Just ( _, Just _ ) <- mbrepo -> do + -- use only checkouts without explicit revision in job id + return ( overrides, crs ) + | otherwise -> do + ( tree, crs' ) <- readTreeFromIdRef crs path =<< evalRepo (fst <$> mbrepo) + return ( ( fst <$> mbrepo, tree ) : overrides, crs' ) + case rs' of + (r' : _) -> throwError $ OtherEvalError $ "unexpected job ref part ‘" <> r' <> "’" + _ -> return () + eset <- evalJobSet (maybe id ((:) . ( Nothing, )) mbDefaultRepo $ overrides) dset + return eset { jobsetJobsEither = fmap (filter ((name ==) . jobName)) $ jobsetJobsEither eset } Nothing -> throwError $ OtherEvalError $ "job ‘" <> r <> "’ not found" -canonicalJobName [] _ = throwError $ OtherEvalError "expected job name" - -canonicalOtherCheckouts :: [ Text ] -> [ Repo ] -> Eval [ JobIdPart ] -canonicalOtherCheckouts (r : rs) (repo : repos) = do - tree <- tryReadCommit repo r >>= \case - Just commit -> getCommitTree commit - Nothing -> tryReadTree repo r >>= \case - Just tree -> return tree - Nothing -> throwError $ OtherEvalError $ "failed to resolve ‘" <> r <> "’ to a commit or tree in " <> T.pack (show repo) - (JobIdTree (treeId tree) :) <$> canonicalOtherCheckouts rs repos -canonicalOtherCheckouts [] [] = return [] -canonicalOtherCheckouts [] (_ : _ ) = throwError $ OtherEvalError $ "expected commit or tree reference" -canonicalOtherCheckouts (r : _) [] = throwError $ OtherEvalError $ "unexpected job ref part ‘" <> r <> "’" - -canonicalCommitConfig :: [ Text ] -> Repo -> Eval [ JobIdPart ] -canonicalCommitConfig (r : rs) repo = do - tree <- tryReadCommit repo r >>= \case - Just commit -> getCommitTree commit - Nothing -> tryReadTree repo r >>= \case - Just tree -> return tree +canonicalJobName [] _ _ = throwError $ OtherEvalError "expected job name" + +readTreeFromIdRef :: [ Text ] -> FilePath -> Repo -> Eval ( Tree, [ Text ] ) +readTreeFromIdRef (r : rs) subdir repo = do + tryReadCommit repo r >>= \case + Just commit -> return . (, rs) =<< getSubtree (Just commit) subdir =<< getCommitTree commit + Nothing -> tryReadTree repo subdir r >>= \case + Just tree -> return ( tree, rs ) 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 JobSet +canonicalCommitConfig rs repo = do + ( tree, rs' ) <- readTreeFromIdRef rs "" repo config <- either fail return =<< loadConfigForCommit tree - (JobIdTree (treeId tree) :) <$> canonicalJobName rs config -canonicalCommitConfig [] _ = throwError $ OtherEvalError "expected commit or tree reference" - -evalJobReference :: Config -> JobRef -> Eval JobId -evalJobReference config (JobRef rs) = - fmap JobId $ do - asks eiContainingRepo >>= \case - Just defRepo -> do - canonicalCommitConfig rs defRepo - Nothing -> do - canonicalJobName rs config + local (\ei -> ei { eiCurrentIdRev = JobIdTree Nothing "" (treeId tree) : eiCurrentIdRev ei }) $ + canonicalJobName rs' config (Just tree) + +evalJobReference :: JobRef -> Eval JobSet +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 () (Just config) 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) + eset <- local (\ei -> ei { eiCurrentIdRev = idRev }) $ do + evalJobSet otherRepos dset + origJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither jset + allJobs <- either (throwError . OtherEvalError . T.pack) return $ jobsetJobsEither eset + deps <- gather allJobs S.empty (map jobName origJobs) + + let jobs = catMaybes $ flip map allJobs $ \ejob -> if + | Just job <- find ((jobName ejob ==) . jobName) origJobs + -> Just job + + | jobName ejob `S.member` deps + -> Just ejob + + | otherwise + -> 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) ++ map (fst . jpArtifact) (jobPublish djob) ++ rest + + | otherwise + = throwError $ OtherEvalError $ "dependency ‘" <> textJobName name <> "’ not found" + + gather _ cur [] = return cur diff --git a/src/FileUtils.c b/src/FileUtils.c new file mode 100644 index 0000000..3cf2997 --- /dev/null +++ b/src/FileUtils.c @@ -0,0 +1,18 @@ +#include <fcntl.h> +#include <sys/stat.h> +#include <unistd.h> + +int minici_fd_open_read( const char * from ) +{ + return open( from, O_RDONLY | O_CLOEXEC ); +} + +int minici_fd_create_write( const char * from, int fd_perms ) +{ + struct stat st; + mode_t mode = 0600; + if( fstat( fd_perms, & st ) == 0 ) + mode = st.st_mode; + + return open( from, O_CREAT | O_WRONLY | O_TRUNC | O_CLOEXEC, mode ); +} diff --git a/src/FileUtils.hs b/src/FileUtils.hs new file mode 100644 index 0000000..a59548f --- /dev/null +++ b/src/FileUtils.hs @@ -0,0 +1,69 @@ +module FileUtils where + +import Control.Monad +import Control.Monad.Catch + +import Data.ByteString (useAsCString) +import Data.Text qualified as T +import Data.Text.Encoding + +import Foreign.C.Error +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Ptr + +import System.Directory +import System.FilePath +import System.Posix.IO.ByteString +import System.Posix.Types + + +-- As of directory-1.3.9 and file-io-0.1.5, the provided copyFile creates a +-- temporary file without O_CLOEXEC, sometimes leaving the write descriptor +-- open in child processes. +safeCopyFile :: FilePath -> FilePath -> IO () +safeCopyFile from to = do + allocaBytes (fromIntegral bufferSize) $ \buf -> + useAsCString (encodeUtf8 $ T.pack from) $ \cfrom -> + useAsCString (encodeUtf8 $ T.pack to) $ \cto -> + bracket (throwErrnoPathIfMinus1 "open" from $ c_fd_open_read cfrom) closeFd $ \fromFd -> + bracket (throwErrnoPathIfMinus1 "open" to $ c_fd_create_write cto fromFd) closeFd $ \toFd -> do + let goRead = do + count <- throwErrnoIfMinus1Retry ("read " <> from) $ fdReadBuf fromFd buf bufferSize + when (count > 0) $ do + goWrite count 0 + goWrite count written + | written < count = do + written' <- throwErrnoIfMinus1Retry ("write " <> to) $ + fdWriteBuf toFd (buf `plusPtr` fromIntegral written) (count - written) + goWrite count (written + written') + | otherwise = do + goRead + goRead + where + bufferSize = 131072 + +-- Custom open(2) wrappers using O_CLOEXEC. The `cloexec` in `OpenFileFlags` is +-- available only since unix-2.8.0.0 +foreign import ccall "minici_fd_open_read" c_fd_open_read :: CString -> IO Fd +foreign import ccall "minici_fd_create_write" c_fd_create_write :: CString -> Fd -> IO Fd + + +copyRecursive :: FilePath -> FilePath -> IO () +copyRecursive from to = do + doesDirectoryExist from >>= \case + False -> do + safeCopyFile 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 @@ -7,7 +7,16 @@ module Job ( JobStatus(..), jobStatusFinished, jobStatusFailed, JobManager(..), newJobManager, cancelAllJobs, - runJobs, + runJobs, waitForRemainingTasks, + + prepareJob, + getArtifactWorkPath, + copyArtifact, + + jobStorageSubdir, + + copyRecursive, + copyRecursiveForce, ) where import Control.Concurrent @@ -37,14 +46,14 @@ import System.IO.Temp import System.Posix.Signals import System.Process +import Destination import Job.Types +import Output import Repo -import Terminal data JobOutput = JobOutput - { outName :: JobName - , outArtifacts :: [ArtifactOutput] + { outArtifacts :: [ArtifactOutput] } deriving (Eq) @@ -58,10 +67,11 @@ data ArtifactOutput = ArtifactOutput data JobStatus a = JobQueued | JobDuplicate JobId (JobStatus a) + | JobPreviousStatus (JobStatus a) | JobWaiting [JobName] | JobRunning | JobSkipped - | JobError TerminalFootnote + | JobError OutputFootnote | JobFailed | JobCancelled | JobDone a @@ -69,31 +79,58 @@ data JobStatus a = JobQueued jobStatusFinished :: JobStatus a -> Bool jobStatusFinished = \case - JobQueued {} -> False - JobDuplicate _ s -> jobStatusFinished s - JobWaiting {} -> False - JobRunning {} -> False - _ -> True + JobQueued {} -> False + JobDuplicate _ s -> jobStatusFinished s + JobPreviousStatus s -> jobStatusFinished s + JobWaiting {} -> False + JobRunning {} -> False + _ -> True jobStatusFailed :: JobStatus a -> Bool jobStatusFailed = \case - JobDuplicate _ s -> jobStatusFailed s - JobError {} -> True - JobFailed {} -> True - _ -> False + JobDuplicate _ s -> jobStatusFailed s + JobPreviousStatus s -> jobStatusFailed s + JobError {} -> True + JobFailed {} -> True + _ -> False + +jobResult :: JobStatus a -> Maybe a +jobResult = \case + JobDone x -> Just x + JobDuplicate _ s -> jobResult s + JobPreviousStatus s -> jobResult s + _ -> Nothing textJobStatus :: JobStatus a -> Text textJobStatus = \case JobQueued -> "queued" JobDuplicate {} -> "duplicate" + JobPreviousStatus s -> textJobStatus s JobWaiting _ -> "waiting" JobRunning -> "running" JobSkipped -> "skipped" - JobError err -> "error\n" <> footnoteText err + JobError _ -> "error" JobFailed -> "failed" JobCancelled -> "cancelled" JobDone _ -> "done" +readJobStatus :: (MonadIO m) => Output -> Text -> m a -> m (Maybe (JobStatus a)) +readJobStatus tout text readResult = case T.lines text of + "queued" : _ -> return (Just JobQueued) + "running" : _ -> return (Just JobRunning) + "skipped" : _ -> return (Just JobSkipped) + "error" : note : _ -> Just . JobError <$> liftIO (outputFootnote tout note) + "failed" : _ -> return (Just JobFailed) + "cancelled" : _ -> return (Just JobCancelled) + "done" : _ -> Just . JobDone <$> readResult + _ -> return Nothing + +textJobStatusDetails :: JobStatus a -> Text +textJobStatusDetails = \case + JobError err -> footnoteText err <> "\n" + JobPreviousStatus s -> textJobStatusDetails s + _ -> "" + data JobManager = JobManager { jmSemaphore :: TVar Int @@ -104,6 +141,7 @@ data JobManager = JobManager , jmReadyTasks :: TVar (Set TaskId) , jmRunningTasks :: TVar (Map TaskId ThreadId) , jmCancelled :: TVar Bool + , jmOpenStatusUpdates :: TVar Int } newtype TaskId = TaskId Int @@ -124,6 +162,7 @@ newJobManager jmDataDir queueLen = do jmReadyTasks <- newTVarIO S.empty jmRunningTasks <- newTVarIO M.empty jmCancelled <- newTVarIO False + jmOpenStatusUpdates <- newTVarIO 0 return JobManager {..} cancelAllJobs :: JobManager -> IO () @@ -181,30 +220,32 @@ runManagedJob JobManager {..} tid cancel job = bracket acquire release $ \case writeTVar jmRunningTasks . M.delete tid =<< readTVar jmRunningTasks -runJobs :: JobManager -> TerminalOutput -> Maybe Commit -> [ Job ] -> IO [ ( Job, TVar (JobStatus JobOutput) ) ] -runJobs mngr@JobManager {..} tout commit jobs = do - tree <- sequence $ fmap getCommitTree commit +runJobs :: JobManager -> Output -> [ Job ] + -> (JobId -> JobStatus JobOutput -> Bool) -- ^ Rerun condition + -> IO [ ( Job, TVar (JobStatus JobOutput) ) ] +runJobs mngr@JobManager {..} tout jobs rerun = do results <- atomically $ do forM jobs $ \job -> do - let jid = JobId $ concat [ JobIdTree . treeId <$> maybeToList tree, [ JobIdName (jobName job) ] ] tid <- reserveTaskId mngr managed <- readTVar jmJobs - ( job, tid, ) <$> case M.lookup jid managed of + ( job, tid, ) <$> case M.lookup (jobId job) managed of Just origVar -> do - newTVar . JobDuplicate jid =<< readTVar origVar + newTVar . JobDuplicate (jobId job) =<< readTVar origVar Nothing -> do statusVar <- newTVar JobQueued - writeTVar jmJobs $ M.insert jid statusVar managed + writeTVar jmJobs $ M.insert (jobId job) statusVar managed return statusVar forM_ results $ \( job, tid, outVar ) -> void $ forkIO $ do - let handler e = if - | Just JobCancelledException <- fromException e -> do - atomically $ writeTVar outVar $ JobCancelled - | otherwise -> do - footnote <- newFootnote tout $ T.pack $ displayException e - atomically $ writeTVar outVar $ JobError footnote + let handler e = do + status <- if + | Just JobCancelledException <- fromException e -> do + return JobCancelled + | otherwise -> do + JobError <$> outputFootnote tout (T.pack $ displayException e) + atomically $ writeTVar outVar status + outputJobFinishedEvent tout job status handle handler $ do res <- runExceptT $ do duplicate <- liftIO $ atomically $ do @@ -216,12 +257,22 @@ runJobs mngr@JobManager {..} tout commit jobs = do case duplicate of Nothing -> do - uses <- waitForUsedArtifacts tout job results outVar - runManagedJob mngr tid (return JobCancelled) $ do - liftIO $ atomically $ writeTVar outVar JobRunning - prepareJob jmDataDir commit job $ \checkoutPath jdir -> do - updateStatusFile (jdir </> "status") outVar - JobDone <$> runJob job uses checkoutPath jdir + let jdir = jmDataDir </> jobStorageSubdir (jobId job) + readStatusFile tout job jdir >>= \case + Just status | status /= JobCancelled && not (rerun (jobId job) status) -> do + let status' = JobPreviousStatus status + liftIO $ atomically $ writeTVar outVar status' + return status' + mbStatus -> do + when (isJust mbStatus) $ do + liftIO $ removeDirectoryRecursive jdir + uses <- waitForUsedArtifacts tout job results outVar + runManagedJob mngr tid (return JobCancelled) $ do + liftIO $ atomically $ writeTVar outVar JobRunning + liftIO $ outputEvent tout $ JobStarted (jobId job) + prepareJob jmDataDir job $ \checkoutPath -> do + updateStatusFile mngr jdir outVar + JobDone <$> runJob job uses checkoutPath jdir Just ( jid, origVar ) -> do let wait = do @@ -239,17 +290,33 @@ runJobs mngr@JobManager {..} tout commit jobs = do liftIO wait atomically $ writeTVar outVar $ either id id res + outputJobFinishedEvent tout job $ either id id res return $ map (\( job, _, var ) -> ( job, var )) results -waitForUsedArtifacts :: (MonadIO m, MonadError (JobStatus JobOutput) m) => - TerminalOutput -> - Job -> [ ( Job, TaskId, TVar (JobStatus JobOutput) ) ] -> TVar (JobStatus JobOutput) -> m [ ArtifactOutput ] +waitForRemainingTasks :: JobManager -> IO () +waitForRemainingTasks JobManager {..} = do + atomically $ do + remainingStatusUpdates <- readTVar jmOpenStatusUpdates + when (remainingStatusUpdates > 0) retry + +waitForUsedArtifacts + :: (MonadIO m, MonadError (JobStatus JobOutput) m) + => Output -> Job + -> [ ( Job, TaskId, TVar (JobStatus JobOutput) ) ] + -> TVar (JobStatus JobOutput) + -> m [ ( ArtifactSpec, ArtifactOutput ) ] waitForUsedArtifacts tout job results outVar = do origState <- liftIO $ atomically $ readTVar outVar - ujobs <- forM (jobUses job) $ \(ujobName@(JobName tjobName), uartName) -> do + let ( selfSpecs, artSpecs ) = partition ((jobName job ==) . fst) $ jobRequiredArtifacts job + + forM_ selfSpecs $ \( _, artName@(ArtifactName tname) ) -> do + when (not (artName `elem` map fst (jobArtifacts job))) $ do + throwError . JobError =<< liftIO (outputFootnote tout $ "Artifact ‘" <> tname <> "’ not produced by the job") + + ujobs <- forM artSpecs $ \(ujobName@(JobName tjobName), uartName) -> do case find (\( j, _, _ ) -> jobName j == ujobName) results of Just ( _, _, var ) -> return ( var, ( ujobName, uartName )) - Nothing -> throwError . JobError =<< liftIO (newFootnote tout $ "Job '" <> tjobName <> "' not found") + Nothing -> throwError . JobError =<< liftIO (outputFootnote tout $ "Job '" <> tjobName <> "' not found") let loop prev = do ustatuses <- atomically $ do @@ -264,60 +331,100 @@ waitForUsedArtifacts tout job results outVar = do else loop $ Just $ map fst ustatuses ustatuses <- liftIO $ loop Nothing - forM ustatuses $ \(ustatus, (JobName tjobName, uartName@(ArtifactName tartName))) -> do - case ustatus of - JobDone out -> case find ((==uartName) . aoutName) $ outArtifacts out of - Just art -> return art - Nothing -> throwError . JobError =<< liftIO (newFootnote tout $ "Artifact '" <> tjobName <> "." <> tartName <> "' not found") + forM ustatuses $ \(ustatus, spec@( JobName tjobName, uartName@(ArtifactName tartName)) ) -> do + case jobResult ustatus of + Just out -> case find ((==uartName) . aoutName) $ outArtifacts out of + Just art -> return ( spec, art ) + Nothing -> throwError . JobError =<< liftIO (outputFootnote tout $ "Artifact '" <> tjobName <> "." <> tartName <> "' not found") _ -> throwError JobSkipped -updateStatusFile :: MonadIO m => FilePath -> TVar (JobStatus JobOutput) -> m () -updateStatusFile path outVar = void $ liftIO $ forkIO $ loop Nothing +outputJobFinishedEvent :: Output -> Job -> JobStatus a -> IO () +outputJobFinishedEvent tout job = \case + JobDuplicate _ s -> outputEvent tout $ JobIsDuplicate (jobId job) (textJobStatus s) + JobPreviousStatus s -> outputEvent tout $ JobPreviouslyFinished (jobId job) (textJobStatus s) + JobSkipped -> outputEvent tout $ JobWasSkipped (jobId job) + s -> outputEvent tout $ JobFinished (jobId job) (textJobStatus s) + +readStatusFile :: (MonadIO m, MonadCatch m) => Output -> Job -> FilePath -> m (Maybe (JobStatus JobOutput)) +readStatusFile tout job jdir = do + handleIOError (\_ -> return Nothing) $ do + text <- liftIO $ T.readFile (jdir </> "status") + readJobStatus tout text $ do + artifacts <- forM (jobArtifacts job) $ \( aoutName@(ArtifactName tname), _ ) -> do + let adir = jdir </> "artifacts" </> T.unpack tname + aoutStorePath = adir </> "data" + aoutWorkPath <- fmap T.unpack $ liftIO $ T.readFile (adir </> "path") + return ArtifactOutput {..} + + return JobOutput + { outArtifacts = artifacts + } + +updateStatusFile :: MonadIO m => JobManager -> FilePath -> TVar (JobStatus JobOutput) -> m () +updateStatusFile JobManager {..} jdir outVar = liftIO $ do + atomically $ writeTVar jmOpenStatusUpdates . (+ 1) =<< readTVar jmOpenStatusUpdates + void $ forkIO $ loop Nothing where loop prev = do status <- atomically $ do status <- readTVar outVar when (Just status == prev) retry return status - T.writeFile path $ textJobStatus status <> "\n" - when (not (jobStatusFinished status)) $ loop $ Just status + T.writeFile (jdir </> "status") $ textJobStatus status <> "\n" <> textJobStatusDetails status + if (not (jobStatusFinished status)) + then loop $ Just status + else atomically $ writeTVar jmOpenStatusUpdates . (subtract 1) =<< readTVar jmOpenStatusUpdates + +jobStorageSubdir :: JobId -> FilePath +jobStorageSubdir (JobId jidParts) = "jobs" </> joinPath (map (T.unpack . textJobIdPart) (jidParts)) -prepareJob :: (MonadIO m, MonadMask m, MonadFail m) => FilePath -> Maybe Commit -> Job -> (FilePath -> FilePath -> m a) -> m a -prepareJob dir mbCommit job inner = do + +prepareJob :: (MonadIO m, MonadMask m, MonadFail m) => FilePath -> Job -> (FilePath -> m a) -> m a +prepareJob dir job inner = do withSystemTempDirectory "minici" $ \checkoutPath -> do - jdirCommit <- case mbCommit of - Just commit -> do - tree <- getCommitTree commit - forM_ (jobContainingCheckout job) $ \(JobCheckout mbsub dest) -> do - subtree <- maybe return (getSubtree mbCommit) mbsub $ tree - checkoutAt subtree $ checkoutPath </> fromMaybe "" dest - return $ showTreeId (treeId tree) </> stringJobName (jobName job) - Nothing -> do - when (not $ null $ jobContainingCheckout job) $ do - fail $ "no containing repository, can't do checkout" - return $ stringJobName (jobName job) - - jdirOther <- forM (jobOtherCheckout job) $ \( EvaluatedJobRepo repo, revision, JobCheckout mbsub dest ) -> do - commit <- readCommit repo $ fromMaybe "HEAD" revision - tree <- getCommitTree commit - subtree <- maybe return (getSubtree (Just commit)) mbsub $ tree + forM_ (jobCheckout job) $ \(JobCheckout tree mbsub dest) -> do + subtree <- maybe return (getSubtree Nothing . makeRelative (treeSubdir tree)) mbsub $ tree checkoutAt subtree $ checkoutPath </> fromMaybe "" dest - return $ showTreeId (treeId tree) - let jdir = dir </> "jobs" </> jdirCommit </> joinPath jdirOther + let jdir = dir </> jobStorageSubdir (jobId job) liftIO $ createDirectoryIfMissing True jdir + inner checkoutPath + +getArtifactStoredPath :: (MonadIO m, MonadError Text m) => FilePath -> JobId -> ArtifactName -> m FilePath +getArtifactStoredPath storageDir jid@(JobId ids) (ArtifactName aname) = do + let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids + adir = jdir </> "artifacts" </> T.unpack aname + + liftIO (doesDirectoryExist jdir) >>= \case + True -> return () + False -> throwError $ "job ‘" <> textJobId jid <> "’ not yet executed" + + liftIO (doesDirectoryExist adir) >>= \case + True -> return () + False -> throwError $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found" - inner checkoutPath jdir + return adir -runJob :: Job -> [ArtifactOutput] -> FilePath -> FilePath -> ExceptT (JobStatus JobOutput) IO JobOutput +getArtifactWorkPath :: (MonadIO m, MonadError Text m) => FilePath -> JobId -> ArtifactName -> m FilePath +getArtifactWorkPath storageDir jid aname = do + adir <- getArtifactStoredPath storageDir jid aname + liftIO $ readFile (adir </> "path") + +copyArtifact :: (MonadIO m, MonadError Text m) => FilePath -> JobId -> ArtifactName -> FilePath -> m () +copyArtifact storageDir jid aname tpath = do + adir <- getArtifactStoredPath storageDir jid aname + liftIO $ copyRecursive (adir </> "data") tpath + + +runJob :: Job -> [ ( ArtifactSpec, ArtifactOutput) ] -> FilePath -> FilePath -> ExceptT (JobStatus JobOutput) IO JobOutput runJob job uses checkoutPath jdir = do - liftIO $ forM_ uses $ \aout -> do + liftIO $ forM_ (filter ((`elem` jobUses job) . fst) 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 + forM_ (fromMaybe [] $ jobRecipe job) $ \p -> do (Just hin, _, _, hp) <- liftIO $ createProcess_ "" p { cwd = Just checkoutPath , std_in = CreatePipe @@ -331,26 +438,36 @@ runJob job uses checkoutPath jdir = do | fromIntegral n == -sigINT -> throwError JobCancelled | otherwise -> throwError JobFailed - let adir = jdir </> "artifacts" artifacts <- forM (jobArtifacts job) $ \( name@(ArtifactName tname), pathPattern ) -> do + let adir = jdir </> "artifacts" </> T.unpack tname path <- liftIO (globDir1 pathPattern checkoutPath) >>= \case [ path ] -> return path found -> do liftIO $ hPutStrLn logs $ - (if null found then "no file" else "multiple files") <> " found matching pattern `" <> - decompile pathPattern <> "' for artifact `" <> T.unpack tname <> "'" + (if null found then "no file" else "multiple files") <> " found matching pattern ‘" <> + decompile pathPattern <> "’ for artifact ‘" <> T.unpack tname <> "’" throwError JobFailed - let target = adir </> T.unpack tname </> takeFileName path + let target = adir </> "data" + workPath = makeRelative checkoutPath path liftIO $ do createDirectoryIfMissing True $ takeDirectory target - copyFile path target + copyRecursiveForce path target + T.writeFile (adir </> "path") $ T.pack workPath return $ ArtifactOutput { aoutName = name - , aoutWorkPath = makeRelative checkoutPath path + , aoutWorkPath = workPath , aoutStorePath = target } + forM_ (jobPublish job) $ \pub -> do + Just aout <- return $ lookup (jpArtifact pub) $ map (\aout -> ( ( jobName job, aoutName aout ), aout )) artifacts ++ uses + let ppath = case jpPath pub of + Just path + | hasTrailingPathSeparator path -> path </> takeFileName (aoutWorkPath aout) + | otherwise -> path + Nothing -> aoutWorkPath aout + copyToDestination (aoutStorePath aout) (jpDestination pub) ppath + return JobOutput - { outName = jobName job - , outArtifacts = artifacts + { outArtifacts = artifacts } diff --git a/src/Job/Types.hs b/src/Job/Types.hs index 0447615..5d3f0f3 100644 --- a/src/Job/Types.hs +++ b/src/Job/Types.hs @@ -1,11 +1,15 @@ module Job.Types where +import Data.Containers.ListUtils +import Data.Kind import Data.Text (Text) import Data.Text qualified as T import System.FilePath.Glob import System.Process +import {-# SOURCE #-} Config +import Destination import Repo @@ -13,17 +17,22 @@ data Declared data Evaluated data Job' d = Job - { jobName :: JobName - , jobContainingCheckout :: [ JobCheckout ] - , jobOtherCheckout :: [ ( JobRepo d, Maybe Text, JobCheckout ) ] - , jobRecipe :: [ CreateProcess ] + { jobId :: JobId' d + , jobName :: JobName + , jobCheckout :: [ JobCheckout d ] + , jobRecipe :: Maybe [ CreateProcess ] , jobArtifacts :: [ ( ArtifactName, Pattern ) ] - , jobUses :: [ ( JobName, ArtifactName ) ] + , jobUses :: [ ArtifactSpec ] + , jobPublish :: [ JobPublish d ] } type Job = Job' Evaluated type DeclaredJob = Job' Declared +type family JobId' d :: Type where + JobId' Declared = JobName + JobId' Evaluated = JobId + data JobName = JobName Text deriving (Eq, Ord, Show) @@ -33,29 +42,52 @@ stringJobName (JobName name) = T.unpack name textJobName :: JobName -> Text textJobName (JobName name) = name +jobRequiredArtifacts :: Job' d -> [ ArtifactSpec ] +jobRequiredArtifacts job = nubOrd $ jobUses job ++ (map jpArtifact $ jobPublish job) + -data JobRepo d where - DeclaredJobRepo :: RepoName -> JobRepo Declared - EvaluatedJobRepo :: Repo -> JobRepo Evaluated +type family JobRepo d :: Type where + JobRepo Declared = Maybe ( RepoName, Maybe Text ) + JobRepo Evaluated = Tree -data JobCheckout = JobCheckout - { jcSubtree :: Maybe FilePath +data JobCheckout d = JobCheckout + { jcRepo :: JobRepo d + , jcSubtree :: Maybe FilePath , jcDestination :: Maybe FilePath } +type family JobDestination d :: Type where + JobDestination Declared = DestinationName + JobDestination Evaluated = Destination + +data JobPublish d = JobPublish + { jpArtifact :: ArtifactSpec + , jpDestination :: JobDestination d + , jpPath :: Maybe FilePath + } + data ArtifactName = ArtifactName Text deriving (Eq, Ord, Show) +type ArtifactSpec = ( JobName, ArtifactName ) + data JobSet' d = JobSet - { jobsetCommit :: Maybe Commit + { jobsetId :: JobSetId' d + , jobsetConfig :: Maybe Config + , jobsetCommit :: Maybe Commit + , jobsetExplicitlyRequested :: [ JobId' d ] , 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 @@ -63,10 +95,13 @@ jobsetJobs = either (const []) id . jobsetJobsEither newtype JobId = JobId [ JobIdPart ] deriving (Eq, Ord) +newtype JobSetId = JobSetId [ JobIdPart ] + deriving (Eq, Ord) + data JobIdPart = JobIdName JobName - | JobIdCommit CommitId - | JobIdTree TreeId + | JobIdCommit (Maybe RepoName) CommitId + | JobIdTree (Maybe RepoName) FilePath TreeId deriving (Eq, Ord) newtype JobRef = JobRef [ Text ] @@ -75,5 +110,22 @@ newtype JobRef = JobRef [ Text ] textJobIdPart :: JobIdPart -> Text textJobIdPart = \case JobIdName name -> textJobName name - JobIdCommit cid -> textCommitId cid - JobIdTree tid -> textTreeId tid + JobIdCommit _ cid -> textCommitId cid + JobIdTree _ _ tid -> textTreeId tid + +textJobId :: JobId -> Text +textJobId (JobId ids) = T.intercalate "." $ map textJobIdPart ids + +parseJobRef :: Text -> JobRef +parseJobRef = JobRef . go 0 "" + where + go :: Int -> Text -> Text -> [ Text ] + go plevel cur s = do + let bchars | plevel > 0 = [ '(', ')' ] + | otherwise = [ '.', '(', ')' ] + let ( part, rest ) = T.break (`elem` bchars) s + case T.uncons rest of + Just ( '.', rest' ) -> (cur <> part) : go plevel "" rest' + Just ( '(', rest' ) -> go (plevel + 1) (cur <> part) rest' + Just ( ')', rest' ) -> go (plevel - 1) (cur <> part) rest' + _ -> [ cur <> part ] diff --git a/src/Main.hs b/src/Main.hs index 9e9214f..647231d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,9 +7,11 @@ import Control.Monad.Reader import Data.ByteString.Lazy qualified as BL import Data.List import Data.List.NonEmpty qualified as NE +import Data.Maybe import Data.Proxy import Data.Text qualified as T +import System.Console.ANSI import System.Console.GetOpt import System.Directory import System.Environment @@ -19,11 +21,16 @@ import System.IO import Command import Command.Checkout +import Command.Extract import Command.JobId +import Command.Log import Command.Run +import Command.Shell +import Command.Subtree import Config +import Destination +import Output import Repo -import Terminal import Version data CmdlineOptions = CmdlineOptions @@ -31,6 +38,7 @@ data CmdlineOptions = CmdlineOptions , optShowVersion :: Bool , optCommon :: CommonOptions , optStorage :: Maybe FilePath + , optOutput :: Maybe [ OutputType ] } defaultCmdlineOptions :: CmdlineOptions @@ -39,6 +47,7 @@ defaultCmdlineOptions = CmdlineOptions , optShowVersion = False , optCommon = defaultCommonOptions , optStorage = Nothing + , optOutput = Nothing } options :: [ OptDescr (CmdlineOptions -> Except String CmdlineOptions) ] @@ -57,15 +66,35 @@ options = case span (/= ':') value of ( repo, ':' : path ) -> return opts { optCommon = (optCommon opts) - { optRepo = DeclaredRepo (RepoName $ T.pack repo) path : optRepo (optCommon opts) + { optRepo = ( RepoName $ T.pack repo, path ) : optRepo (optCommon opts) } } - _ -> throwError $ "--repo: invalid value `" <> value <> "'" + _ -> throwError $ "--repo: invalid value ‘" <> value <> "’" ) "<repo>:<path>") ("override or declare repo path") + , Option [] [ "destination" ] + (ReqArg (\value opts -> + case span (/= ':') value of + ( dest, ':' : url ) -> return opts + { optCommon = (optCommon opts) + { optDestination = ( DestinationName $ T.pack dest, T.pack url ) : optDestination (optCommon opts) + } + } + _ -> throwError $ "--repo: invalid value ‘" <> value <> "’" + ) "<destination>:<url>") + ("override or declare destination") , Option [] [ "storage" ] (ReqArg (\value opts -> return opts { optStorage = Just value }) "<path>") "set storage path" + , Option [] [ "terminal-output" ] + (NoArg $ \opts -> return opts { optOutput = Just $ TerminalOutput : fromMaybe [] (optOutput opts) }) + "use terminal-style output (default if standard output is terminal)" + , Option [] [ "log-output" ] + (OptArg (\value opts -> return opts { optOutput = Just $ LogOutput (fromMaybe "-" value) : fromMaybe [] (optOutput opts) }) "<path>") + "use log-style output to <path> or standard output" + , Option [] [ "test-output" ] + (OptArg (\value opts -> return opts { optOutput = Just $ TestOutput (fromMaybe "-" value) : fromMaybe [] (optOutput opts) }) "<path>") + "use test-style output to <path> or standard output" ] data SomeCommandType = forall c. Command c => SC (Proxy c) @@ -74,7 +103,11 @@ commands :: NE.NonEmpty SomeCommandType commands = ( SC $ Proxy @RunCommand) NE.:| [ SC $ Proxy @CheckoutCommand + , SC $ Proxy @ExtractCommand , SC $ Proxy @JobIdCommand + , SC $ Proxy @LogCommand + , SC $ Proxy @ShellCommand + , SC $ Proxy @SubtreeCommand ] lookupCommand :: String -> Maybe SomeCommandType @@ -85,9 +118,10 @@ lookupCommand name = find p commands main :: IO () main = do args <- getArgs - let ( mbConfigPath, args' ) = case args of + let isPathArgument path = maybe False (/= '-') (listToMaybe path) && any isPathSeparator path + let ( mbRootPath, args' ) = case args of (path : rest) - | any isPathSeparator path -> ( Just path, rest ) + | isPathArgument path -> ( Just path, rest ) _ -> ( Nothing, args ) (opts, cmdargs) <- case getOpt RequireOrder options args' of @@ -100,10 +134,10 @@ main = do case foldl merge ( [], defaultCmdlineOptions ) os of ( [], opts ) -> return ( opts , cmdargs ) ( errs, _ ) -> do - hPutStrLn stderr $ unlines (reverse errs) <> "Try `minici --help' for more information." + hPutStrLn stderr $ unlines (reverse errs) <> "Try ‘minici --help’ for more information." exitFailure (_, _, errs) -> do - hPutStrLn stderr $ concat errs <> "Try `minici --help' for more information." + hPutStrLn stderr $ concat errs <> "Try ‘minici --help’ for more information." exitFailure when (optShowHelp opts) $ do @@ -126,13 +160,13 @@ main = do putStrLn versionLine exitSuccess - ( configPath, cmdargs' ) <- case ( mbConfigPath, cmdargs ) of + ( rootPath, cmdargs' ) <- case ( mbRootPath, cmdargs ) of ( Just path, _ ) -> return ( Just path, cmdargs ) ( _, path : rest ) - | any isPathSeparator path + | isPathArgument path -> return ( Just path, rest ) - _ -> ( , cmdargs ) <$> findConfig + _ -> return ( Nothing , cmdargs ) ( ncmd, cargs ) <- case cmdargs' of [] -> return ( NE.head commands, [] ) @@ -141,12 +175,12 @@ main = do | Just nc <- lookupCommand cname -> return (nc, cargs) | otherwise -> do hPutStr stderr $ unlines - [ "Unknown command `" <> cname <> "'." - , "Try `minici --help' for more information." + [ "Unknown command ‘" <> cname <> "’." + , "Try ‘minici --help’ for more information." ] exitFailure - runSomeCommand configPath opts ncmd cargs + runSomeCommand rootPath opts ncmd cargs data FullCommandOptions c = FullCommandOptions { fcoSpecific :: CommandOptions c @@ -169,11 +203,37 @@ fullCommandOptions proxy = ] runSomeCommand :: Maybe FilePath -> CmdlineOptions -> SomeCommandType -> [ String ] -> IO () -runSomeCommand ciConfigPath gopts (SC tproxy) args = do +runSomeCommand rootPath gopts (SC tproxy) args = do + let reportFailure err = hPutStrLn stderr err >> exitFailure + ( ciRootPath, ciJobRoot ) <- case rootPath of + Just path -> do + doesFileExist path >>= \case + True -> BL.readFile path >>= return . parseConfig >>= \case + Right config -> return ( path, JobRootConfig config ) + Left err -> reportFailure $ "Failed to parse job file ‘" <> path <> "’:" <> err + False -> doesDirectoryExist path >>= \case + True -> openRepo path >>= \case + Just repo -> return ( path, JobRootRepo repo ) + Nothing -> reportFailure $ "Failed to open repository ‘" <> path <> "’" + False -> reportFailure $ "File or directory ‘" <> path <> "’ not found" + Nothing -> do + openRepo "." >>= \case + Just repo -> return ( ".", JobRootRepo repo ) + Nothing -> findConfig >>= \case + Just path -> BL.readFile path >>= return . parseConfig >>= \case + Right config -> return ( path, JobRootConfig config ) + Left err -> reportFailure $ "Failed to parse job file ‘" <> path <> "’:" <> err + Nothing -> reportFailure $ "No job file or repository found" + + let storageFileName = ".minici" + ciStorageDir = case ( optStorage gopts, ciRootPath, ciJobRoot ) of + ( Just path, _ , _ ) -> path + ( Nothing , path, JobRootConfig {} ) -> takeDirectory path </> storageFileName + ( Nothing , _ , JobRootRepo repo ) -> getRepoWorkDir repo </> storageFileName + let ciOptions = optCommon gopts - ciStorageDir = optStorage gopts let exitWithErrors errs = do - hPutStrLn stderr $ concat errs <> "Try `minici " <> commandName tproxy <> " --help' for more information." + hPutStrLn stderr $ concat errs <> "Try ‘minici " <> commandName tproxy <> " --help’ for more information." exitFailure (opts, cmdargs) <- case getOpt Permute (fullCommandOptions tproxy) args of @@ -188,34 +248,65 @@ runSomeCommand ciConfigPath gopts (SC tproxy) args = do putStr $ usageInfo (T.unpack $ commandUsage tproxy) (fullCommandOptions tproxy) exitSuccess - ciConfig <- case ciConfigPath of - Just path -> parseConfig <$> BL.readFile path - Nothing -> return $ Left "no job file found" - let cmd = commandInit tproxy (fcoSpecific opts) cmdargs let CommandExec exec = commandExec cmd - ciContainingRepo <- maybe (return Nothing) (openRepo . takeDirectory) ciConfigPath + ciContainingRepo <- case ciJobRoot of + JobRootRepo repo -> return (Just repo) + JobRootConfig _ -> openRepo $ takeDirectory ciRootPath - let openDeclaredRepo dir decl = do - let path = dir </> repoPath decl + let openDeclaredRepo dir ( name, dpath ) = do + let path = dir </> dpath openRepo path >>= \case - Just repo -> return ( repoName decl, repo ) + Just repo -> return ( name, repo ) Nothing -> do absPath <- makeAbsolute path - hPutStrLn stderr $ "Failed to open repo `" <> showRepoName (repoName decl) <> "' at " <> repoPath decl <> " (" <> absPath <> ")" + hPutStrLn stderr $ "Failed to open repo ‘" <> showRepoName name <> "’ at " <> dpath <> " (" <> absPath <> ")" exitFailure cmdlineRepos <- forM (optRepo ciOptions) (openDeclaredRepo "") - configRepos <- case ( ciConfigPath, ciConfig ) of - ( Just path, Right config ) -> + configRepos <- case ciJobRoot of + JobRootConfig config -> forM (configRepos config) $ \decl -> do case lookup (repoName decl) cmdlineRepos of Just repo -> return ( repoName decl, repo ) - Nothing -> openDeclaredRepo (takeDirectory path) decl + Nothing + | Just path <- repoPath decl + -> openDeclaredRepo (takeDirectory ciRootPath) ( repoName decl, path ) + + | otherwise + -> do + hPutStrLn stderr $ "No path defined for repo ‘" <> showRepoName (repoName decl) <> "’" + exitFailure _ -> return [] - let ciOtherRepos = configRepos ++ cmdlineRepos + let openDeclaredDestination dir ( name, url ) = do + dest <- openDestination dir url + return ( name, dest ) + + cmdlineDestinations <- forM (optDestination ciOptions) (openDeclaredDestination "") + cfgDestinations <- case ciJobRoot of + JobRootConfig config -> do + forM (configDestinations config) $ \decl -> do + case lookup (destinationName decl) cmdlineDestinations of + Just dest -> return ( destinationName decl, dest ) + Nothing + | Just url <- destinationUrl decl + -> openDeclaredDestination (takeDirectory ciRootPath) ( destinationName decl, url ) + + | otherwise + -> do + hPutStrLn stderr $ "No url defined for destination ‘" <> showDestinationName (destinationName decl) <> "’" + exitFailure + _ -> return [] - ciTerminalOutput <- initTerminalOutput - flip runReaderT CommandInput {..} exec + let ciOtherRepos = configRepos ++ cmdlineRepos + ciDestinations = cfgDestinations ++ cmdlineDestinations + + outputTypes <- case optOutput gopts of + Just types -> return types + Nothing -> hSupportsANSI stdout >>= return . \case + True -> [ TerminalOutput ] + False -> [ LogOutput "-" ] + withOutput outputTypes $ \ciOutput -> do + flip runReaderT CommandInput {..} exec diff --git a/src/Output.hs b/src/Output.hs new file mode 100644 index 0000000..5fa2f81 --- /dev/null +++ b/src/Output.hs @@ -0,0 +1,132 @@ +module Output ( + Output, + OutputType(..), + OutputEvent(..), + OutputFootnote(..), + + withOutput, + outputTerminal, + outputMessage, + outputEvent, + outputFootnote, +) where + +import Control.Concurrent.MVar +import Control.Monad +import Control.Monad.Catch +import Control.Monad.IO.Class + +import Data.Text (Text) +import Data.Text.IO qualified as T + +import System.IO + +import Job.Types +import Terminal + + +data Output = Output + { outLock :: MVar () + , outTerminal :: Maybe TerminalOutput + , outLogs :: [ Handle ] + , outTest :: [ Handle ] + } + +data OutputType + = TerminalOutput + | LogOutput FilePath + | TestOutput FilePath + deriving (Eq, Ord) + +data OutputEvent + = OutputMessage Text + | TestMessage Text + | LogMessage Text + | JobStarted JobId + | JobFinished JobId Text + | JobIsDuplicate JobId Text + | JobPreviouslyFinished JobId Text + | JobWasSkipped JobId + +data OutputFootnote = OutputFootnote + { footnoteText :: Text + , footnoteTerminal :: Maybe TerminalFootnote + } + deriving (Eq) + + +withOutput :: [ OutputType ] -> (Output -> IO a) -> IO a +withOutput types inner = do + lock <- newMVar () + go types (Output lock Nothing [] []) + where + go (TerminalOutput : ts) out = do + term <- initTerminalOutput + go ts out { outTerminal = Just term } + go (LogOutput path : ts) out = withOutputFile path $ \h -> do + go ts out { outLogs = h : outLogs out } + go (TestOutput path : ts) out = withOutputFile path $ \h -> do + go ts out { outTest = h : outTest out } + go [] out = inner out + + withOutputFile "-" f = hSetBuffering stdout LineBuffering >> f stdout + withOutputFile path f = bracket (openFile' path) hClose f + openFile' path = do + h <- openFile path WriteMode + hSetBuffering h LineBuffering + return h + + +outputTerminal :: Output -> Maybe TerminalOutput +outputTerminal = outTerminal + +outStrLn :: Output -> Handle -> Text -> IO () +outStrLn Output {..} h text + | Just tout <- outTerminal, terminalHandle tout == h = do + void $ newLine tout text + | otherwise = do + withMVar outLock $ \_ -> do + T.hPutStrLn h text + +outputMessage :: MonadIO m => Output -> Text -> m () +outputMessage out msg = outputEvent out (OutputMessage msg) + +outputEvent :: MonadIO m => Output -> OutputEvent -> m () +outputEvent out@Output {..} = liftIO . \case + OutputMessage msg -> do + forM_ outTerminal $ \term -> void $ newLine term msg + forM_ outLogs $ \h -> outStrLn out h msg + forM_ outTest $ \h -> outStrLn out h ("msg " <> msg) + + TestMessage msg -> do + forM_ outTest $ \h -> outStrLn out h msg + + LogMessage msg -> do + forM_ outLogs $ \h -> outStrLn out h msg + + JobStarted jid -> do + forM_ outLogs $ \h -> outStrLn out h ("Started " <> textJobId jid) + forM_ outTest $ \h -> outStrLn out h ("job-start " <> textJobId jid) + + JobFinished jid status -> do + forM_ outLogs $ \h -> outStrLn out h ("Finished " <> textJobId jid <> " (" <> status <> ")") + forM_ outTest $ \h -> outStrLn out h ("job-finish " <> textJobId jid <> " " <> status) + + JobIsDuplicate jid status -> do + forM_ outLogs $ \h -> outStrLn out h ("Duplicate " <> textJobId jid <> " (" <> status <> ")") + forM_ outTest $ \h -> outStrLn out h ("job-duplicate " <> textJobId jid <> " " <> status) + + JobPreviouslyFinished jid status -> do + forM_ outLogs $ \h -> outStrLn out h ("Previously finished " <> textJobId jid <> " (" <> status <> ")") + forM_ outTest $ \h -> outStrLn out h ("job-previous " <> textJobId jid <> " " <> status) + + JobWasSkipped jid -> do + forM_ outLogs $ \h -> outStrLn out h ("Skipped " <> textJobId jid) + forM_ outTest $ \h -> outStrLn out h ("job-skip " <> textJobId jid) + +outputFootnote :: Output -> Text -> IO OutputFootnote +outputFootnote out@Output {..} footnoteText = do + footnoteTerminal <- forM outTerminal $ \term -> newFootnote term footnoteText + forM_ outLogs $ \h -> outStrLn out h footnoteText + forM_ outTest $ \h -> outStrLn out h ("note " <> footnoteText) + return OutputFootnote {..} diff --git a/src/Repo.hs b/src/Repo.hs index f22b211..c878b1e 100644 --- a/src/Repo.hs +++ b/src/Repo.hs @@ -1,16 +1,16 @@ module Repo ( - Repo, + Repo, getRepoWorkDir, DeclaredRepo(..), RepoName(..), textRepoName, showRepoName, Commit, commitId, CommitId, textCommitId, showCommitId, - Tree, treeId, treeRepo, + Tree, treeId, treeRepo, treeSubdir, TreeId, textTreeId, showTreeId, Tag(..), openRepo, - readCommit, tryReadCommit, - readTree, tryReadTree, + readCommit, readCommitId, tryReadCommit, + readTree, readTreeId, tryReadTree, readBranch, readTag, listCommits, @@ -67,9 +67,12 @@ data Repo instance Show Repo where show GitRepo {..} = gitDir +getRepoWorkDir :: Repo -> FilePath +getRepoWorkDir GitRepo {..} = takeDirectory gitDir + data DeclaredRepo = DeclaredRepo { repoName :: RepoName - , repoPath :: FilePath + , repoPath :: Maybe FilePath } newtype RepoName = RepoName Text @@ -98,8 +101,9 @@ data CommitDetails = CommitDetails } data Tree = Tree - { treeRepo :: Repo - , treeId :: TreeId + { treeRepo :: Repo -- ^ Repository in which the tree is tored + , treeId :: TreeId -- ^ Tree ID + , treeSubdir :: FilePath -- ^ Subdirectory represented by this tree (from the repo root) } data Tag a = Tag @@ -169,17 +173,26 @@ mkCommit commitRepo commitId_ = do readCommit :: (MonadIO m, MonadFail m) => Repo -> Text -> m Commit readCommit repo@GitRepo {..} ref = maybe (fail err) return =<< tryReadCommit repo ref - where err = "revision `" <> T.unpack ref <> "' not found in `" <> gitDir <> "'" + 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 -readTree :: (MonadIO m, MonadFail m) => Repo -> Text -> m Tree -readTree repo@GitRepo {..} ref = maybe (fail err) return =<< tryReadTree repo ref - where err = "tree `" <> T.unpack ref <> "' not found in `" <> gitDir <> "'" +readTree :: (MonadIO m, MonadFail m) => Repo -> FilePath -> Text -> m Tree +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 -> Text -> m (Maybe Tree) -tryReadTree repo ref = return . fmap (Tree repo . TreeId) =<< tryReadObjectId repo "tree" ref +tryReadTree :: (MonadIO m, MonadFail m) => Repo -> FilePath -> Text -> m (Maybe Tree) +tryReadTree treeRepo treeSubdir ref = do + fmap (fmap TreeId) (tryReadObjectId treeRepo "tree" ref) >>= \case + Just treeId -> return $ Just Tree {..} + Nothing -> return Nothing tryReadObjectId :: (MonadIO m, MonadFail m) => Repo -> Text -> Text -> m (Maybe ByteString) tryReadObjectId GitRepo {..} otype ref = do @@ -252,6 +265,7 @@ getCommitDetails Commit {..} = do Just treeId <- return $ TreeId . BC.pack <$> lookup "tree" info let treeRepo = commitRepo + treeSubdir = "" let commitTree = Tree {..} let commitTitle = T.pack title let commitMessage = T.pack $ unlines $ dropWhile null message @@ -272,14 +286,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) - } - _ -> 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/src/Terminal.hs b/src/Terminal.hs index aa7335c..1e71559 100644 --- a/src/Terminal.hs +++ b/src/Terminal.hs @@ -6,6 +6,7 @@ module Terminal ( newLine, redrawLine, newFootnote, + terminalHandle, terminalBlinkStatus, ) where @@ -22,7 +23,8 @@ import System.IO data TerminalOutput = TerminalOutput - { outNumLines :: MVar Int + { outHandle :: Handle + , outNumLines :: MVar Int , outNextFootnote :: MVar Int , outBlinkVar :: TVar Bool } @@ -37,14 +39,14 @@ data TerminalLine = TerminalLine deriving (Eq) data TerminalFootnote = TerminalFootnote - { footnoteLine :: TerminalLine - , footnoteNumber :: Int - , footnoteText :: Text + { tfLine :: TerminalLine + , tfNumber :: Int } deriving (Eq) initTerminalOutput :: IO TerminalOutput initTerminalOutput = do + outHandle <- return stdout outNumLines <- newMVar 0 outNextFootnote <- newMVar 1 outBlinkVar <- newTVarIO False @@ -57,7 +59,7 @@ newLine :: TerminalOutput -> Text -> IO TerminalLine newLine lineOutput@TerminalOutput {..} text = do modifyMVar outNumLines $ \lineNum -> do T.putStrLn text - hFlush stdout + hFlush outHandle return ( lineNum + 1, TerminalLine {..} ) redrawLine :: TerminalLine -> Text -> IO () @@ -66,14 +68,17 @@ redrawLine TerminalLine {..} text = do withMVar outNumLines $ \total -> do let moveBy = total - lineNum T.putStr $ "\ESC[s\ESC[" <> T.pack (show moveBy) <> "F" <> text <> "\ESC[u" - hFlush stdout + hFlush outHandle newFootnote :: TerminalOutput -> Text -> IO TerminalFootnote -newFootnote tout@TerminalOutput {..} footnoteText = do - modifyMVar outNextFootnote $ \footnoteNumber -> do - footnoteLine <- newLine tout $ "[" <> T.pack (show footnoteNumber) <> "] " <> footnoteText - hFlush stdout - return ( footnoteNumber + 1, TerminalFootnote {..} ) +newFootnote tout@TerminalOutput {..} text = do + modifyMVar outNextFootnote $ \tfNumber -> do + tfLine <- newLine tout $ "[" <> T.pack (show tfNumber) <> "] " <> text + hFlush outHandle + return ( tfNumber + 1, TerminalFootnote {..} ) + +terminalHandle :: TerminalOutput -> Handle +terminalHandle = outHandle terminalBlinkStatus :: TerminalOutput -> STM Bool terminalBlinkStatus TerminalOutput {..} = readTVar outBlinkVar diff --git a/test/asset/artifact/minici.yaml b/test/asset/artifact/minici.yaml new file mode 100644 index 0000000..7204bb3 --- /dev/null +++ b/test/asset/artifact/minici.yaml @@ -0,0 +1,25 @@ +job generate: + checkout: null + + shell: + - echo "content 1" > f1 + - mkdir -p dir/subdir + - echo "content 2" > dir/f2 + - echo "content a" > dir/fa + - echo "content b" > dir/subdir/fb + - echo "content 3" > f3 + + artifact first: + path: f1 + + artifact second: + path: dir/f2 + + artifact third: + path: f3 + + artifact dir: + path: dir + + artifact sdir: + path: dir/subdir diff --git a/test/asset/publish/from_dependency.yaml b/test/asset/publish/from_dependency.yaml new file mode 100644 index 0000000..6bbfbf8 --- /dev/null +++ b/test/asset/publish/from_dependency.yaml @@ -0,0 +1,84 @@ +destination first: + url: ./first/dest + +destination second: + url: ./second/dest + +destination third: + +destination fourth: + +destination fifth: + + +job gen: + checkout: + + shell: + - mkdir dir + - mkdir dir2 + - mkdir dir2/subdir + - touch x + - touch dir/y + - touch dir2/z2 + - touch dir2/subdir/z + + artifact x: + path: ./x + + artifact y: + path: ./dir/y + + artifact z: + path: ./dir2/subdir/z + + artifact dir: + path: ./dir + + artifact dir2: + path: ./dir2 + + artifact dir2_subdir: + path: ./dir2/subdir + + +job publish: + publish: + - to: first + artifact: gen.x + + - to: first + artifact: gen.y + + - to: second + artifact: gen.z + + - to: third + artifact: gen.dir + + - to: third + artifact: gen.dir2_subdir + + - to: fourth + artifact: gen.x + path: path/for/artifact + + - to: fourth + artifact: gen.x + path: dir/for/artifact/ + + - to: fifth + artifact: gen.dir2_subdir + path: path/for/artifact + + - to: fifth + artifact: gen.dir2_subdir + path: dir/for/artifact/ + + - to: fifth + artifact: gen.dir2 + path: path2/for/artifact + + - to: fifth + artifact: gen.dir2 + path: dir2/for/artifact/ diff --git a/test/asset/publish/from_self.yaml b/test/asset/publish/from_self.yaml new file mode 100644 index 0000000..92d10e9 --- /dev/null +++ b/test/asset/publish/from_self.yaml @@ -0,0 +1,22 @@ +destination dest: + + +job gen_publish: + checkout: + + shell: + - touch x + - touch y + + artifact x: + path: x + + artifact y: + path: y + + publish: + - to: dest + artifact: x + + - to: dest + artifact: gen_publish.y diff --git a/test/asset/repo/checkout.yaml b/test/asset/repo/checkout.yaml new file mode 100644 index 0000000..f1bcbc8 --- /dev/null +++ b/test/asset/repo/checkout.yaml @@ -0,0 +1,93 @@ +repo r1: +repo r2: +repo r3: + +job checkout_subtree: + checkout: + - repo: r1 + dest: d1 + + - repo: r2 + subtree: s1 + dest: d2_s1 + + shell: + - find \! -name 'list?' -type f > list1 + + artifact out: + path: list1 + + +job checkout_common_root: + checkout: + - repo: r1 + dest: d1 + + - repo: r2 + subtree: s1 + dest: d2_s1 + + - repo: r2 + subtree: s2 + dest: d2_s2 + + shell: + - find \! -name 'list?' -type f > list2 + + artifact out: + path: list2 + + +job checkout_common_subtree: + checkout: + - repo: r3 + subtree: a/b/s1 + dest: d3_s1 + + - repo: r3 + subtree: a/b/c/s2 + dest: d3_s2 + + shell: + - find \! -name 'list?' -type f > list3 + + artifact out: + path: list3 + + +job checkout_common_subtree2: + checkout: + - repo: r1 + dest: d1 + + - repo: r2 + subtree: s1 + dest: d2_s1 + + - repo: r3 + subtree: a/b/c/s2 + dest: d3_s2 + + - repo: r3 + subtree: a/b/c/s3 + dest: d3_s3 + + shell: + - find \! -name 'list?' -type f > list4 + + artifact out: + path: list4 + + +job combined_subtree: + uses: + - checkout_common_root.out + - checkout_common_subtree2.out + + +job combined_all: + uses: + - checkout_subtree.out + - checkout_common_root.out + - checkout_common_subtree.out + - checkout_common_subtree2.out diff --git a/test/asset/run/dependencies.yaml b/test/asset/run/dependencies.yaml new file mode 100644 index 0000000..13d5e63 --- /dev/null +++ b/test/asset/run/dependencies.yaml @@ -0,0 +1,62 @@ +repo other: + +job first: + shell: + - touch x + + artifact out: + path: x + + +job second: + uses: + - first.out + + shell: + - mv x y + + artifact out: + path: y + + +job third: + uses: + - first.out + + shell: + - mv x z + + artifact out: + path: z + + +job fourth: + checkout: + - dest: a + - repo: other + dest: b + + uses: + - second.out + + shell: + - mv y w + + artifact out: + path: w + + +job fifth: + uses: + - third.out + - fourth.out + + shell: + - mv z z2 + - mv w w2 + + artifact out1: + path: z2 + + artifact out2: + path: w2 diff --git a/test/asset/run/explicit.yaml b/test/asset/run/explicit.yaml new file mode 100644 index 0000000..d543d16 --- /dev/null +++ b/test/asset/run/explicit.yaml @@ -0,0 +1,7 @@ +job build: + shell: + - ls subdir | sed -e ':a;N;s/\n/ /;ta' > list + - echo >> list + + artifact out: + path: list diff --git a/test/asset/run/external.yaml b/test/asset/run/external.yaml new file mode 100644 index 0000000..f1d2b2c --- /dev/null +++ b/test/asset/run/external.yaml @@ -0,0 +1,42 @@ +repo first: + path: ../first + +repo second: + path: ../second + + +job single: + checkout: + repo: first + dest: first + + shell: + - tar czf first.tar.gz first + + artifact tarball: + path: ./first.tar.gz + +job multiple: + checkout: + - repo: first + dest: first-subdir + subtree: subdir + - repo: second + dest: second-subdir + subtree: sub + + shell: + - tar czf pack.tar.gz first-subdir second-subdir + + artifact tarball: + path: ./pack.tar.gz + +job combine: + checkout: null + + shell: + - ls + + uses: + - single.tarball + - multiple.tarball diff --git a/test/asset/run/many_repos.yaml b/test/asset/run/many_repos.yaml new file mode 100644 index 0000000..d861433 --- /dev/null +++ b/test/asset/run/many_repos.yaml @@ -0,0 +1,109 @@ +repo r1: +repo r2: +repo r3: +repo r4: +repo r5: + +destination d1: + +job first: + checkout: + - repo: r1 + dest: d1 + - repo: r4 + dest: d4b + - repo: r3 + dest: d3 + - repo: r2 + dest: d2 + - repo: r4 + dest: d4 + + shell: + - touch some_file + + artifact out: + path: some_file + +job first_manual_revision: + checkout: + - repo: r1 + dest: d1 + - repo: r1 + dest: d1b + revision: tag1 + - repo: r2 + dest: d2b + revision: tag1 + - repo: r4 + dest: d4b + - repo: r3 + dest: d3 + revision: tag1 + - repo: r2 + dest: d2 + - repo: r4 + dest: d4 + + shell: + - touch some_file + + artifact out: + path: some_file + + +job second: + checkout: + - dest: main + - repo: r2 + dest: d2 + - repo: r5 + dest: d5 + - repo: r3 + dest: d3 + + shell: + - touch second_file + + artifact out: + path: second_file + + +job dependent: + uses: + - first.out + + shell: + - mv some_file some_other_file + + artifact out: + path: some_other_file + + +job dependent_publish: + publish: + - to: d1 + artifact: first.out + + +job transitive: + uses: + - dependent.out + + artifact out: + path: some_other_file + + +job combined: + uses: + - first.out + - second.out + + artifact out: + path: second_file + + +job combined_transitive: + uses: + - combined.out + - transitive.out diff --git a/test/asset/run/norepo-basic.yaml b/test/asset/run/norepo-basic.yaml new file mode 100644 index 0000000..2000858 --- /dev/null +++ b/test/asset/run/norepo-basic.yaml @@ -0,0 +1,9 @@ +job success: + checkout: null + shell: + - "true" + +job failure: + checkout: null + shell: + - "false" diff --git a/test/asset/run/repo-basic.yaml b/test/asset/run/repo-basic.yaml new file mode 100644 index 0000000..82f5650 --- /dev/null +++ b/test/asset/run/repo-basic.yaml @@ -0,0 +1,7 @@ +job success: + shell: + - "true" + +job failure: + shell: + - "false" diff --git a/test/asset/run/repo-basic2.yaml b/test/asset/run/repo-basic2.yaml new file mode 100644 index 0000000..bcfac50 --- /dev/null +++ b/test/asset/run/repo-basic2.yaml @@ -0,0 +1,15 @@ +job success: + shell: + - "true" + +job third: + shell: + - "true" + +job failure: + shell: + - "false" + +job fourth: + shell: + - "true" diff --git a/test/asset/run/rerun.yaml b/test/asset/run/rerun.yaml new file mode 100644 index 0000000..dc18b41 --- /dev/null +++ b/test/asset/run/rerun.yaml @@ -0,0 +1,45 @@ +job first: + shell: + - touch x + + artifact out: + path: x + + +job second: + uses: + - first.out + + shell: + - mv x y + + artifact out: + path: y + + +job first_fail: + shell: + - "false" + + artifact out: + path: x + + +job second_skip: + uses: + - first_fail.out + + shell: + - "true" + + artifact out: + path: y + + +job third: + uses: + - second.out + - second_skip.out + + shell: + - "true" diff --git a/test/script/artifact.et b/test/script/artifact.et new file mode 100644 index 0000000..d353b49 --- /dev/null +++ b/test/script/artifact.et @@ -0,0 +1,128 @@ +module artifact + +asset scripts: + path: ../asset/artifact + + +test ExtractArtifact: + node n + local: + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "run", "generate" ] + expect /job-finish generate done/ from p + + local: + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.first", "extracted" ] + local: + shell on n as s: + cat ./extracted + expect /content 1/ from s + + local: + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.second", "generate.third", "." ] + local: + shell on n as s: + cat ./f2 + cat ./f3 + expect /content 2/ from s + expect /content 3/ from s + + local: + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.dir", "." ] + local: + shell on n as s: + cat ./dir/f2 + cat ./dir/fa + cat ./dir/subdir/fb + expect /content 2/ from s + expect /content a/ from s + expect /content b/ from s + + local: + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.sdir", "extracted_subdir" ] + local: + shell on n as s: + cat ./extracted_subdir/fb + expect /content b/ from s + + +test ExtractArtifactForce: + node n + local: + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "run", "generate" ] + expect /job-finish generate done/ from p + + # TODO: test failure without --force + #local: + # shell on n: + # touch extracted + # spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.first", "extracted" ] + #local: + + local: + shell on n: + touch extracted + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "--force", "generate.first", "extracted" ] + local: + shell on n as s: + cat ./extracted + expect /content 1/ from s + + # TODO: test failure without --force + #local: + # shell on n: + # touch f1 + # spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.first", "." ] + #local: + + local: + shell on n: + touch f1 + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "--force", "generate.first", "." ] + local: + shell on n as s: + cat ./f1 + expect /content 1/ from s + + # TODO: test failure without --force + #local: + # shell on n: + # mkdir dir + # touch dir/existing_file + # spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.dir", "." ] + #local: + + local: + shell on n: + mkdir dir + touch dir/existing_file + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "--force", "generate.dir", "." ] + local: + shell on n as s: + ls dir + echo DONE + expect /f2/ from s + expect /fa/ from s + expect /subdir/ from s + expect /(.*)/ from s capture done + guard (done == "DONE") + + # TODO: test failure without --force + #local: + # shell on n: + # touch dir + # spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "generate.dir", "." ] + #local: + + local: + shell on n: + touch dir + spawn on n as p args [ "--storage=.minici", "${scripts.path}/minici.yaml", "extract", "--force", "generate.dir", "." ] + local: + shell on n as s: + ls dir + echo DONE + expect /f2/ from s + expect /fa/ from s + expect /subdir/ from s + expect /(.*)/ from s capture done + guard (done == "DONE") diff --git a/test/script/common.et b/test/script/common.et new file mode 100644 index 0000000..8875c79 --- /dev/null +++ b/test/script/common.et @@ -0,0 +1,26 @@ +module common + + +export def expect_result from p of job result result: + let dummy = job == "" # TODO: forces string type + expect from p: + /job-start $job/ + /job-finish $job ([a-z]+)/ capture done + guard (done == result) + +export def expect_previous_result from p of job result result: + let dummy = job == "" # TODO: forces string type + expect from p: + /job-previous $job ([a-z]+)/ capture done + guard (done == result) + +export def expect_success from p of job: + expect_result from p of job result "done" + +export def expect_previous_success from p of job: + expect_previous_result from p of job result "done" + +export def expect_skip from p of job: + let dummy = job == "" # TODO: forces string type + expect from p: + /job-skip $job/ diff --git a/test/script/publish.et b/test/script/publish.et new file mode 100644 index 0000000..6cea2f2 --- /dev/null +++ b/test/script/publish.et @@ -0,0 +1,69 @@ +module publish + +import common + + +asset scripts: + path: ../asset/publish + + +test PublishFromDependency: + node n + shell on n: + mkdir workdir + cp ${scripts.path}/from_dependency.yaml workdir/minici.yaml + + spawn on n as p args [ "--destination=second:second_override", "--destination=third:./third", "--destination=fourth:fourth/with_dir", "--destination=fifth:fifth/with_dir", "workdir/minici.yaml", "run", "publish" ] + expect_result from p: + of "gen" result "done" + of "publish" result "done" + local: + expect /(.*)/ from p capture done + guard (done == "run-finish") + + shell on n as listing: + find . -path ./workdir/.minici -prune -o -type f -print + echo DONE + + expect from listing: + /.\/workdir\/minici.yaml/ + /.\/workdir\/first\/dest\/x/ + /.\/workdir\/first\/dest\/dir\/y/ + /.\/second_override\/dir2\/subdir\/z/ + /.\/third\/dir\/y/ + /.\/third\/dir2\/subdir\/z/ + /.\/fourth\/with_dir\/path\/for\/artifact/ + /.\/fourth\/with_dir\/dir\/for\/artifact\/x/ + /.\/fifth\/with_dir\/path\/for\/artifact\/z/ + /.\/fifth\/with_dir\/dir\/for\/artifact\/subdir\/z/ + /.\/fifth\/with_dir\/path2\/for\/artifact\/z2/ + /.\/fifth\/with_dir\/path2\/for\/artifact\/subdir\/z/ + /.\/fifth\/with_dir\/dir2\/for\/artifact\/dir2\/z2/ + /.\/fifth\/with_dir\/dir2\/for\/artifact\/dir2\/subdir\/z/ + /(.*)/ capture done + guard (done == "DONE") + + +test PublishFromSelf: + node n + shell on n: + mkdir workdir + cp ${scripts.path}/from_self.yaml workdir/minici.yaml + + spawn on n as p args [ "--destination=dest:destination", "workdir/minici.yaml", "run", "gen_publish" ] + expect_result from p: + of "gen_publish" result "done" + local: + expect /(.*)/ from p capture done + guard (done == "run-finish") + + shell on n as listing: + find . -path ./workdir/.minici -prune -o -type f -print + echo DONE + + expect from listing: + /.\/workdir\/minici.yaml/ + /.\/destination\/x/ + /.\/destination\/y/ + /(.*)/ capture done + guard (done == "DONE") diff --git a/test/script/repo.et b/test/script/repo.et new file mode 100644 index 0000000..aeeeb6a --- /dev/null +++ b/test/script/repo.et @@ -0,0 +1,265 @@ +module repo + +import common + +asset scripts: + path: ../asset/repo + + +test RepoSubtree: + node n + shell on n as git_init: + mkdir -p work + git -C work -c init.defaultBranch=master init -q + git -C work -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + + mkdir -p work/first/second + touch work/first/second/file + git -C work add first + git -C work -c user.name=test -c user.email=test commit -q -m 'commit' + git -C work rev-parse HEAD^{commit} + git -C work rev-parse HEAD^{tree} + 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", "./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") + + +test CheckoutSubtree: + node n + shell on n as git_init: + mkdir -p main + git -C main -c init.defaultBranch=master init -q + cp "${scripts.path}/checkout.yaml" main/minici.yaml + git -C main add minici.yaml + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + git -C main rev-parse HEAD + git -C main rev-parse HEAD^{tree} + + mkdir -p dir_r1 + git -C dir_r1 -c init.defaultBranch=master init -q + git -C dir_r1 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch dir_r1/file + git -C dir_r1 add . + git -C dir_r1 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r1' + git -C dir_r1 rev-parse HEAD + git -C dir_r1 rev-parse HEAD^{tree} + + mkdir -p dir_r2 + git -C dir_r2 -c init.defaultBranch=master init -q + git -C dir_r2 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + mkdir -p dir_r2/s1 + mkdir -p dir_r2/s2 + touch dir_r2/s1/file1 + touch dir_r2/s2/file2 + git -C dir_r2 add . + git -C dir_r2 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r2' + git -C dir_r2 rev-parse HEAD + git -C dir_r2 rev-parse HEAD^{tree} + git -C dir_r2 rev-parse HEAD^{tree}:s1 + git -C dir_r2 rev-parse HEAD^{tree}:s2 + + mkdir -p dir_r3 + git -C dir_r3 -c init.defaultBranch=master init -q + git -C dir_r3 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + mkdir -p dir_r3/a/b/s1 + mkdir -p dir_r3/a/b/c/s2 + mkdir -p dir_r3/a/b/c/s3 + touch dir_r3/a/b/s1/file1 + touch dir_r3/a/b/c/s2/file2 + touch dir_r3/a/b/c/s3/file3 + git -C dir_r3 add . + git -C dir_r3 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r3' + git -C dir_r3 rev-parse HEAD + git -C dir_r3 rev-parse HEAD^{tree} + git -C dir_r3 rev-parse HEAD^{tree}:a/b + git -C dir_r3 rev-parse HEAD^{tree}:a/b/s1 + git -C dir_r3 rev-parse HEAD^{tree}:a/b/c + git -C dir_r3 rev-parse HEAD^{tree}:a/b/c/s2 + git -C dir_r3 rev-parse HEAD^{tree}:a/b/c/s3 + + expect /([0-9a-f]+)/ from git_init capture mc + expect /([0-9a-f]+)/ from git_init capture mt + + expect /([0-9a-f]+)/ from git_init capture r1c + expect /([0-9a-f]+)/ from git_init capture r1t + + expect /([0-9a-f]+)/ from git_init capture r2c + expect /([0-9a-f]+)/ from git_init capture r2t + expect /([0-9a-f]+)/ from git_init capture r2s1 + expect /([0-9a-f]+)/ from git_init capture r2s2 + + expect /([0-9a-f]+)/ from git_init capture r3c + expect /([0-9a-f]+)/ from git_init capture r3t + expect /([0-9a-f]+)/ from git_init capture r3ab + expect /([0-9a-f]+)/ from git_init capture r3abs1 + expect /([0-9a-f]+)/ from git_init capture r3abc + expect /([0-9a-f]+)/ from git_init capture r3abcs2 + expect /([0-9a-f]+)/ from git_init capture r3abcs3 + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "checkout_subtree" ] + expect_success from p of "$mt.checkout_subtree.$r1t.$r2s1" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "$mt.checkout_subtree.$r1t.$r2s1" ] + expect_success from p of "$mt.checkout_subtree.$r1t.$r2s1" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "extract", "$mt.checkout_subtree.$r1t.$r2s1.out", "list" ] + local: + shell on n as list: + cat list + rm list + echo DONE + expect from list: + /\.\/d1\/file/ + /\.\/d2_s1\/file1/ + /(.*)/ capture done + guard (done == "DONE") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "checkout_common_root" ] + expect_success from p of "$mt.checkout_common_root.$r1t.$r2t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "$mt.checkout_common_root.$r1t.$r2t" ] + expect_success from p of "$mt.checkout_common_root.$r1t.$r2t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "extract", "$mt.checkout_common_root.$r1t.$r2t.out", "list" ] + local: + shell on n as list: + cat list + rm list + echo DONE + expect from list: + /\.\/d1\/file/ + /\.\/d2_s1\/file1/ + /\.\/d2_s2\/file2/ + /(.*)/ capture done + guard (done == "DONE") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "checkout_common_subtree" ] + expect_success from p of "$mt.checkout_common_subtree.$r3ab" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "$mt.checkout_common_subtree.$r3ab" ] + expect_success from p of "$mt.checkout_common_subtree.$r3ab" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "extract", "$mt.checkout_common_subtree.$r3ab.out", "list" ] + local: + shell on n as list: + cat list + rm list + echo DONE + expect from list: + /\.\/d3_s1\/file1/ + /\.\/d3_s2\/file2/ + /(.*)/ capture done + guard (done == "DONE") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "checkout_common_subtree2" ] + expect_success from p of "$mt.checkout_common_subtree2.$r1t.$r2s1.$r3abc" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "run", "--rerun-all", "$mt.checkout_common_subtree2.$r1t.$r2s1.$r3abc" ] + expect_success from p of "$mt.checkout_common_subtree2.$r1t.$r2s1.$r3abc" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r2:./dir_r2", "--repo=r3:./dir_r3", "./main", "extract", "$mt.checkout_common_subtree2.$r1t.$r2s1.$r3abc.out", "list" ] + local: + shell on n as list: + cat list + rm list + echo DONE + expect from list: + /\.\/d1\/file/ + /\.\/d2_s1\/file1/ + /\.\/d3_s2\/file2/ + /\.\/d3_s3\/file3/ + /(.*)/ capture done + guard (done == "DONE") diff --git a/test/script/run.et b/test/script/run.et new file mode 100644 index 0000000..f00a4a7 --- /dev/null +++ b/test/script/run.et @@ -0,0 +1,624 @@ +module run + +import common + +asset scripts: + path: ../asset/run + + +test RunWithoutRepo: + node n + spawn on n as p args [ "--storage=.minici", "${scripts.path}/norepo-basic.yaml", "run", "success", "failure" ] + expect_result from p: + of "success" result "done" + of "failure" result "failed" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + +test RunWithRepo: + node n + shell on n as git_init: + git -c init.defaultBranch=master init -q + git -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + git rev-parse HEAD + cp "${scripts.path}/repo-basic.yaml" minici.yaml + git add minici.yaml + git -c user.name=test -c user.email=test commit -q -m 'basic1' + git rev-parse HEAD^{tree} + cp "${scripts.path}/repo-basic2.yaml" minici.yaml + git add minici.yaml + git -c user.name=test -c user.email=test commit -q -m 'basic1' + git rev-parse HEAD + git rev-parse HEAD^{tree} + + expect /([0-9a-f]+)/ from git_init capture c0 + expect /([0-9a-f]+)/ from git_init capture t1 + expect /([0-9a-f]+)/ from git_init capture c2 + expect /([0-9a-f]+)/ from git_init capture t2 + + local: + spawn on n as p args [ "run", "--range=$c0..$c2" ] + expect_result from p: + of "$t1.success" result "done" + of "$t1.failure" result "failed" + + of "$t2.success" result "done" + of "$t2.failure" result "failed" + of "$t2.third" result "done" + of "$t2.fourth" result "done" + + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./minici.yaml", "run", "--range=$c0..$c2" ] + expect_previous_result from p: + of "$t1.success" result "done" + expect_result from p: + of "$t1.failure" result "failed" + of "$t1.third" result "done" + of "$t1.fourth" result "done" + + expect_previous_result from p: + of "$t2.success" result "done" + expect_result from p: + of "$t2.failure" result "failed" + expect_previous_result from p: + of "$t2.third" result "done" + of "$t2.fourth" result "done" + + expect /(.*)/ from p capture done + guard (done == "run-finish") + + +test RunExternalRepo: + node n + shell on n as git_init: + mkdir -p first/subdir + git -C first -c init.defaultBranch=master init -q + git -C first -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch first/subdir/file + git -C first add subdir + git -C first -c user.name=test -c user.email=test commit -q -m 'commit' + git -C first rev-parse HEAD^{tree} + git -C first rev-parse HEAD:subdir + + mkdir -p second/sub + git -C second -c init.defaultBranch=master init -q + git -C second -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch second/sub/other + git -C second add sub + git -C second -c user.name=test -c user.email=test commit -q -m 'commit' + git -C second rev-parse HEAD^{tree} + git -C second rev-parse HEAD:sub + + mkdir -p main + git -C main -c init.defaultBranch=master init -q + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + cp "${scripts.path}/external.yaml" main/minici.yaml + git -C main add minici.yaml + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{tree} + + expect /([0-9a-f]+)/ from git_init capture first_root + expect /([0-9a-f]+)/ from git_init capture first_subtree + expect /([0-9a-f]+)/ from git_init capture second_root + expect /([0-9a-f]+)/ from git_init capture second_subtree + expect /([0-9a-f]+)/ from git_init capture main_root + + # Explicit jobfile outside of any git repo + local: + spawn on n as p args [ "--repo=first:./first", "--repo=second:./second", "--storage=.minici", "${scripts.path}/external.yaml", "run", "single", "multiple", "combine" ] + for job in [ "single.$first_root", "multiple.$first_subtree.$second_subtree", "combine.$first_root.$second_subtree" ]: + expect_success from p of job + + expect /(.*)/ from p capture done + guard (done == "run-finish") + + # Explicit jobfile within a git repo + local: + spawn on n as p args [ "--repo=first:./first", "--repo=second:./second", "--storage=.minici", "${scripts.path}/external.yaml", "run", "single" ] + expect_success from p of "single.$first_root" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + # Implicit jobfile within a git repo + local: + spawn on n as p args [ "--repo=first:./first", "--repo=second:./second", "./main", "run", "HEAD^..HEAD" ] + for job in [ "single.$first_root", "multiple.$first_subtree.$second_subtree", "combine.$first_root.$second_subtree" ]: + expect_success from p of "$main_root.$job" + + expect /(.*)/ from p capture done + guard (done == "run-finish") + + +test RunExplicitJob: + node n + shell on n as git_init: + mkdir -p main + git -C main -c init.defaultBranch=master init -q + cp "${scripts.path}/explicit.yaml" main/minici.yaml + git -C main add minici.yaml + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + + mkdir -p main/subdir + + touch main/subdir/a + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{commit} + git -C main rev-parse HEAD^{tree} + + touch main/subdir/b + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{tree} + + rm main/subdir/a + rm main/subdir/b + touch main/subdir/c + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{tree} + + touch main/subdir/d + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{tree} + + expect /([0-9a-f]+)/ from git_init capture c1 + expect /([0-9a-f]+)/ from git_init capture t1 + expect /([0-9a-f]+)/ from git_init capture t2 + expect /([0-9a-f]+)/ from git_init capture t3 + expect /([0-9a-f]+)/ from git_init capture t4 + + local: + spawn on n as p args [ "./main", "run", "$c1.build" ] + expect_success from p of "$t1.build" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "./main", "extract", "$c1.build.out", "list" ] + local: + shell on n as s: + cat list + rm list + expect /a/ from s + + local: + spawn on n as p args [ "./main", "run", "$t2.build" ] + expect_success from p of "$t2.build" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "./main", "extract", "$t2.build.out", "list" ] + local: + shell on n as s: + cat list + rm list + expect /a b/ from s + + local: + spawn on n as p args [ "./main", "run", "HEAD^.build" ] + expect_success from p of "$t3.build" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "./main", "extract", "HEAD^.build.out", "list" ] + local: + shell on n as s: + cat list + rm list + expect /c/ from s + + local: + spawn on n as p args [ "./main", "run", "HEAD.build" ] + expect_success from p of "$t4.build" + expect /(.*)/ from p capture done + guard (done == "run-finish") + local: + spawn on n as p args [ "./main", "extract", "HEAD.build.out", "list" ] + local: + shell on n as s: + cat list + rm list + expect /c d/ from s + + +test RunExplicitDependentJob: + node n + shell on n as git_init: + mkdir -p main + git -C main -c init.defaultBranch=master init -q + cp "${scripts.path}/dependencies.yaml" main/minici.yaml + git -C main add minici.yaml + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + + mkdir -p main/subdir + + touch main/subdir/a + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{commit} + git -C main rev-parse HEAD^{tree} + + touch main/subdir/b + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{tree} + + rm main/subdir/a + rm main/subdir/b + touch main/subdir/c + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{tree} + + touch main/subdir/d + git -C main add subdir + git -C main -c user.name=test -c user.email=test commit -q -m 'commit' + git -C main rev-parse HEAD^{tree} + + mkdir -p other + git -C other -c init.defaultBranch=master init -q + + mkdir -p other/subdir + + touch other/subdir/a + git -C other add subdir + git -C other -c user.name=test -c user.email=test commit -q -m 'commit' + git -C other rev-parse HEAD^{tree} + + touch other/subdir/b + git -C other add subdir + git -C other -c user.name=test -c user.email=test commit -q -m 'commit' + git -C other rev-parse HEAD^{tree} + + rm other/subdir/a + rm other/subdir/b + touch other/subdir/c + git -C other add subdir + git -C other -c user.name=test -c user.email=test commit -q -m 'commit' + git -C other rev-parse HEAD^{tree} + + touch other/subdir/d + git -C other add subdir + git -C other -c user.name=test -c user.email=test commit -q -m 'commit' + git -C other rev-parse HEAD^{tree} + + expect /([0-9a-f]+)/ from git_init capture c1 + expect /([0-9a-f]+)/ from git_init capture t1 + expect /([0-9a-f]+)/ from git_init capture t2 + expect /([0-9a-f]+)/ from git_init capture t3 + expect /([0-9a-f]+)/ from git_init capture t4 + + expect /([0-9a-f]+)/ from git_init capture o1 + expect /([0-9a-f]+)/ from git_init capture o2 + expect /([0-9a-f]+)/ from git_init capture o3 + expect /([0-9a-f]+)/ from git_init capture o4 + + local: + spawn on n as p args [ "--repo=other:./other", "./main", "run", "$c1.first", "$t2.first", "$t3.fourth.$o3", "$c1.fifth.$o1", "$c1.fourth.$o1", "$c1.third", "$c1.second", "$t4.fifth.$o4" ] + expect_success from p of "$t1.first" + expect_success from p of "$t1.second" + expect_success from p of "$t1.third" + expect_success from p of "$t1.fourth.$o1" + expect_success from p of "$t1.fifth.$o1" + + expect_success from p of "$t2.first" + + expect_success from p of "$t3.first" + expect_success from p of "$t3.second" + expect_success from p of "$t3.fourth.$o3" + + expect_success from p of "$t4.first" + expect_success from p of "$t4.second" + expect_success from p of "$t4.third" + expect_success from p of "$t4.fourth.$o4" + expect_success from p of "$t4.fifth.$o4" + + flush from p matching /note .*/ + flush from p matching /job-duplicate .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + +test RunRerun: + node n + shell on n as git_init: + mkdir -p main + git -C main -c init.defaultBranch=master init -q + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + cp "${scripts.path}/rerun.yaml" main/minici.yaml + git -C main add minici.yaml + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'minici' + git -C main rev-parse HEAD^{tree} + + expect /([0-9a-f]+)/ from git_init capture t1 + + local: + spawn on n as p args [ "./main", "run", "$t1.third" ] + expect_success from p of "$t1.first" + expect_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-explicit", "$t1.second" ] + expect_previous_success from p of "$t1.first" + expect_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-failed", "$t1.second" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-all", "$t1.second" ] + expect_success from p of "$t1.first" + expect_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-none", "$t1.second" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-explicit", "$t1.third" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-failed", "$t1.third" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-all", "$t1.third" ] + expect_success from p of "$t1.first" + expect_success from p of "$t1.second" + expect_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "./main", "run", "--rerun-none", "$t1.third" ] + expect_previous_success from p of "$t1.first" + expect_previous_success from p of "$t1.second" + expect_previous_result from p of "$t1.first_fail" result "failed" + expect_skip from p of "$t1.second_skip" + expect_skip from p of "$t1.third" + + flush from p matching /note .*/ + expect /(.*)/ from p capture done + guard (done == "run-finish") + + +test RunWithManyRepos: + node n + shell on n as git_init: + mkdir -p main + git -C main -c init.defaultBranch=master init -q + cp "${scripts.path}/many_repos.yaml" main/minici.yaml + git -C main add minici.yaml + git -C main -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + git -C main rev-parse HEAD + git -C main rev-parse HEAD^{tree} + + mkdir -p dir_r1 + git -C dir_r1 -c init.defaultBranch=master init -q + git -C dir_r1 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch dir_r1/file_r1 + git -C dir_r1 add file_r1 + git -C dir_r1 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r1' + git -C dir_r1 -c user.name=test -c user.email=test tag tag1 -m tag1 + touch dir_r1/file2_r1 + git -C dir_r1 add file2_r1 + git -C dir_r1 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r1' + git -C dir_r1 rev-parse HEAD + git -C dir_r1 rev-parse HEAD^{tree} + + mkdir -p dir_r2 + git -C dir_r2 -c init.defaultBranch=master init -q + git -C dir_r2 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch dir_r2/file_r2 + git -C dir_r2 add file_r2 + git -C dir_r2 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r2' + git -C dir_r2 -c user.name=test -c user.email=test tag tag1 -m tag1 + touch dir_r2/file2_r2 + git -C dir_r2 add file2_r2 + git -C dir_r2 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r2' + git -C dir_r2 rev-parse HEAD + git -C dir_r2 rev-parse HEAD^{tree} + + mkdir -p dir_r3 + git -C dir_r3 -c init.defaultBranch=master init -q + git -C dir_r3 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch dir_r3/file2_r3 + git -C dir_r3 add file2_r3 + git -C dir_r3 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r3' + git -C dir_r3 -c user.name=test -c user.email=test tag tag1 -m tag1 + touch dir_r3/file_r3 + git -C dir_r3 add file_r3 + git -C dir_r3 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r3' + git -C dir_r3 rev-parse HEAD + git -C dir_r3 rev-parse HEAD^{tree} + + mkdir -p dir_r4 + git -C dir_r4 -c init.defaultBranch=master init -q + git -C dir_r4 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch dir_r4/file_r4 + git -C dir_r4 add file_r4 + git -C dir_r4 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r4' + git -C dir_r4 rev-parse HEAD + git -C dir_r4 rev-parse HEAD^{tree} + + mkdir -p dir_r5 + git -C dir_r5 -c init.defaultBranch=master init -q + git -C dir_r5 -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit' + touch dir_r5/file_r5 + git -C dir_r5 add file_r5 + git -C dir_r5 -c user.name=test -c user.email=test commit -q --allow-empty -m 'commit r5' + git -C dir_r5 rev-parse HEAD + git -C dir_r5 rev-parse HEAD^{tree} + + expect /([0-9a-f]+)/ from git_init capture mc + expect /([0-9a-f]+)/ from git_init capture mt + expect /([0-9a-f]+)/ from git_init capture r1c + expect /([0-9a-f]+)/ from git_init capture r1t + expect /([0-9a-f]+)/ from git_init capture r2c + expect /([0-9a-f]+)/ from git_init capture r2t + expect /([0-9a-f]+)/ from git_init capture r3c + expect /([0-9a-f]+)/ from git_init capture r3t + expect /([0-9a-f]+)/ from git_init capture r4c + expect /([0-9a-f]+)/ from git_init capture r4t + expect /([0-9a-f]+)/ from git_init capture r5c + expect /([0-9a-f]+)/ from git_init capture r5t + + # Path to a repo containing the script file + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "first" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "$mc.first.$r1c.$r2t.$r3c.$r4t" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "first_manual_revision" ] + expect_success from p of "$mt.first_manual_revision.$r1t.$r2t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "$mc.first_manual_revision.$r1c.$r2t.$r4t" ] + expect_success from p of "$mt.first_manual_revision.$r1t.$r2t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "dependent" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.dependent.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "$mc.dependent.$r1c.$r2t.$r3c.$r4t" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.dependent.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "dependent_publish" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.dependent_publish.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "transitive" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.dependent.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.transitive.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "$mc.transitive.$r1c.$r2t.$r3c.$r4t" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.dependent.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.transitive.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "combined" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.second.$r2t.$r3t.$r5t" + expect_success from p of "$mt.combined.$r1t.$r2t.$r3t.$r4t.$r5t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main", "run", "--rerun-all", "combined_transitive" ] + expect_success from p of "$mt.first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.second.$r2t.$r3t.$r5t" + expect_success from p of "$mt.dependent.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.transitive.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "$mt.combined.$r1t.$r2t.$r3t.$r4t.$r5t" + expect_success from p of "$mt.combined_transitive.$r1t.$r2t.$r3t.$r4t.$r5t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + + # Explicit path to the script file + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main/minici.yaml", "run", "--rerun-all", "first" ] + expect_success from p of "first.$r1t.$r2t.$r3t.$r4t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main/minici.yaml", "run", "--rerun-all", "second" ] + expect_success from p of "second.$mt.$r2t.$r3t.$r5t" + expect /(.*)/ from p capture done + guard (done == "run-finish") + + local: + spawn on n as p args [ "--storage=minici", "--repo=r1:./dir_r1", "--repo=r3:./dir_r3", "--repo=r4:./dir_r4", "--repo=r2:./dir_r2", "--repo=r5:./dir_r5", "--destination=d1:./dest1", "./main/minici.yaml", "run", "--rerun-all", "combined_transitive" ] + expect_success from p of "first.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "second.$mt.$r2t.$r3t.$r5t" + expect_success from p of "dependent.$mt.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "transitive.$mt.$r1t.$r2t.$r3t.$r4t" + expect_success from p of "combined.$mt.$r1t.$r2t.$r3t.$r4t.$r5t" + expect_success from p of "combined_transitive.$mt.$r1t.$r2t.$r3t.$r4t.$r5t" + expect /(.*)/ from p capture done + guard (done == "run-finish") |