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.

1 files changed, 16 insertions, 4 deletions

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)