From 0092723895da4136a68f71f34a816b33586d9ccb Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Sun, 26 Feb 2023 21:43:25 +0100
Subject: microlens and an ugly parse of ,(something,something)

btw we triggered a ghc bug here with iscallTok in parser. Apparently it kills
`call` for whichever reason. New ghc solved it.
---
 app/Parser.hs | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

(limited to 'app/Parser.hs')

diff --git a/app/Parser.hs b/app/Parser.hs
index 1dd86ba..e6b7a7a 100644
--- a/app/Parser.hs
+++ b/app/Parser.hs
@@ -49,7 +49,7 @@ singleToks = ",;|()[]{}!"
 
 identParts = "_"
 
-notOpToks = "\'%" ++ identParts
+notOpToks = "\'" ++ identParts
 
 isOperatorlike x =
   (isSymbol x || isPunctuation x) && not (x `elem` singleToks ++ notOpToks)
@@ -162,20 +162,32 @@ free = (<* ws) -- we eat blanks _after_ the token.
 
 isNormalTokStr = (`notElem` [".", "[", "]", "(", "|", ")", "{", "}"])
 
+isNormalTok :: Lexeme -> Bool
 isNormalTok (Tok x) = isNormalTokStr x
-isNormalTok (QTok x _) = isNormalTokStr x
+isNormalTok (QTok _ _) = True
 isNormalTok _ = False
 
+isCallTok :: Lexeme -> Bool
+isCallTok (Tok x) =
+  all (\c -> not (isSymbol c) && not (isPunctuation c) || c `elem` identParts) x
+isCallTok _ = True
+
 unTok (Tok t) = t
 unTok (QTok t _) = t
 
 literal :: Parser PAST
-literal = Literal . unTok <$> free (satisfy isNormalTok <* notFollowedBy lParen)
+literal =
+  Literal . unTok <$>
+  free
+    (choice
+       [ satisfy isCallTok <* notFollowedBy (choice [lParen, lBrace])
+       , satisfy (\x -> not (isCallTok x) && isNormalTok x)
+       ])
 
 makeParams (Seq inner) = splitOn [Literal ","] inner
 
 call eb contents fmod = do
-  fn <- fmod . unTok <$> satisfy isNormalTok -- not free
+  fn <- fmod . unTok <$> satisfy isCallTok -- not free
   (Call fn [] <$ try eb) <|> (Call fn . makeParams <$> free contents)
 
 parens = Seq <$> (free lParen *> some seqItem <* free rParen)
-- 
cgit v1.2.3