fix error message for non-associative fixity

src/Idris/Desugar.idr

@@ -105,6 +105,10 @@ mkPrec InfixR = AssocR
 mkPrec Infix  = NonAssoc
 mkPrec Prefix = Prefix
 
+-- This is used to print the error message for fixities
+[showFst] Show a => Show (a, b) where
+  show (x, y) = show x
+
 -- Check that an operator does not have any conflicting fixities in scope.
 -- Each operator can have its fixity defined multiple times across multiple
 -- modules as long as the fixities are consistent. If they aren't, the fixity
@@ -352,10 +356,10 @@ mutual
   desugarB side ps (PBracketed fc e) = desugarB side ps e
   desugarB side ps (POp fc opFC l op r)
       = do ts <- toTokList side (POp fc opFC l op r)
-           desugarTree side ps !(parseOps ts)
+           desugarTree side ps !(parseOps @{showFst} ts)
   desugarB side ps (PPrefixOp fc opFC op arg)
       = do ts <- toTokList side (PPrefixOp fc opFC op arg)
-           desugarTree side ps !(parseOps ts)
+           desugarTree side ps !(parseOps @{showFst} ts)
   desugarB side ps (PSectionL fc opFC op arg)
       = do syn <- get Syn
            -- It might actually be a prefix argument rather than a section

src/Libraries/Utils/Shunting.idr

@@ -90,13 +90,13 @@ higher : Show op => FC -> op -> OpPrec -> op -> OpPrec -> Core Bool
 higher loc opx op opy (Prefix p) = pure False
 higher loc opx (NonAssoc x) opy oy
     = if x == getPrec oy
-         then throw (GenericMsg loc ("Operator '" ++ show opx ++
+         then throw (GenericMsg loc ("Operator " ++ show opx ++
-                                     "' is non-associative"))
+                                     " is non-associative"))
          else pure (x > getPrec oy)
 higher loc opx ox opy (NonAssoc y)
     = if getPrec ox == y
-         then throw (GenericMsg loc ("Operator '" ++ show opy ++
+         then throw (GenericMsg loc ("Operator " ++ show opy ++
-                                     "' is non-associative"))
+                                     " is non-associative"))
          else pure (getPrec ox > y)
 higher loc opl l opr r
     = pure $ (getPrec l > getPrec r) ||

tests/idris2/operators/operators004/Test.idr

@@ -0,0 +1,9 @@
+
+infix 5 -:-
+
+(-:-) : a -> List a -> List a
+(-:-) = (::)
+
+test : List Nat
+test = 4 -:- 3 -:- []
+

tests/idris2/operators/operators004/expected

@@ -0,0 +1,11 @@
+1/1: Building Test (Test.idr)
+Error: Operator -:- is non-associative
+
+Test:8:8--8:22
+ 4 | (-:-) : a -> List a -> List a
+ 5 | (-:-) = (::)
+ 6 | 
+ 7 | test : List Nat
+ 8 | test = 4 -:- 3 -:- []
+            ^^^^^^^^^^^^^^
+

tests/idris2/operators/operators004/run

@@ -0,0 +1,3 @@
+. ../../../testutils.sh
+
+check Test.idr