diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Command/Extract.hs | 5 | ||||
| -rw-r--r-- | src/Command/Run.hs | 9 | ||||
| -rw-r--r-- | src/Expression.hs | 2 | ||||
| -rw-r--r-- | src/Job/Types.hs | 34 |
4 files changed, 35 insertions, 15 deletions
diff --git a/src/Command/Extract.hs b/src/Command/Extract.hs index 8dee537..3f78e2e 100644 --- a/src/Command/Extract.hs +++ b/src/Command/Extract.hs @@ -32,9 +32,8 @@ instance CommandArgumentsType ExtractArguments where 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 ) + toArtifactRef tref = case parseJobRefParts $ T.pack tref of + parts@(_ : _) -> return ( JobRef $ init parts, ArtifactName $ last parts ) _ -> throwError $ "too few parts in artifact ref ‘" <> tref <> "’" _ -> throwError "too few arguments" diff --git a/src/Command/Run.hs b/src/Command/Run.hs index ccd4bfa..6419c58 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -10,6 +10,7 @@ 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) @@ -314,10 +315,14 @@ cmdRun (RunCommand RunOptions {..} args) = do ] let ( nameOptions, jobOptions ) = partition (T.all $ \c -> isAlphaNum c || c == '_') args - ( refOptions, exprOptions ) = partition (\r -> "." `T.isInfixOf` r && not (".." `T.isInfixOf` r)) jobOptions + ( refOptions, exprOptions ) = partitionEithers $ map splitRefs jobOptions + splitRefs t = case parseJobRef t of + JobRef [ e ] -> Right e + JobRef [ e, "" ] -> Right e + ref -> Left ref argumentJobs <- argumentJobSource $ map JobName nameOptions - refJobs <- refJobSource $ map parseJobRef refOptions + refJobs <- refJobSource refOptions exprJobs <- forM exprOptions $ \trange -> case parseRangeExpression trange of diff --git a/src/Expression.hs b/src/Expression.hs index 95ba815..3fc6e7a 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -156,7 +156,7 @@ parseRangeExpression = bimap errorBundlePretty id . runParser parser "" return $ RangeExpression rev1 (ModifiedRevision "^" rev1) ] - (char ':' >> eof) <|> eof + eof return expr parseRevision :: ExprParser DeclaredRevisionExpression diff --git a/src/Job/Types.hs b/src/Job/Types.hs index 50f550d..c7a859d 100644 --- a/src/Job/Types.hs +++ b/src/Job/Types.hs @@ -135,21 +135,37 @@ textJobIdPart = \case JobIdRepo _ (JobIdTag cid tid) -> textCommitId cid <> "^" <> textTagId tid textJobId :: JobId -> Text -textJobId (JobId ids) = T.intercalate "." $ map textJobIdPart ids +textJobId (JobId ids) = T.intercalate ":" $ map textJobIdPart ids parseJobRef :: Text -> JobRef -parseJobRef = JobRef . go 0 "" +parseJobRef = JobRef . parseJobRefParts + +parseJobRefParts :: Text -> [ Text ] +parseJobRefParts = go [ ':', '.' ] 0 False "" where - go :: Int -> Text -> Text -> [ Text ] - go plevel cur s = do + go :: [ Char ] -> Int -> Bool -> Text -> Text -> [ Text ] + go seps plevel pdrop cur s = do let bchars | plevel > 0 = [ '(', ')' ] - | otherwise = [ '.', '(', ')' ] + | otherwise = seps ++ [ '(', ')' ] 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 ] + Just ( '.', rest' ) + | Just ( '.', rest'' ) <- T.uncons rest' + -> go seps plevel pdrop (cur <> part <> "..") rest'' + Just ( sep, rest' ) + | sep `elem` seps + -> (cur <> part) : go [ sep ] plevel pdrop "" rest' + Just ( '(', rest' ) + | T.null cur && T.null part + -> go seps (plevel + 1) True (cur <> part) rest' + | otherwise + -> go seps (plevel + 1) pdrop (cur <> part <> "(") rest' + Just ( ')', rest' ) + | T.null rest' && pdrop + -> go seps (plevel - 1) False (cur <> part) rest' + | otherwise + -> go seps (plevel - 1) pdrop (cur <> part <> ")") rest' + _ -> [ cur <> part ] lastJobNameId :: JobId -> Maybe JobName lastJobNameId (JobId ids) = go Nothing ids |