Parse double unary - correctly and improve perf

We now don't use `buildExpressionParser` from parsers because it cannot
deal with double unary `-`, as in `--a`. Because nix doesn't have
operators which have the same precendence but different associativities,
we can greatly simplify the operator parser. This also has the effect of
improving performance and the error messages a bit.

Nix/Parser.hs

@@ -19,14 +19,14 @@ nixExpr = whiteSpace *> (nixToplevelForm <|> foldl' makeParser nixOpArg nixOpera
   makeParser term (Left NSelectOp) = nixSelect term
   makeParser term (Left NAppOp) = chainl1 term $ pure $ \a b -> Fix (NApp a b)
   makeParser term (Left NHasAttrOp) = nixHasAttr term
-  makeParser term (Right ops) = buildExpressionParser [map buildOp ops] term
-
-  buildOp (NUnaryDef n op) = Prefix $ Fix . NOper . NUnary op <$ reservedOp n
-  buildOp (NBinaryDef n op a) = Infix (mkOper2 op <$ reservedOp n) (toAssoc a)
-
-  toAssoc NAssocNone = AssocNone
-  toAssoc NAssocLeft = AssocLeft
-  toAssoc NAssocRight = AssocRight
+  makeParser term (Right (NUnaryDef name op))
+    = build <$> many (void $ symbol name) <*> term
+   where build = flip $ foldl' (\t' () -> mkOper op t')
+  makeParser term (Right (NBinaryDef assoc ops)) = case assoc of
+    NAssocLeft  -> chainl1 term op
+    NAssocRight -> chainr1 term op
+    NAssocNone  -> term <**> (flip <$> op <*> term <|> pure id)
+   where op = choice . map (\(n,o) -> mkOper2 o <$ reservedOp n) $ ops
 
 antiStart :: Parser String
 antiStart = try (string "${") <?> show ("${" :: String)

Nix/Types.hs

@@ -209,28 +209,26 @@ data NAssoc = NAssocNone | NAssocLeft | NAssocRight
 
 data NOperatorDef
   = NUnaryDef String NUnaryOp
-  | NBinaryDef String NBinaryOp NAssoc
+  | NBinaryDef NAssoc [(String, NBinaryOp)]
   deriving (Eq, Ord, Generic, Typeable, Data, Show)
 
-nixOperators :: [Either NSpecialOp [NOperatorDef]]
+nixOperators :: [Either NSpecialOp NOperatorDef]
 nixOperators =
   [ Left NSelectOp
   , Left NAppOp
-  , Right [ NUnaryDef  "-"  NNeg           ]
+  , Right $ NUnaryDef  "-"  NNeg
   , Left NHasAttrOp
   ] ++ map Right
-  [ [ NBinaryDef "++" NConcat  NAssocRight ]
-  , [ NBinaryDef "*"  NMult    NAssocLeft  , NBinaryDef "/" NDiv   NAssocLeft ]
-  , [ NBinaryDef "+"  NPlus    NAssocLeft  , NBinaryDef "-" NMinus NAssocLeft ]
-  , [ NUnaryDef  "!"  NNot                 ]
-  , [ NBinaryDef "//" NUpdate NAssocRight  ]
-  , [ NBinaryDef "<"  NLt     NAssocLeft   , NBinaryDef ">"  NGt  NAssocLeft
-    , NBinaryDef "<=" NLte    NAssocLeft   , NBinaryDef ">=" NGte NAssocLeft
-    ]
-  , [ NBinaryDef "==" NEq     NAssocNone   , NBinaryDef "!=" NNEq NAssocNone  ]
-  , [ NBinaryDef "&&" NAnd    NAssocLeft   ]
-  , [ NBinaryDef "||" NOr     NAssocLeft   ]
-  , [ NBinaryDef "->" NImpl   NAssocNone   ]
+  [ NBinaryDef NAssocRight [("++", NConcat)]
+  , NBinaryDef NAssocLeft [("*", NMult), ("/", NDiv)]
+  , NBinaryDef NAssocLeft [("+", NPlus), ("-", NMinus)]
+  , NUnaryDef  "!"  NNot
+  , NBinaryDef NAssocRight [("//", NUpdate)]
+  , NBinaryDef NAssocLeft [("<", NLt), (">", NGt), ("<=", NLte), (">=", NGte)]
+  , NBinaryDef NAssocNone [("==", NEq), ("!=", NNEq)]
+  , NBinaryDef NAssocLeft [("&&", NAnd)]
+  , NBinaryDef NAssocLeft [("||", NOr)]
+  , NBinaryDef NAssocNone [("->", NImpl)]
   ]
 
 data OperatorInfo = OperatorInfo
@@ -242,16 +240,15 @@ data OperatorInfo = OperatorInfo
 getUnaryOperator :: NUnaryOp -> OperatorInfo
 getUnaryOperator = (m Map.!) where
   m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $ nixOperators
-  buildEntry _ (Left _) = []
-  buildEntry i (Right ops) =
-    [ (op, OperatorInfo i NAssocNone name) | NUnaryDef name op <- ops ]
+  buildEntry i (Right (NUnaryDef name op)) = [(op, OperatorInfo i NAssocNone name)]
+  buildEntry _ _                           = []
 
 getBinaryOperator :: NBinaryOp -> OperatorInfo
 getBinaryOperator = (m Map.!) where
   m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $ nixOperators
-  buildEntry _ (Left _) = []
-  buildEntry i (Right ops) =
-    [ (op, OperatorInfo i assoc name) | NBinaryDef name op assoc <- ops ]
+  buildEntry i (Right (NBinaryDef assoc ops)) =
+    [ (op, OperatorInfo i assoc name) | (name,op) <- ops ]
+  buildEntry _ _                              = []
 
 getSpecialOperatorPrec :: NSpecialOp -> Int
 getSpecialOperatorPrec = (m Map.!) where

tests/ParserTests.hs

@@ -289,6 +289,10 @@ case_operators = do
   assertParseString "{ a = 3; } // rec { b = 4; }" $ mkOper2 NUpdate
     (Fix $ NSet NonRec [NamedVar (mkSelector "a") (mkInt 3)])
     (Fix $ NSet Rec    [NamedVar (mkSelector "b") (mkInt 4)])
+  assertParseString "--a" $ mkOper NNeg $ mkOper NNeg $ mkSym "a"
+  assertParseString "a - b - c" $ mkOper2 NMinus
+    (mkOper2 NMinus (mkSym "a") (mkSym "b")) $
+    mkSym "c"
 
 tests :: TestTree
 tests = $testGroupGenerator