diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2022-10-07 13:41:11 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2022-10-07 18:27:33 +0200 |
commit | 409e9dc95aa9f17770f21d11a65ec839da699f16 (patch) | |
tree | 47799d2cca2d5a9fc4d9325ab4ffc6f3aaa47cee /src/Parser.hs | |
parent | bc688a7abf7f0d04429885084ed14bdf32b2d087 (diff) |
Regex expansion
Diffstat (limited to 'src/Parser.hs')
-rw-r--r-- | src/Parser.hs | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/src/Parser.hs b/src/Parser.hs index 35f28c5..22928c3 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -132,17 +132,14 @@ someExpansion = do , between (char '{') (char '}') someExpr ] -stringExpansion :: Text -> TestParser (Expr Text) -stringExpansion tname = do +stringExpansion :: ExprType a => Text -> (forall b. ExprType b => Expr b -> [Maybe (Expr a)]) -> TestParser (Expr a) +stringExpansion tname conv = do off <- stateOffset <$> getParserState SomeExpr e <- someExpansion let err = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat [ tname, T.pack " expansion not defined for '", textExprType e, T.pack "'" ] - maybe err return $ listToMaybe $ catMaybes - [ cast e - , UnOp (T.pack . show @Integer) <$> cast e - ] + maybe err return $ listToMaybe $ catMaybes $ conv e integerLiteral :: TestParser (Expr Integer) integerLiteral = Literal . read . TL.unpack <$> takeWhile1P (Just "integer") isDigit @@ -163,7 +160,10 @@ quotedString = label "string" $ lexeme $ do , char 't' >> return '\t' ] (Literal (T.singleton c) :) <$> inner - ,do e <- stringExpansion (T.pack "string") + ,do e <- stringExpansion (T.pack "string") $ \e -> + [ cast e + , UnOp (T.pack . show @Integer) <$> cast e + ] (e:) <$> inner ] Concat <$> inner @@ -173,14 +173,18 @@ regex = label "regular expression" $ lexeme $ do void $ char '/' let inner = choice [ char '/' >> return [] - , takeWhile1P Nothing (`notElem` "/\\$") >>= \s -> (Literal (TL.toStrict s) :) <$> inner + , takeWhile1P Nothing (`notElem` "/\\$") >>= \s -> (Literal (RegexPart (TL.toStrict s)) :) <$> inner ,do void $ char '\\' s <- choice - [ char '/' >> return (Literal $ T.singleton '/') - , anySingle >>= \c -> return (Literal $ T.pack ['\\', c]) + [ char '/' >> return (Literal $ RegexPart $ T.singleton '/') + , anySingle >>= \c -> return (Literal $ RegexPart $ T.pack ['\\', c]) ] (s:) <$> inner - ,do e <- stringExpansion (T.pack "regex") + ,do e <- stringExpansion (T.pack "regex") $ \e -> + [ cast e + , UnOp RegexString <$> cast e + , UnOp (RegexString . T.pack . show @Integer) <$> cast e + ] (e:) <$> inner ] expr <- Regex <$> inner |