From 072b2e8d51f54b30506adf775597a2b6364663f6 Mon Sep 17 00:00:00 2001
From: John Wiegley <johnw@newartisans.com>
Date: Fri, 4 Jul 2014 16:07:32 -0500
Subject: [PATCH] Add support for more operators

---
 Nix/Parser.hs         | 27 ++++++++++++++-------------
 Nix/Parser/Library.hs | 28 ++++++++++++++++++----------
 Nix/Types.hs          |  2 ++
 3 files changed, 34 insertions(+), 23 deletions(-)

diff --git a/Nix/Parser.hs b/Nix/Parser.hs
index e7c269f..1024b7a 100644
--- a/Nix/Parser.hs
+++ b/Nix/Parser.hs
@@ -28,20 +28,21 @@ nixExpr :: Bool -> Parser NExpr
 nixExpr = buildExpressionParser table . nixTerm
   where
     table =
-        [ [ prefix "-"  NNeg ]
-        , [ prefix "~"  NNeg ]
-        , [ prefix "?"  NNeg ]
-        , [ binary "++" NConcat AssocRight ]
-        , [ binary "*"  NMult   AssocLeft, binary "/"  NDiv    AssocLeft ]
-        , [ binary "+"  NPlus   AssocLeft, binary "-"  NMinus  AssocLeft ]
+        [ [ binary "."  NAttr    AssocNone ]
+        , [ prefix "-"  NNeg ]
+        -- , [ prefix "~"  NSubpath ]  -- deprecated
+        , [ binary "?"  NHasAttr AssocNone ]
+        , [ binary "++" NConcat  AssocRight ]
+        , [ binary "*"  NMult    AssocLeft, binary "/"  NDiv    AssocLeft ]
+        , [ binary "+"  NPlus    AssocLeft, binary "-"  NMinus  AssocLeft ]
         , [ prefix "!"  NNot ]
-        , [ binary "//" NUpdate AssocRight ]
-        , [ binary "<"  NLt     AssocLeft, binary ">"  NGt     AssocLeft
-          , binary "<=" NLte    AssocLeft, binary ">=" NGte    AssocLeft ]
-        , [ binary "==" NEq     AssocNone, binary "!=" NNEq    AssocNone ]
-        , [ binary "&&" NAnd    AssocLeft ]
-        , [ binary "||" NOr     AssocLeft ]
-        , [ binary "->" NImpl   AssocNone ]
+        , [ binary "//" NUpdate  AssocRight ]
+        , [ binary "<"  NLt      AssocLeft, binary ">"  NGt     AssocLeft
+          , binary "<=" NLte     AssocLeft, binary ">=" NGte    AssocLeft ]
+        , [ binary "==" NEq      AssocNone, binary "!=" NNEq    AssocNone ]
+        , [ binary "&&" NAnd     AssocLeft ]
+        , [ binary "||" NOr      AssocLeft ]
+        , [ binary "->" NImpl    AssocNone ]
         ]
 
     binary  name fun = Infix ((\x y -> Fix (NOper (fun x y))) <$ symbol name)
diff --git a/Nix/Parser/Library.hs b/Nix/Parser/Library.hs
index 60fdddb..583b5b3 100644
--- a/Nix/Parser/Library.hs
+++ b/Nix/Parser/Library.hs
@@ -23,7 +23,7 @@ lexer = P.makeTokenParser P.LanguageDef
     , P.commentLine     = "#"
     , P.nestedComments  = True
     , P.identStart      = letter <|> char '_'
-    , P.identLetter     = alphaNum <|> oneOf "_."
+    , P.identLetter     = alphaNum <|> oneOf "_"
     , P.opStart         = oneOf ":!#$%&*+./<=>?@\\^|-~"
     , P.opLetter        = oneOf "@"
     , P.reservedNames   =
@@ -91,44 +91,52 @@ reserved = fmap pack . symbol
 -----------------------------------------------------------
 -- White space & symbols
 -----------------------------------------------------------
+symbol :: (CharParsing m, Monad m) => String -> m String
 symbol name = lexeme (string name)
 
-lexeme p
-    = do{ x <- p; whiteSpace; return x  }
+lexeme :: (CharParsing m, Monad m) => m b -> m b
+lexeme p = do{ x <- p; whiteSpace; return x  }
 
+whiteSpace :: (CharParsing m, Monad m) => m ()
 whiteSpace =
     skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")
 
+simpleSpace :: CharParsing m => m ()
 simpleSpace = skipSome (satisfy isSpace)
 
+oneLineComment :: (CharParsing m, Monad m) => m ()
 oneLineComment =
-    do{ try (string "#")
+    do{ _ <- try (string "#")
       ; skipMany (satisfy (/= '\n'))
       ; return ()
       }
 
+multiLineComment :: (CharParsing m, Monad m) => m ()
 multiLineComment =
-    do { try (string "/*")
+    do { _ <- try (string "/*")
        ; inComment
        }
 
+inComment :: (CharParsing m, Monad m) => m ()
 inComment
     | True      = inCommentMulti
     | otherwise = inCommentSingle
 
+inCommentMulti :: (CharParsing m, Monad m) => m ()
 inCommentMulti
-    =   do{ try (string "*/") ; return () }
-    <|> do{ multiLineComment                     ; inCommentMulti }
+    =   do{ _ <- try (string "*/") ; return () }
+    <|> do{ multiLineComment                    ; inCommentMulti }
     <|> do{ skipSome (noneOf startEnd)          ; inCommentMulti }
-    <|> do{ oneOf startEnd                       ; inCommentMulti }
+    <|> do{ _ <- oneOf startEnd                  ; inCommentMulti }
     <?> "end of comment"
     where
       startEnd   = nub ("*/" ++ "/*")
 
+inCommentSingle :: (CharParsing m, Monad m) => m ()
 inCommentSingle
-    =   do{ try (string "*/"); return () }
+    =   do{ _ <- try (string "*/"); return () }
     <|> do{ skipSome (noneOf startEnd)         ; inCommentSingle }
-    <|> do{ oneOf startEnd                      ; inCommentSingle }
+    <|> do{ _ <- oneOf startEnd                 ; inCommentSingle }
     <?> "end of comment"
     where
       startEnd   = nub ("*/" ++ "/*")
diff --git a/Nix/Types.hs b/Nix/Types.hs
index 75d4bb1..8e1b24a 100644
--- a/Nix/Types.hs
+++ b/Nix/Types.hs
@@ -59,6 +59,7 @@ data NOperF r
     | NImpl r r
     | NUpdate r r
     | NHasAttr r r
+    | NAttr r r
 
     | NPlus r r
     | NMinus r r
@@ -82,6 +83,7 @@ instance Show f => Show (NOperF f) where
     show (NImpl r1 r2)    = show r1 ++ " -> " ++ show r2
     show (NUpdate r1 r2)  = show r1 ++ " // " ++ show r2
     show (NHasAttr r1 r2) = show r1 ++ " ? " ++ show r2
+    show (NAttr r1 r2)    = show r1 ++ "." ++ show r2
 
     show (NPlus r1 r2)    = show r1 ++ " + " ++ show r2
     show (NMinus r1 r2)   = show r1 ++ " - " ++ show r2