@@ -17,7 +17,7 @@
1717--
1818-----------------------------------------------------------------------------
1919
20−{-# LANGUAGE Rank2Types #-}
20+{-# LANGUAGE Rank2Types, FlexibleContexts #-}
2121
2222module Language.PureScript.Sugar.Operators (
2323 rebracket
@@ -32,6 +32,7 @@ import Control.Arrow (first)
3232import Control.Monad.State
3333
3434import Data.Function (on)
35+import Data.Functor.Identity
3536import Data.List (groupBy, sortBy)
3637
3738import qualified Data.Map as M
@@ -86,18 +87,31 @@ matchOperators moduleName ops = G.everywhereM' (G.mkM parseChains)
8687 extendChain other = [Left other]
8788 bracketChain :: Chain -> Either String Value
8889 bracketChain = either (Left . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"
89− opTable = map (map (\(name, f, a) -> P.Infix (P.try (matchOp moduleName name) >> return f) (toAssoc a))) ops
90− ++ [[P.Infix (P.try (parseOp >>= \ident -> return (\t1 t2 -> App (App (Var ident) t1) t2))) P.AssocLeft]]
90+ opTable = [P.Infix (P.try (parseTicks >>= \ident -> return (\t1 t2 -> App (App (Var ident) t1) t2))) P.AssocLeft]
91+ : map (map (\(name, f, a) -> P.Infix (P.try (matchOp moduleName name) >> return f) (toAssoc a))) ops
92+ ++ [[ P.Infix (P.try (parseOp >>= \ident -> return (\t1 t2 -> App (App (Var ident) t1) t2))) P.AssocLeft ]]
9193
9294toAssoc :: Associativity -> P.Assoc
9395toAssoc Infixl = P.AssocLeft
9496toAssoc Infixr = P.AssocRight
9597
98+token :: (P.Stream s Identity t, Show t) => (t -> Maybe a) -> P.Parsec s u a
99+token = P.token show (const (P.initialPos ""))
100+
96101parseValue :: P.Parsec Chain () Value
97−parseValue = P.token show (const (P.initialPos "")) (either Just (const Nothing)) P.<?> "expression"
102+parseValue = token (either Just (const Nothing)) P.<?> "expression"
98103
99104parseOp :: P.Parsec Chain () (Qualified Ident)
100−parseOp = P.token show (const (P.initialPos "")) (either (const Nothing) Just) P.<?> "operator"
105+parseOp = token (either (const Nothing) fromOp) P.<?> "operator"
106+ where
107+ fromOp q@(Qualified _ (Op _)) = Just q
108+ fromOp _ = Nothing
109+
110+parseTicks :: P.Parsec Chain () (Qualified Ident)
111+parseTicks = token (either (const Nothing) fromOp) P.<?> "infix function"
112+ where
113+ fromOp q@(Qualified _ (Ident _)) = Just q
114+ fromOp _ = Nothing
101115
102116matchOp :: ModuleName -> Qualified Ident -> P.Parsec Chain () ()
103117matchOp moduleName op = do