Fix some parser and pretty printer issues related to extended infix expr changes.

paf31 · paf31 · commit 61209510ff87 · 2015-02-08T13:44:48.000-08:00
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
@@ -358,17 +358,17 @@ parseValueAtom = P.choice
             , parseOperatorSection ]
 
 -- |
--- Parse an identifier in backticks or an operator
+-- Parse an expression in backticks or an operator
 --
-parseIdentInfix :: TokenParser Expr
-parseIdentInfix = P.between tick tick parseValue 
-                  <|> Var <$> parseQualified (Op <$> symbol)
+parseInfixExpr :: TokenParser Expr
+parseInfixExpr = P.between tick tick parseValue 
+                 <|> Var <$> parseQualified (Op <$> symbol)
 
 parseOperatorSection :: TokenParser Expr
 parseOperatorSection = parens $ left <|> right
   where
-  right = OperatorSection <$> parseIdentInfix <* indented <*> (Right <$> parseValueAtom)
-  left = flip OperatorSection <$> (Left <$> parseValueAtom) <* indented <*> parseIdentInfix
+  right = OperatorSection <$> parseInfixExpr <* indented <*> (Right <$> parseValueAtom)
+  left = flip OperatorSection <$> (Left <$> parseValueAtom) <* indented <*> parseInfixExpr
 
 parsePropertyUpdate :: TokenParser (String, Maybe Expr)
 parsePropertyUpdate = do
@@ -419,7 +419,7 @@ parseValue = withSourceSpan PositionedValue
                   ]
   operators = [ [ P.Prefix (P.try (C.indented *> symbol' "-") >> return UnaryMinus)
                 ]
-              , [ P.Infix (P.try (C.indented *> parseIdentInfix P.<?> "operator") >>= \ident ->
+              , [ P.Infix (P.try (C.indented *> parseInfixExpr P.<?> "infix expression") >>= \ident ->
                     return (BinaryNoParens ident)) P.AssocRight
                 ]
               ]
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
@@ -73,8 +73,8 @@ literals = mkPattern' match
     , withIndent $ prettyPrintMany prettyPrintDoNotationElement els
     , currentIndent
     ]
-  match (OperatorSection op (Right val)) = return $ "(" ++ show op ++ " " ++ prettyPrintValue val ++ ")"
-  match (OperatorSection op (Left val)) = return $ "(" ++ prettyPrintValue val ++ " " ++ show op ++ ")"
+  match (OperatorSection op (Right val)) = return $ "(" ++ prettyPrintValue op ++ " " ++ prettyPrintValue val ++ ")"
+  match (OperatorSection op (Left val)) = return $ "(" ++ prettyPrintValue val ++ " " ++ prettyPrintValue op ++ ")"
   match (TypeClassDictionary name _ _) = return $ "<<dict " ++ show name ++ ">>"
   match (SuperClassDictionary name _) = return $ "<<superclass dict " ++ show name ++ ">>"
   match (TypedValue _ val _) = prettyPrintValue' val
