From e6bab9cb2aabafb27324f7d923739a8f4a96ad97 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 11 Aug 2024 10:32:50 +0200
Subject: Remove MonadEval instance for TestParser

---
 src/Parser/Expr.hs | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

(limited to 'src/Parser/Expr.hs')

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)
-- 
cgit v1.2.3