summaryrefslogtreecommitdiff
path: root/src/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parser.hs')
-rw-r--r--src/Parser.hs31
1 files changed, 26 insertions, 5 deletions
diff --git a/src/Parser.hs b/src/Parser.hs
index 2b6f14d..4b98dde 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -80,15 +80,36 @@ procName = label "process name" $ lexeme $ do
quotedString :: TestParser Text
quotedString = label "string" $ lexeme $ do
symbol "\""
- str <- takeWhileP Nothing (/='"')
- symbol "\""
- return $ TL.toStrict str
+ let inner = choice
+ [ char '"' >> return []
+ , takeWhile1P Nothing (`notElem` "\"\\") >>= \s -> (s:) <$> inner
+ ,do void $ char '\\'
+ c <- choice
+ [ char '\\' >> return '\\'
+ , char '"' >> return '"'
+ , char '$' >> return '$'
+ , char 'n' >> return '\n'
+ , char 'r' >> return '\r'
+ , char 't' >> return '\t'
+ ]
+ (TL.singleton c:) <$> inner
+ ]
+ TL.toStrict . TL.concat <$> inner
regex :: TestParser (Regex, Text)
regex = label "regular expression" $ lexeme $ do
symbol "/"
- pat <- takeWhileP Nothing (/='/')
- symbol "/"
+ let inner = choice
+ [ char '/' >> return []
+ , takeWhile1P Nothing (`notElem` "/\\") >>= \s -> (s:) <$> inner
+ ,do void $ char '\\'
+ s <- choice
+ [ char '/' >> return (TL.singleton '/')
+ , anySingle >>= \c -> return (TL.pack ['\\', c])
+ ]
+ (s:) <$> inner
+ ]
+ pat <- TL.concat <$> inner
case compile defaultCompOpt defaultExecOpt ("^" ++ TL.unpack pat ++ "$") of
Left err -> fail err
Right re -> return (re, TL.toStrict pat)