Range expression parsing

5 files changed, 251 insertions, 14 deletions

diff --git a/minici.cabal b/minici.cabal
index 2170785..0a35b53 100644
--- a/minici.cabal
+++ b/minici.cabal
@@ -96,6 +96,7 @@ executable minici
         Glob ^>= { 0.10.2 },
         hinotify ^>= { 0.4 },
         HsYAML ^>= { 0.2 },
+        megaparsec ^>= { 9.2, 9.3, 9.4, 9.5, 9.6, 9.7, 9.8 },
         mtl ^>= { 2.2, 2.3 },
         parser-combinators ^>= { 1.3 },
         process ^>= { 1.6 },
diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index b26c265..63d1254 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -8,8 +8,8 @@ import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
 
+import Data.Char
 import Data.Containers.ListUtils
-import Data.Either
 import Data.List
 import Data.Maybe
 import Data.Text (Text)
@@ -225,6 +225,7 @@ watchExpressionSource expr = do
     root <- getJobRoot
     repo <- getDefaultRepo
     einputBase <- getEvalInput
+    let loop = isRangeExpressionDynamic expr
     let go running prev tmvar = do
             cur <- atomically $ do
                 cur <- evaluateRange expr
@@ -252,7 +253,11 @@ watchExpressionSource expr = do
 
             nextvar <- newEmptyTMVarIO
             atomically $ putTMVar tmvar $ Just ( jobsets, JobSource nextvar )
-            go (reverse jobsets ++ keep) cur nextvar
+            if loop
+              then do
+                go (reverse jobsets ++ keep) cur nextvar
+              else do
+                atomically $ putTMVar nextvar Nothing
 
     liftIO $ do
         tmvar <- newEmptyTMVarIO
@@ -299,28 +304,31 @@ cmdRun (RunCommand RunOptions {..} args) = do
     output <- getOutput
     storageDir <- getStorageDir
 
-    ( rangeOptions, jobOptions ) <- partitionEithers . concat <$> sequence
+    rangeOptions <- concat <$> sequence
         [ forM roRanges $ \range -> case T.splitOn ".." range of
             [ base, tip ]
                 | not (T.null base) && not (T.null tip)
-                -> return $ Left ( Just base, tip )
+                -> return ( Just base, tip )
             _ -> tfail $ "invalid range: " <> range
-        , forM roSinceUpstream $ return . Left . ( Nothing, )
-        , forM args $ \arg -> case T.splitOn ".." arg of
-            [ base, tip ]
-                | not (T.null base) && not (T.null tip)
-                -> return $ Left ( Just base, tip )
-            [ _ ] -> return $ Right arg
-            _ -> tfail $ "invalid argument: " <> arg
+        , forM roSinceUpstream $ return . ( Nothing, )
         ]
 
-    let ( refOptions, nameOptions ) = partition (T.elem '.') jobOptions
+    let ( nameOptions, jobOptions ) = partition (T.all $ \c -> isAlphaNum c || c == '_') args
+        ( refOptions, exprOptions ) = partition (\r -> "." `T.isInfixOf` r && not (".." `T.isInfixOf` r)) jobOptions
 
     argumentJobs <- argumentJobSource $ map JobName nameOptions
     refJobs <- refJobSource $ map parseJobRef refOptions
 
+    exprJobs <- forM exprOptions $ \trange ->
+        case parseRangeExpression trange of
+            Left err -> fail err
+            Right expr -> do
+                repo <- getDefaultRepo
+                range <- evaluateDeclaredRange repo expr
+                watchExpressionSource range
+
     defaultSource <- getJobRoot >>= \case
-        _ | not (null rangeOptions && null roNewCommitsOn && null roNewTags && null jobOptions) -> do
+        _ | not (null rangeOptions && null roNewCommitsOn && null roNewTags && null args) -> do
             emptyJobSource
 
         JobRootRepo repo -> do
@@ -344,7 +352,7 @@ cmdRun (RunCommand RunOptions {..} args) = do
     liftIO $ do
         mngr <- newJobManager storageDir optJobs
 
-        source <- mergeSources $ concat [ [ defaultSource, argumentJobs, refJobs ], ranges, branches, tags ]
+        source <- mergeSources $ concat [ [ defaultSource, argumentJobs, refJobs ], exprJobs, ranges, branches, tags ]
         mbHeaderLine <- mapM (flip newLine "") (outputTerminal output)
 
         threadCount <- newTVarIO (0 :: Int)
diff --git a/src/Expression.hs b/src/Expression.hs
index 6b1adc9..95ba815 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -9,14 +9,28 @@ module Expression (
     evaluateDeclaredRevision, evaluateDeclaredRange,
     evaluateRevision, evaluateRange,
     getRangeCommits, getAddedRangeCommits,
+
+    isRangeExpressionDynamic,
+    isRevisionExpressionDynamic,
+
+    parseRangeExpression,
 ) where
 
 import Control.Concurrent.STM
 import Control.Monad.IO.Class
 
+import Data.Bifunctor
+import Data.Char
 import Data.Kind
+import Data.List.NonEmpty qualified as NE
 import Data.Maybe
+import Data.Proxy
 import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Void
+
+import Text.Megaparsec
+import Text.Megaparsec.Char
 
 import Job.Types
 import Output
@@ -112,3 +126,63 @@ getAddedRangeCommits repo (CommitRange ar br) (CommitRange ar' br') = do
     (++)
         <$> listCommitsFrom repo a'b (catMaybes [ b' ]) -- added by moving B to B'
         <*> listCommitsFrom repo (catMaybes [ a' ]) (catMaybes [ a, b, b' ]) -- added by moving A to A'
+
+
+isRangeExpressionDynamic :: RangeExpression -> Bool
+isRangeExpressionDynamic = \case
+    RangeExpression x y -> isRevisionExpressionDynamic x || isRevisionExpressionDynamic y
+
+isRevisionExpressionDynamic :: RevisionExpression -> Bool
+isRevisionExpressionDynamic = \case
+    StaticRef _ -> False
+    WatchedRef _ -> True
+    ModifiedRevision _ e -> isRevisionExpressionDynamic e
+
+
+type ExprParser = Parsec Void Text
+
+parseRangeExpression :: Text -> Either String DeclaredRangeExpression
+parseRangeExpression = bimap errorBundlePretty id . runParser parser ""
+  where
+    parser :: ExprParser DeclaredRangeExpression
+    parser = do
+        rev1 <- parseRevision
+        expr <- choice
+          [ do
+              _ <- string ".."
+              rev2 <- parseRevision
+              return $ RangeExpression rev2 rev1
+          , do
+              return $ RangeExpression rev1 (ModifiedRevision "^" rev1)
+          ]
+
+        (char ':' >> eof) <|> eof
+        return expr
+
+    parseRevision :: ExprParser DeclaredRevisionExpression
+    parseRevision = do
+        tok <- fmap T.concat $ some $ choice
+            [ takeWhile1P Nothing (\x -> isAlphaNum x || x `elem` [ '_', '-', '/' ])
+            , try $ string "." <* notFollowedBy (char '.')
+            ]
+
+        rev <- choice
+            [ do
+                _ <- char '('
+                arg <- takeWhileP Nothing (\x -> isAlphaNum x || x `elem` [ '_', '-', '/', '.' ])
+                _ <- char ')'
+                case tok of
+                    "watch" -> return $ WatchedRef arg
+                    _ -> unexpected $ Tokens $ NE.fromList $ chunkToTokens @Text Proxy tok
+
+            , do
+                return $ StaticRef tok
+            ]
+
+        choice
+            [ do
+                suffix <- takeWhile1P Nothing (\x -> isNumber x || x `elem` [ '~', '^', '@', '{', '}' ])
+                return $ ModifiedRevision suffix rev
+            , do
+                return rev
+            ]
diff --git a/test/asset/run/single.yaml b/test/asset/run/single.yaml
new file mode 100644
index 0000000..76d3943
--- /dev/null
+++ b/test/asset/run/single.yaml
@@ -0,0 +1,3 @@
+job single:
+  shell: |
+    true
diff --git a/test/script/run.et b/test/script/run.et
index 104562e..1c3ca96 100644
--- a/test/script/run.et
+++ b/test/script/run.et
@@ -860,3 +860,154 @@ test RestartCancelledJobs:
             /job-start $td.third/
             /job-(.*)/ capture final_job
         guard (final_job == "finish $td.third done")
+
+
+test RangeExpressions:
+    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}/single.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}
+
+        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}
+
+        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}
+
+        touch d
+        git add d
+        git -c user.name=test -c user.email=test commit -q -m d
+        git rev-parse HEAD
+        git rev-parse HEAD^{tree}
+
+        touch e
+        git add e
+        git -c user.name=test -c user.email=test commit -q -m e
+        git rev-parse HEAD
+        git rev-parse HEAD^{tree}
+
+        git reset --hard HEAD~4
+        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 cd
+    expect /([0-9a-f]+)/ from git_init capture td
+    expect /([0-9a-f]+)/ from git_init capture ce
+    expect /([0-9a-f]+)/ from git_init capture te
+    expect /([0-9a-f]+)/ from git_init capture c_end
+
+    local:
+        spawn on n as p args [ "run", "--rerun-all", "$ce:" ] killwith SIGINT
+        expect from p:
+            /job-enqueue $te.single/
+            /job-start $te.single/
+            /job-finish $te.single done/
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+    local:
+        spawn on n as p args [ "run", "--rerun-all", "$cb..$cd" ] killwith SIGINT
+        expect from p:
+            /job-enqueue $tc.single/
+            /job-start $tc.single/
+            /job-finish $tc.single done/
+            /job-enqueue $td.single/
+            /job-start $td.single/
+            /job-finish $td.single done/
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+    local:
+        spawn on n as p args [ "run", "--rerun-all", "master..$cc" ] killwith SIGINT
+        expect from p:
+            /job-enqueue $tb.single/
+            /job-start $tb.single/
+            /job-finish $tb.single done/
+            /job-enqueue $tc.single/
+            /job-start $tc.single/
+            /job-finish $tc.single done/
+        expect /(.*)/ from p capture finish
+        guard (finish == "run-finish")
+
+    local:
+        local:
+            shell on n:
+                git reset --hard $ca
+
+        spawn on n as p args [ "run", "--rerun-all", "watch(master)" ] killwith SIGINT
+        expect from p:
+            /job-enqueue $ta.single/
+            /job-start $ta.single/
+            /job-finish $ta.single done/
+
+        local:
+            shell on n:
+                git reset --hard $cd
+
+        expect from p:
+            /job-enqueue (.*)/ capture td_single
+        guard (td_single == "$td.single")
+        expect from p:
+            /job-start $td_single/
+            /job-finish $td_single done/
+
+        local:
+            shell on n:
+                git reset --hard $cb
+
+        expect from p:
+            /job-enqueue (.*)/ capture tb_single
+        guard (tb_single == "$tb.single")
+        expect from p:
+            /job-start $tb_single/
+            /job-finish $tb_single done/
+
+    local:
+        local:
+            shell on n:
+                git reset --hard $c_init
+
+        spawn on n as p args [ "run", "--rerun-all", "master..watch(master)" ] killwith SIGINT
+        expect from p /watch-branch-started master/
+
+        shell on n:
+            git reset --hard $cb
+        expect from p:
+            /job-enqueue $ta.single/
+            /job-start $ta.single/
+            /job-finish $ta.single done/
+            /job-enqueue $tb.single/
+            /job-start $tb.single/
+            /job-finish $tb.single done/
+
+        shell on n:
+            git reset --hard $cd
+        expect from p:
+            /job-enqueue $tc.single/
+            /job-start $tc.single/
+            /job-finish $tc.single done/
+            /job-enqueue $td.single/
+            /job-start $td.single/
+            /job-finish $td.single done/