summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-04-01 23:33:06 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-04-04 21:25:00 +0200
commit1f01dbd2b1d3fb89efdaab56bc52d82a8ed0483e (patch)
treeed2a279157f6af16dbdd3b620e10e6028a320f23 /src
parent7e8ec380763292d8afa4f3d0f03a679ffe384d49 (diff)
Job root either as repo or jobfile
Diffstat (limited to 'src')
-rw-r--r--src/Command.hs30
-rw-r--r--src/Command/JobId.hs3
-rw-r--r--src/Command/Run.hs36
-rw-r--r--src/Config.hs6
-rw-r--r--src/Eval.hs34
-rw-r--r--src/Main.hs52
-rw-r--r--src/Repo.hs5
7 files changed, 105 insertions, 61 deletions
diff --git a/src/Command.hs b/src/Command.hs
index 0d333e8..e2ef911 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -9,8 +9,7 @@ module Command (
tfail,
CommandInput(..),
getCommonOptions,
- getConfigPath,
- getConfig,
+ getRootPath, getJobRoot,
getRepo, getDefaultRepo, tryGetDefaultRepo,
getEvalInput,
getTerminalOutput,
@@ -28,7 +27,6 @@ import Data.Text.IO qualified as T
import System.Console.GetOpt
import System.Exit
-import System.FilePath
import System.IO
import Config
@@ -100,28 +98,22 @@ 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
+ , 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
@@ -140,6 +132,8 @@ tryGetDefaultRepo = CommandExec $ asks ciContainingRepo
getEvalInput :: CommandExec EvalInput
getEvalInput = CommandExec $ do
+ eiJobRoot <- asks ciJobRoot
+ eiRootPath <- asks ciRootPath
eiContainingRepo <- asks ciContainingRepo
eiOtherRepos <- asks ciOtherRepos
return EvalInput {..}
@@ -148,6 +142,4 @@ getTerminalOutput :: CommandExec TerminalOutput
getTerminalOutput = CommandExec (asks ciTerminalOutput)
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/JobId.hs b/src/Command/JobId.hs
index 9f531d6..eb51a66 100644
--- a/src/Command/JobId.hs
+++ b/src/Command/JobId.hs
@@ -31,9 +31,8 @@ instance Command JobIdCommand where
cmdJobId :: JobIdCommand -> CommandExec ()
cmdJobId (JobIdCommand ref) = do
- config <- getConfig
einput <- getEvalInput
JobId ids <- either (tfail . textEvalError) return =<<
- liftIO (runEval (evalJobReference config ref) einput)
+ liftIO (runEval (evalJobReference ref) einput)
liftIO $ T.putStrLn $ T.intercalate "." $ map textJobIdPart ids
diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index 905204e..e0277c3 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -123,24 +123,41 @@ mergeSources sources = do
argumentJobSource :: [ JobName ] -> CommandExec JobSource
argumentJobSource [] = emptyJobSource
argumentJobSource names = do
- config <- getConfig
+ ( config, jobsetCommit ) <- getJobRoot >>= \case
+ JobRootConfig config -> do
+ commit <- sequence . fmap createWipCommit =<< tryGetDefaultRepo
+ return ( config, commit )
+ JobRootRepo repo -> do
+ commit <- createWipCommit repo
+ config <- either fail return =<< loadConfigForCommit =<< getCommitTree commit
+ return ( config, Just commit )
+
einput <- getEvalInput
jobsetJobsEither <- fmap Right $ 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 {..} ]
+loadJobSetFromRoot :: (MonadIO m, MonadFail m) => JobRoot -> Commit -> m DeclaredJobSet
+loadJobSetFromRoot root commit = case root of
+ JobRootRepo _ -> loadJobSetForCommit commit
+ JobRootConfig config -> return JobSet
+ { jobsetCommit = Just commit
+ , 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
+ oneshotJobSource . map (evalJobSet einput) =<< mapM (loadJobSetFromRoot root) commits
watchBranchSource :: Text -> CommandExec JobSource
watchBranchSource branch = do
+ root <- getJobRoot
repo <- getDefaultRepo
einput <- getEvalInput
getCurrentTip <- watchBranch repo branch
@@ -153,7 +170,7 @@ watchBranchSource branch = do
Nothing -> retry
commits <- listCommits repo (textCommitId (commitId prev) <> ".." <> textCommitId (commitId cur))
- jobsets <- map (evalJobSet einput) <$> mapM loadJobSetForCommit commits
+ jobsets <- map (evalJobSet einput) <$> mapM (loadJobSetFromRoot root) commits
nextvar <- newEmptyTMVarIO
atomically $ putTMVar tmvar $ Just ( jobsets, JobSource nextvar )
go cur nextvar
@@ -170,6 +187,7 @@ watchBranchSource branch = do
watchTagSource :: Pattern -> CommandExec JobSource
watchTagSource pat = do
+ root <- getJobRoot
chan <- watchTags =<< getDefaultRepo
einput <- getEvalInput
@@ -177,7 +195,7 @@ watchTagSource pat = do
tag <- atomically $ readTChan chan
if match pat $ T.unpack $ tagTag tag
then do
- jobset <- evalJobSet einput <$> loadJobSetForCommit (tagObject tag)
+ jobset <- evalJobSet einput <$> (loadJobSetFromRoot root) (tagObject tag)
nextvar <- newEmptyTMVarIO
atomically $ putTMVar tmvar $ Just ( [ jobset ], JobSource nextvar )
go nextvar
@@ -202,13 +220,7 @@ cmdRun (RunCommand RunOptions {..} args) = do
, 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 )
+ [ _ ] -> return $ Right $ JobName arg
_ -> tfail $ "invalid argument: " <> arg
]
diff --git a/src/Config.hs b/src/Config.hs
index 5631179..bc66ea9 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -1,4 +1,5 @@
module Config (
+ JobRoot(..),
Config(..),
findConfig,
parseConfig,
@@ -34,6 +35,11 @@ configFileName :: FilePath
configFileName = "minici.yaml"
+data JobRoot
+ = JobRootRepo Repo
+ | JobRootConfig Config
+
+
data Config = Config
{ configJobs :: [ DeclaredJob ]
, configRepos :: [ DeclaredRepo ]
diff --git a/src/Eval.hs b/src/Eval.hs
index 1828468..7e53128 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -14,6 +14,7 @@ import Control.Monad.Reader
import Data.Bifunctor
import Data.List
+import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
@@ -22,7 +23,9 @@ import Job.Types
import Repo
data EvalInput = EvalInput
- { eiContainingRepo :: Maybe Repo
+ { eiJobRoot :: JobRoot
+ , eiRootPath :: FilePath
+ , eiContainingRepo :: Maybe Repo
, eiOtherRepos :: [ ( RepoName, Repo ) ]
}
@@ -66,17 +69,22 @@ evalJobSet ei decl = do
runExceptStr = first (T.unpack . textEvalError) . runExcept
-canonicalJobName :: [ Text ] -> Config -> Eval [ JobIdPart ]
-canonicalJobName (r : rs) config = do
+canonicalJobName :: [ Text ] -> Maybe Tree -> Config -> Eval [ JobIdPart ]
+canonicalJobName (r : rs) mbTree config = do
einput <- ask
let name = JobName r
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
+ repos <- concat <$> sequence
+ [ case mbTree of
+ Just _ -> return []
+ Nothing -> maybeToList <$> asks eiContainingRepo
+ , return $ nub $ map (\( EvaluatedJobRepo repo, _, _ ) -> repo) $ jobOtherCheckout job
+ ]
(JobIdName name :) <$> canonicalOtherCheckouts rs repos
Nothing -> throwError $ OtherEvalError $ "job ‘" <> r <> "’ not found"
-canonicalJobName [] _ = throwError $ OtherEvalError "expected job name"
+canonicalJobName [] _ _ = throwError $ OtherEvalError "expected job name"
canonicalOtherCheckouts :: [ Text ] -> [ Repo ] -> Eval [ JobIdPart ]
canonicalOtherCheckouts (r : rs) (repo : repos) = do
@@ -98,14 +106,14 @@ canonicalCommitConfig (r : rs) repo = do
Just tree -> return tree
Nothing -> throwError $ OtherEvalError $ "failed to resolve ‘" <> r <> "’ to a commit or tree in " <> T.pack (show repo)
config <- either fail return =<< loadConfigForCommit tree
- (JobIdTree (treeId tree) :) <$> canonicalJobName rs config
+ (JobIdTree (treeId tree) :) <$> canonicalJobName rs (Just tree) 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
+evalJobReference :: JobRef -> Eval JobId
+evalJobReference (JobRef rs) =
+ JobId <$> do
+ asks eiJobRoot >>= \case
+ JobRootRepo defRepo -> do
canonicalCommitConfig rs defRepo
- Nothing -> do
- canonicalJobName rs config
+ JobRootConfig config -> do
+ canonicalJobName rs Nothing config
diff --git a/src/Main.hs b/src/Main.hs
index 9e9214f..1b062e8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -85,7 +85,7 @@ lookupCommand name = find p commands
main :: IO ()
main = do
args <- getArgs
- let ( mbConfigPath, args' ) = case args of
+ let ( mbRootPath, args' ) = case args of
(path : rest)
| any isPathSeparator path -> ( Just path, rest )
_ -> ( Nothing, args )
@@ -126,13 +126,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
-> return ( Just path, rest )
- _ -> ( , cmdargs ) <$> findConfig
+ _ -> return ( Nothing , cmdargs )
( ncmd, cargs ) <- case cmdargs' of
[] -> return ( NE.head commands, [] )
@@ -146,7 +146,7 @@ main = do
]
exitFailure
- runSomeCommand configPath opts ncmd cargs
+ runSomeCommand rootPath opts ncmd cargs
data FullCommandOptions c = FullCommandOptions
{ fcoSpecific :: CommandOptions c
@@ -169,9 +169,35 @@ 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."
exitFailure
@@ -188,14 +214,12 @@ 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
@@ -207,12 +231,12 @@ runSomeCommand ciConfigPath gopts (SC tproxy) args = do
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 -> openDeclaredRepo (takeDirectory ciRootPath) decl
_ -> return []
let ciOtherRepos = configRepos ++ cmdlineRepos
diff --git a/src/Repo.hs b/src/Repo.hs
index f22b211..dc88c4b 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -1,5 +1,5 @@
module Repo (
- Repo,
+ Repo, getRepoWorkDir,
DeclaredRepo(..),
RepoName(..), textRepoName, showRepoName,
Commit, commitId,
@@ -67,6 +67,9 @@ data Repo
instance Show Repo where
show GitRepo {..} = gitDir
+getRepoWorkDir :: Repo -> FilePath
+getRepoWorkDir GitRepo {..} = takeDirectory gitDir
+
data DeclaredRepo = DeclaredRepo
{ repoName :: RepoName
, repoPath :: FilePath