summaryrefslogtreecommitdiff
path: root/src/Parser
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parser')
-rw-r--r--src/Parser/Core.hs9
-rw-r--r--src/Parser/Expr.hs21
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)