From 6e183bf63ad75da44a030d0d6f5060e8b745d2ca Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 23 Aug 2022 21:39:22 +0200
Subject: Expression expansion in strings and regexes

---
 src/Parser.hs | 37 ++++++++++++++++++++++++-------------
 1 file changed, 24 insertions(+), 13 deletions(-)

(limited to 'src')

diff --git a/src/Parser.hs b/src/Parser.hs
index 77a2877..027c358 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -123,15 +123,26 @@ addVarName _ name = do
         Nothing -> return ()
     modify $ \s -> s { testVars = (name, SomeExprType @a Proxy) : testVars s }
 
-varExpansion :: TestParser VarName
-varExpansion = do
+someExpansion :: TestParser SomeExpr
+someExpansion = do
     void $ char '$'
     choice
-        [ VarName . (:[]) . TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_')
-        ,do void $ char '{'
-            name <- varName
-            void $ char '}'
-            return name
+        [do name <- VarName . (:[]) . TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_')
+            SomeVarValue (_ :: a) <- lookupVar name
+            return $ SomeExpr $ Variable @a name
+        , between (char '{') (char '}') someExpr
+        ]
+
+stringExpansion :: Text -> TestParser (Expr Text)
+stringExpansion tname = 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
         ]
 
 integerLiteral :: TestParser (Expr Integer)
@@ -139,7 +150,7 @@ integerLiteral = Literal . read . TL.unpack <$> takeWhile1P (Just "integer") isD
 
 quotedString :: TestParser (Expr Text)
 quotedString = label "string" $ lexeme $ do
-    symbol "\""
+    void $ char '"'
     let inner = choice
             [ char '"' >> return []
             , takeWhile1P Nothing (`notElem` "\"\\$") >>= \s -> (Literal (TL.toStrict s):) <$> inner
@@ -153,14 +164,14 @@ quotedString = label "string" $ lexeme $ do
                     , char 't' >> return '\t'
                     ]
                 (Literal (T.singleton c) :) <$> inner
-            ,do name <- varExpansion
-                (Variable name :) <$> inner
+            ,do e <- stringExpansion (T.pack "string")
+                (e:) <$> inner
             ]
     Concat <$> inner
 
 regex :: TestParser (Expr Regex)
 regex = label "regular expression" $ lexeme $ do
-    symbol "/"
+    void $ char '/'
     let inner = choice
             [ char '/' >> return []
             , takeWhile1P Nothing (`notElem` "/\\$") >>= \s -> (Literal (TL.toStrict s) :) <$> inner
@@ -170,8 +181,8 @@ regex = label "regular expression" $ lexeme $ do
                     , anySingle >>= \c -> return (Literal $ T.pack ['\\', c])
                     ]
                 (s:) <$> inner
-            ,do name <- varExpansion
-                (Variable name :) <$> inner
+            ,do e <- stringExpansion (T.pack "regex")
+                (e:) <$> inner
             ]
     expr <- Regex <$> inner
     _ <- eval expr -- test regex parsing with empty variables
-- 
cgit v1.2.3