Accept revision expressions in job refs

4 files changed, 97 insertions, 8 deletions

diff --git a/src/Command.hs b/src/Command.hs
index 9dd6f35..5278beb 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -145,6 +145,7 @@ getEvalInput = CommandExec $ do
     eiContainingRepo <- asks ciContainingRepo
     eiOtherRepos <- asks ciOtherRepos
     eiDestinations <- asks ciDestinations
+    eiOutput <- asks ciOutput
     return EvalInput {..}
 
 cmdEvalWith :: (EvalInput -> EvalInput) -> Eval a -> CommandExec a
diff --git a/src/Eval.hs b/src/Eval.hs
index c7db23a..9ac11a5 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -12,6 +12,7 @@ module Eval (
     loadJobSetById,
 ) where
 
+import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Catch
 import Control.Monad.Except
@@ -29,7 +30,9 @@ import System.FilePath
 import Config
 import Destination
 import Expr
+import Expression
 import Job.Types
+import Output
 import Repo
 
 data EvalInput = EvalInput
@@ -39,6 +42,7 @@ data EvalInput = EvalInput
     , eiContainingRepo :: Maybe Repo
     , eiOtherRepos :: [ ( RepoName, Repo ) ]
     , eiDestinations :: [ ( DestinationName, Destination ) ]
+    , eiOutput :: Output
     }
 
 data EvalError
@@ -59,6 +63,9 @@ newtype Eval a = Eval (ReaderT EvalInput (ExceptT EvalError IO) a)
 instance MonadFail Eval where
     fail = throwError . OtherEvalError . T.pack
 
+instance MonadOutput Eval where
+    getOutput = asks eiOutput
+
 runEval :: Eval a -> EvalInput -> IO (Either EvalError a)
 runEval (Eval action) einput = runExceptT $ flip runReaderT einput action
 
@@ -349,13 +356,31 @@ canonicalJobName [] _ _ = throwError $ OtherEvalError "expected job name"
 
 readRepoRefFromIdRef :: [ Text ] -> FilePath -> Repo -> Eval ( RepoRef, [ Text ] )
 readRepoRefFromIdRef (r : rs) subdir repo = do
-    tryReadCommit repo r >>= \case
-        Just commit
-            | subdir == "" -> return ( RepoRefCommit commit, rs )
-            | otherwise -> return . ( , rs ) . RepoRefTree =<< getSubtree (Just commit) subdir =<< getCommitTree commit
-        Nothing -> tryReadTree repo subdir r >>= \case
-            Just tree -> return ( RepoRefTree tree, rs )
-            Nothing -> throwError $ OtherEvalError $ "failed to resolve ‘" <> r <> "’ to a commit or tree in " <> T.pack (show repo)
+    case parseRangeExpression r of
+        Left err -> throwError $ OtherEvalError $ T.pack err
+        Right (SingleRevisionExpression revDecl) -> do
+            doEvaluateRev revDecl >>= \case
+                Just commit
+                    | subdir == "" -> return ( RepoRefCommit commit, rs )
+                    | otherwise -> return . ( , rs ) . RepoRefTree =<< getSubtree (Just commit) subdir =<< getCommitTree commit
+                Nothing -> tryReadTree repo subdir r >>= \case
+                    Just tree -> return ( RepoRefTree tree, rs )
+                    Nothing -> throwError $ OtherEvalError $ "failed to resolve ‘" <> r <> "’ to a commit or tree in " <> T.pack (show repo)
+        Right _ -> throwError $ OtherEvalError $ "only single revision expression is supported in job ref now"
+  where
+    doEvaluateRev revDecl = do
+        mbRevExpr <- (Just <$> evaluateDeclaredRevision repo revDecl) `catchError` (const $ return Nothing)
+        case mbRevExpr of
+            Just revExpr -> do
+                when (isRevisionExpressionDynamic revExpr) $ do
+                    throwError $ OtherEvalError $ "dynamic watch expression is not yet supported in job ref"
+                liftIO (atomically (evaluateRevision revExpr)) >>= \case
+                    Just commitRef -> getCommitFromRef repo commitRef
+                    Nothing -> return Nothing
+            Nothing -> do
+                return Nothing
+
+
 readRepoRefFromIdRef [] _ _ = throwError $ OtherEvalError $ "expected commit or tree reference"
 
 canonicalCommitConfig :: [ Text ] -> Repo -> Eval JobSet
diff --git a/src/Expression.hs b/src/Expression.hs
index 29b6ea0..3897ede 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -9,6 +9,7 @@ module Expression (
     CommitRange(..),
     evaluateDeclaredRevision, evaluateDeclaredRange,
     evaluateRevision, evaluateRange,
+    getCommitFromRef,
     getRangeCommits, getAddedRangeCommits,
 
     isRangeExpressionDynamic,
@@ -207,8 +208,11 @@ evaluateRange = \case
     WatchedTagsExpression wt -> do
         CommitSet . map (CommitRef "" . commitId . tagObject) <$> updateWatchedTags wt
 
+getCommitFromRef :: MonadIO m => Repo -> CommitRef -> m (Maybe Commit)
+getCommitFromRef repo = liftIO . tryReadCommit repo . textCommitRef
+
 getCommitIdFromRef :: MonadIO m => Repo -> CommitRef -> m (Maybe CommitId)
-getCommitIdFromRef repo = liftIO . fmap (fmap commitId) . tryReadCommit repo . textCommitRef
+getCommitIdFromRef repo = fmap (fmap commitId) . getCommitFromRef repo
 
 getRangeCommits :: MonadIO m => Repo -> CommitRange -> m [ Commit ]
 getRangeCommits repo = \case
diff --git a/test/script/run.et b/test/script/run.et
index 4df5a2e..4825108 100644
--- a/test/script/run.et
+++ b/test/script/run.et
@@ -860,3 +860,62 @@ test RestartCancelledJobs:
             /job-start $td:third/
             /job-(.*)/ capture final_job
         guard (final_job == "finish $td:third done")
+
+
+test RunHighestTag:
+    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'
+        cp "${scripts.path}/repo-basic2.yaml" minici.yaml
+        git add minici.yaml
+        git -c user.name=test -c user.email=test commit -q -m 'minici.yaml'
+        git rev-parse HEAD
+
+        touch a
+        git add a
+        git -c user.name=test -c user.email=test commit -q -m a
+        git rev-parse HEAD
+        git rev-parse HEAD^{tree}
+        git -c user.name=test -c user.email=test tag -a -m ... v1.2
+
+        touch b
+        git add b
+        git -c user.name=test -c user.email=test commit -q -m b
+        git rev-parse HEAD
+        git rev-parse HEAD^{tree}
+        git -c user.name=test -c user.email=test tag -a -m ... v2.1
+
+        touch c
+        git add c
+        git -c user.name=test -c user.email=test commit -q -m c
+        git rev-parse HEAD
+        git rev-parse HEAD^{tree}
+        git -c user.name=test -c user.email=test tag -a -m ... v1.3
+        git -c user.name=test -c user.email=test tag -a -m ... w1.3
+
+        git reset --hard HEAD~3
+        git rev-parse HEAD
+
+    expect /([0-9a-f]+)/ from git_init capture c_init
+    expect /([0-9a-f]+)/ from git_init capture ca
+    expect /([0-9a-f]+)/ from git_init capture ta
+    expect /([0-9a-f]+)/ from git_init capture cb
+    expect /([0-9a-f]+)/ from git_init capture tb
+    expect /([0-9a-f]+)/ from git_init capture cc
+    expect /([0-9a-f]+)/ from git_init capture tc
+    expect /([0-9a-f]+)/ from git_init capture c_end
+
+    guard (c_init == c_end)
+
+    local:
+        spawn on n as p args [ "run", "highesttag(v*):third", "highesttag(*):fourth" ]
+        expect from p:
+            /job-enqueue $tb:third/
+            /job-start $tb:third/
+            /job-finish $tb:third done/
+            /job-enqueue $tc:fourth/
+            /job-start $tc:fourth/
+            /job-finish $tc:fourth done/
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")