Switch to a Parsec expression table

.gitignore

@@ -1 +1,2 @@
 /Setup
+/dist/

Nix/Parser.hs

@@ -17,17 +17,16 @@ import qualified Prelude
 import           Prelude hiding (elem)
 
 nixApp :: Parser NExpr
-nixApp = go <$> some (whiteSpace *> nixExpr True)
+nixApp = go <$> someTill (whiteSpace *> nixExpr True)
+                         (try (lookAhead (char ';')))
   where
     go []     = error "some has failed us"
     go [x]    = x
     go (f:xs) = Fix (NApp f (go xs))
 
 nixExpr :: Bool -> Parser NExpr
-nixExpr allowLambdas =
+nixExpr = buildExpressionParser table . nixTerm
-    buildExpressionParser table (nixTerm allowLambdas) <?> "expression"
+  where
- where
-    table :: OperatorTable Parser NExpr
     table =
         [ [ prefix "-"  NNeg ]
         , [ binary "++" NConcat AssocRight ]
@@ -45,7 +44,7 @@ nixExpr allowLambdas =
     --     Postfix (pure (Fix . NOper . fun) <* symbol name)
 
 nixTerm :: Bool -> Parser NExpr
-nixTerm allowLambdas = choice
+nixTerm allowLambdas = trace "in nixTerm" (return ()) >> choice
     [ nixInt
     , nixBool
     , nixNull
@@ -67,12 +66,12 @@ nixNull :: Parser NExpr
 nixNull = string "null" *> pure mkNull <?> "null"
 
 nixParens :: Parser NExpr
-nixParens = between (symbolic '(') (symbolic ')') nixApp <?> "parens"
+nixParens = parens nixApp <?> "parens"
 
 nixList :: Parser NExpr
-nixList = between (symbolic '[') (symbolic ']')
+nixList = do
-              (Fix . NList <$> many (nixTerm False))
+    trace "in nixList" $ return ()
-              <?> "list"
+    brackets (Fix . NList <$> many (nixTerm False)) <?> "list"
 
 nixPath :: Parser NExpr
 nixPath = try $ do
@@ -112,9 +111,8 @@ symName = do
 
 stringish :: Parser NExpr
 stringish
-     =  (char '"' *>
+     =  (char '"' *> (merge <$> manyTill stringChar (char '"')))
-         (merge <$> manyTill stringChar (char '"')))
+    <|> (char '$' *> braces nixApp)
-    <|> (char '$' *> between (symbolic '{') (symbolic '}') nixApp)
   where
     merge = foldl1' (\x y -> Fix (NOper (NConcat x y)))
 
@@ -126,18 +124,25 @@ stringish
         oneChar = mkStr . singleton <$> anyChar
 
 argExpr :: Parser NExpr
-argExpr =  (Fix . NArgSet . Map.fromList <$> argList)
+argExpr = do
-       <|> ((mkSym <$> symName) <?> "argname")
+    trace "in argExpr" $ return ()
+    (Fix . NArgSet . Map.fromList <$> argList)
+        <|> ((mkSym <$> symName) <?> "argname")
   where
-    argList = between (symbolic '{') (symbolic '}')
+    argList = do
-                  ((argName <* whiteSpace) `sepBy` symbolic ',')
+        trace "in argList" $ return ()
-                  <?> "arglist"
+        braces ((argName <* trace "FOO" whiteSpace) `sepBy` trace "BAR" (symbolic ','))
+            <?> "arglist"
 
-    argName = (,) <$> (symName <* whiteSpace)
+    argName = do
-                  <*> optional (symbolic '?' *> nixTerm False)
+        trace "in argName" $ return ()
+        (,) <$> (symName <* whiteSpace)
+            <*> optional (symbolic '?' *> nixExpr False)
 
 nvPair :: Parser (NExpr, NExpr)
-nvPair = (,) <$> keyName <*> (symbolic '=' *> nixApp)
+nvPair = do
+    trace "in nvPair" $ return ()
+    (,) <$> keyName <*> (symbolic '=' *> nixApp)
 
 keyName :: Parser NExpr
 keyName = (stringish <|> (mkSym <$> symName)) <* whiteSpace
@@ -153,9 +158,8 @@ setOrArgs = do
         else try (lookAhead lookaheadForSet)
     trace ("Do we have a set: " ++ show haveSet) $ return ()
     if haveSet
-        then between (symbolic '{') (symbolic '}')
+        then braces (Fix . NSet sawRec <$> nvPair `endBy` symbolic ';')
-                 (Fix . NSet sawRec <$> nvPair `endBy` symbolic ';')
+            <?> "set"
-                 <?> "set"
         else do
             trace "parsing arguments" $ return ()
             args <- argExpr <?> "arguments"
@@ -169,7 +173,8 @@ lookaheadForSet = do
     x <- (symbolic '{' *> return True) <|> return False
     if not x then return x else do
         y <- (keyName *> return True) <|> return False
-        if not y then return y else
+        if not y then return y else do
+            trace "still in lookaheadForSet" $ return ()
             (symbolic '=' *> return True) <|> return False
 
 parseNixFile :: MonadIO m => FilePath -> m (Result NExpr)

Nix/Parser/Library.hs

@@ -1,27 +1,43 @@
 {-# LANGUAGE CPP #-}
 
-module Nix.Parser.Library
+module Nix.Parser.Library ( module Nix.Parser.Library, module X ) where
-    (
+
-#if USE_PARSEC
+import           Control.Applicative
-      module Text.Parsec
-    , module Text.Parsec.Expr
-    , module Text.Parsec.Text
-#else
-      module Text.Trifecta
-    , module Text.Parser.Expression
-    , module Text.Parser.LookAhead
-#endif
-    )
-    where
 
 #if USE_PARSEC
 
-import Control.Applicative
+import           Control.Monad
-import Data.Text.IO
+import           Control.Monad.IO.Class
-import Text.Parsec hiding ((<|>), many, optional)
+import           Data.Text.IO as T
-import Text.Parsec.Expr
+import           Text.Parsec as X hiding ((<|>), many, optional)
-import Text.Parsec.Text
+import           Text.Parsec.Expr as X
-import Text.PrettyPrint.ANSI.Leijen (Doc, text)
+import           Text.Parsec.Text as X
+import qualified Text.Parsec.Token as P
+import           Text.PrettyPrint.ANSI.Leijen as X (Doc, text)
+
+lexer :: Stream s m Char => P.GenTokenParser s u m
+lexer = P.makeTokenParser P.LanguageDef
+    { P.commentStart    = "/*"
+    , P.commentEnd      = "*/"
+    , P.commentLine     = "#"
+    , P.nestedComments  = True
+    , P.identStart      = letter <|> char '_'
+    , P.identLetter     = alphaNum <|> char '_'
+    , P.opStart         = oneOf ":!#$%&*+./<=>?@\\^|-~"
+    , P.opLetter        = oneOf "@"
+    , P.reservedNames   = []
+    , P.reservedOpNames = []
+    , P.caseSensitive   = True
+    }
+
+parens :: Parser a -> Parser a
+parens = P.parens lexer
+
+brackets :: Parser a -> Parser a
+brackets = P.brackets lexer
+
+braces :: Parser a -> Parser a
+braces = P.braces lexer
 
 symbol :: String -> Parser String
 symbol str = string str <* whiteSpace
@@ -33,7 +49,7 @@ decimal :: Parser Integer
 decimal = read <$> some digit
 
 whiteSpace :: Parser ()
-whiteSpace = spaces
+whiteSpace = P.whiteSpace lexer
 
 data Result a = Success a
               | Failure Doc
@@ -41,12 +57,19 @@ data Result a = Success a
 parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a)
 parseFromFileEx p path =
     (either (Failure . text . show) Success . parse p path)
-        `liftM` liftIO (readFile path)
+        `liftM` liftIO (T.readFile path)
 
 #else
 
-import Text.Parser.Expression
+import Text.Parser.Expression as X
-import Text.Parser.LookAhead
+import Text.Parser.LookAhead as X
-import Text.Trifecta
+import Text.Parser.Token as X
+import Text.Trifecta as X
 
 #endif
+
+someTill :: Parser a -> Parser end -> Parser [a]
+someTill p end = go *> scan
+  where
+    go = do { x <- p; xs <- scan; return (x:xs) }
+    scan = (end *> return []) <|>  go

default.nix

@@ -1,5 +1,5 @@
 { cabal, parsers, trifecta, text, ansiWlPprint, parsec, transformers
-, useParsec ? false
+, useParsec ? true
 }:
 
 cabal.mkDerivation (self: rec {