diff options
Diffstat (limited to 'src/Parser')
| -rw-r--r-- | src/Parser/Core.hs | 9 | ||||
| -rw-r--r-- | src/Parser/Expr.hs | 21 |
2 files changed, 17 insertions, 13 deletions
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs index 341d9ca..2a74d3d 100644 --- a/src/Parser/Core.hs +++ b/src/Parser/Core.hs @@ -6,7 +6,6 @@ import Control.Monad.Writer import Data.Text (Text) import qualified Data.Text.Lazy as TL -import Data.Typeable import Data.Void import Text.Megaparsec hiding (State) @@ -28,15 +27,11 @@ data TestParserState = TestParserState , testContext :: SomeExpr } -someEmptyVar :: SomeExprType -> SomeVarValue -someEmptyVar (SomeExprType (Proxy :: Proxy a)) = SomeVarValue $ emptyVarValue @a - textSomeExprType :: SomeExprType -> Text textSomeExprType (SomeExprType p) = textExprType p -instance MonadEval TestParser where - lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") (return . someEmptyVar) =<< gets (lookup name . testVars) - rootNetwork = return emptyVarValue +lookupVarType :: VarName -> TestParser SomeExprType +lookupVarType name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return =<< gets (lookup name . testVars) skipLineComment :: TestParser () skipLineComment = L.skipLineComment $ TL.pack "#" diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index 6659895..9c0a1de 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -26,7 +26,9 @@ import Data.Void import Text.Megaparsec hiding (State) import Text.Megaparsec.Char -import qualified Text.Megaparsec.Char.Lexer as L +import Text.Megaparsec.Char.Lexer qualified as L +import Text.Regex.TDFA qualified as RE +import Text.Regex.TDFA.Text qualified as RE import Parser.Core import Test @@ -58,7 +60,7 @@ someExpansion = do void $ char '$' choice [do name <- VarName . TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_') - SomeVarValue (_ :: a) <- lookupVar name + SomeExprType (_ :: Proxy a) <- lookupVarType name return $ SomeExpr $ Variable @a name , between (char '{') (char '}') someExpr ] @@ -111,6 +113,7 @@ quotedString = label "string" $ lexeme $ do regex :: TestParser (Expr Regex) regex = label "regular expression" $ lexeme $ do + off <- stateOffset <$> getParserState void $ char '/' let inner = choice [ char '/' >> return [] @@ -129,9 +132,15 @@ regex = label "regular expression" $ lexeme $ do ] (e:) <$> inner ] - expr <- Regex <$> inner - _ <- eval expr -- test regex parsing with empty variables - return expr + parts <- inner + let testEval = \case + Pure (RegexPart p) -> p + _ -> "" + case RE.compile RE.defaultCompOpt RE.defaultExecOpt $ T.concat $ map testEval parts of + Left err -> registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat + [ "failed to parse regular expression: ", T.pack err ] + Right _ -> return () + return $ Regex parts list :: TestParser SomeExpr list = label "list" $ do @@ -307,7 +316,7 @@ someExpr = join inner <?> "expression" variable = label "variable" $ do name <- varName - SomeVarValue (_ :: a) <- lookupVar name + SomeExprType (_ :: Proxy a) <- lookupVarType name return $ return $ SomeExpr $ Variable @a name typedExpr :: forall a. ExprType a => TestParser (Expr a) |