Down to 16 basic test failures with megaparsec

hnix.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b4bb539502138611081a4bd9bf0a38f573101647309db931461e50f536595869
+-- hash: 59b163436955fe71d606be041b46cadfa36f494fb45ea40526c82b5dae8cafc8
 
 name:           hnix
 version:        0.5.0
@@ -111,7 +111,6 @@ executable hnix
     , exceptions
     , hnix
     , insert-ordered-containers >=0.2.2 && <0.3
-    , megaparsec
     , mtl
     , optparse-applicative
     , template-haskell

main/Main.hs

@@ -88,7 +88,9 @@ main = do
     -- print . printNix =<< Nix.eval [nix|1 + 3|]
 
     handleResult opts mpath = \case
-        Failure err -> hPutStr stderr $ "Parse failed: " ++ show err
+        Failure err ->
+            errorWithoutStackTrace $ "Parse failed: " ++ show err
+
         Success expr -> do
             -- expr <- Exc.evaluate $ force expr
             -- putStrLn "Parsing file...done"

src/Nix/Builtins.hs

@@ -113,6 +113,7 @@ builtinsList = sequence [
     , add  TopLevel "throw"                      throw_
     , add2 TopLevel "scopedImport"               scopedImport
     , add  TopLevel "derivationStrict"           derivationStrict_
+    -- jww (2018-04-09): NYI
     -- , add0 TopLevel "derivation"                 $(do
     --       let f = "data/nix/corepkgs/derivation.nix"
     --       addDependentFile f
@@ -132,7 +133,7 @@ builtinsList = sequence [
     , add  Normal   "splitVersion"               splitVersion_
     , add2 Normal   "compareVersions"            compareVersions_
     , add2 Normal   "match"                      match_
-    --TODO: Support floats for `add` and `sub`
+    -- jww (2018-04-09): Support floats for `add` and `sub`
     , add' Normal   "add"                        (arity2 ((+) @Integer))
     , add' Normal   "sub"                        (arity2 ((-) @Integer))
     , add' Normal   "parseDrvName"               parseDrvName

src/Nix/Expr/Types/Annotated.hs

@@ -94,6 +94,10 @@ nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc
 nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) (NHasAttr e1 ats)
 nHasAttr _ _ = error "nHasAttr: unexpected"
 
+nApp :: NExprLoc -> NExprLoc -> NExprLoc
+nApp e1@(AnnE s1 _) e2@(AnnE s2 _) = AnnE (s1 <> s2) (NBinary NApp e1 e2)
+nApp _ _ = error "nApp: unexpected"
+
 nAbs :: Ann SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc
 nAbs (Ann s1 ps) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NAbs ps e1)
 nAbs _ _ = error "nAbs: unexpected"

src/Nix/Parser.hs

@@ -13,10 +13,11 @@ module Nix.Parser (
 import           Control.Applicative hiding (many, some)
 import           Control.Monad
 import           Control.Monad.IO.Class
+import           Data.Char (isAlpha, isDigit, isSpace)
 import           Data.Functor
 import qualified Data.List.NonEmpty as NE
 import qualified Data.HashMap.Strict.InsOrd as M
-import           Data.Text hiding (map, concat)
+import           Data.Text hiding (map)
 import           Nix.Expr hiding (($>))
 import           Nix.Parser.Library
 import           Nix.Parser.Operators
@@ -33,18 +34,21 @@ nixExprLoc :: Parser NExprLoc
 nixExprLoc = whiteSpace *> (nixToplevelForm <|> exprParser)
 
 exprParser :: Parser NExprLoc
-exprParser = makeExprParser nixTerm $
-    map (map snd) (nixOperators nixTerm nixSelector selDot)
+exprParser = makeExprParser (nixTerm <* whiteSpace) $
+    map (map snd) (nixOperators (nixTerm <* whiteSpace) nixSelector selDot)
 
 antiStart :: Parser Text
 antiStart = try (symbol "${") <?> show ("${" :: String)
 
 nixAntiquoted :: Parser a -> Parser (Antiquoted a NExprLoc)
-nixAntiquoted p = Antiquoted <$> (antiStart *> nixExprLoc <* symbol "}") <|> Plain <$> p
+nixAntiquoted p =
+        Antiquoted <$> (antiStart *> nixExprLoc <* symbol "}")
+    <|> Plain <$> p
 
 selDot :: Parser ()
-selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whiteSpace
-      <?> "."
+selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath))
+    *> whiteSpace
+    <?> "."
 
 nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
 nixSelector = annotateLocation $ keyName `sepBy1` selDot
@@ -52,11 +56,26 @@ nixSelector = annotateLocation $ keyName `sepBy1` selDot
 -- | A self-contained unit.
 nixTerm :: Parser NExprLoc
 nixTerm = choice
-  [ nixPath, nixSPath, nixFloat, nixInt, nixBool, nixNull, nixParens, nixList, nixUri
-  , nixStringExpr, nixSet, nixSym ]
+    [ {-dbg "Path"       -} nixPath
+    , {-dbg "SPath"      -} nixSPath
+    , {-dbg "Float"      -} nixFloat
+    , {-dbg "Int"        -} nixInt
+    , {-dbg "Bool" $     -} try (nixBool <* notFollowedBy (char '-'))
+    , {-dbg "Null" $     -} try (nixNull <* notFollowedBy (char '-'))
+    , {-dbg "Parens"     -} nixParens
+    , {-dbg "List"       -} nixList
+    , {-dbg "Uri"        -} nixUri
+    , {-dbg "StringExpr" -} nixStringExpr
+    , {-dbg "Set"        -} nixSet
+    , {-dbg "Path"       -} nixSym ]
 
 nixToplevelForm :: Parser NExprLoc
-nixToplevelForm = choice [nixLambda, nixLet, nixIf, nixAssert, nixWith]
+nixToplevelForm = choice
+    [ {-dbg "Lambda" -} nixLambda
+    , {-dbg "Let"    -} nixLet
+    , {-dbg "If"     -} nixIf
+    , {-dbg "Assert" -} nixAssert
+    , {-dbg "Lambda" -} nixWith ]
 
 nixSym :: Parser NExprLoc
 nixSym = annotateLocation1 $ mkSymF <$> identifier
@@ -81,31 +100,29 @@ nixParens = parens nixExprLoc <?> "parens"
 nixList :: Parser NExprLoc
 nixList = annotateLocation1 (brackets (NList <$> many nixTerm) <?> "list")
 
-pathChars :: String
-pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']
+pathChar :: Bool -> Parser Char
+pathChar allowSlash = satisfy $ \x ->
+    isAlpha x || isDigit x || x == '.' || x == '_' || x == '-' || x == '+'
+        || (allowSlash && x == '/')
 
 slash :: Parser Char
-slash = try (char '/' <* notFollowedBy (void (char '/') <|>
-                                        void (char '*') <|>
-                                        whiteSpace))
+slash = try (char '/' <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x)))
     <?> "slash"
 
 -- | A path surrounded by angle brackets, indicating that it should be
 -- looked up in the NIX_PATH environment variable at evaluation.
 nixSPath :: Parser NExprLoc
-nixSPath = annotateLocation1 (mkPathF True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* symbol ">")
-        <?> "spath")
+nixSPath = annotateLocation1
+    (mkPathF True <$> try (char '<' *> some (pathChar True) <* symbol ">")
+         <?> "spath")
 
 nixPath :: Parser NExprLoc
-nixPath = annotateLocation1 (parseToken (fmap (mkPathF False) (((++)
-    <$> (try ((++) <$> many (oneOf pathChars) <*> fmap (:[]) slash) <?> "path")
-    <*> fmap concat
-      (  some (some (oneOf pathChars)
-     <|> liftA2 (:) slash (some (oneOf pathChars)))
-      ))
-    <?> "path")))
-  where
-    parseToken p = p <* whiteSpace
+nixPath = annotateLocation1 $ try $ do
+    start  <- many (pathChar False)
+    middle <- some slash
+    finish <- some (pathChar True)
+    whiteSpace
+    return $ mkPathF False $ start ++ middle ++ finish
 
 nixLet :: Parser NExprLoc
 nixLet = annotateLocation1 (reserved "let"
@@ -235,7 +252,8 @@ argExpr = choice [atLeft, onlyname, atRight] <* symbol ":" where
       -- Could be nothing, in which just return what we have so far.
       option (acc, False) $ do
         -- Get an argument name and an optional default.
-        pair <- liftA2 (,) identifier (optional $ question *> nixExprLoc)
+        pair <- liftA2 (,) (identifier <* whiteSpace)
+                          (optional $ question *> nixExprLoc)
         -- Either return this, or attempt to get a comma and restart.
         option (acc ++ [pair], False) $ comma >> go (acc ++ [pair])
 
@@ -250,7 +268,7 @@ nixBinders = (inherit <|> namedVar) `endBy` semi where
   scope = parens nixExprLoc <?> "inherit scope"
 
 keyName :: Parser (NKeyName NExprLoc)
-keyName = dynamicKey <|> staticKey where
+keyName = (dynamicKey <|> staticKey) <* whiteSpace where
   staticKey = do
       beg <- getPosition
       StaticKey <$> identifier <*> pure (Just beg)

src/Nix/Parser/Library.hs

@@ -11,6 +11,7 @@ module Nix.Parser.Library
 import           Control.Applicative hiding (many)
 import           Control.Monad
 import           Control.Monad.IO.Class
+import           Data.Char (isAlpha, isDigit)
 import           Data.Functor.Identity
 import           Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
@@ -93,26 +94,25 @@ reservedOp o = token $ try $ void $
   highlight ReservedOperator (string o)
       <* (notFollowedBy opLetter <?> "end of " ++ o)
 
-opStart :: CharParsing m => m Char
-opStart = oneOf ".+-*/=<>&|!?"
-
 opLetter :: CharParsing m => m Char
 opLetter = oneOf ">+/&|="
 -}
 
+opStart :: Parser Char
+opStart = satisfy $ \x -> x `elem` (".+-*/=<>&|!?" :: String)
+
 identStart :: Parser Char
 identStart = letterChar <|> char '_'
 
 identLetter :: Parser Char
-identLetter = alphaNumChar
-    <|> satisfy (\x -> x == '"' || x == '_' || x == '\'' || x == '-')
+identLetter = satisfy $ \x ->
+    isAlpha x || isDigit x || x == '"' || x == '_' || x == '\'' || x == '-'
 
-symbol    = L.symbol whiteSpace
-lexeme    = L.lexeme whiteSpace
+symbol     = L.symbol whiteSpace
+lexeme     = L.lexeme whiteSpace
 reservedOp = symbol
-identifier :: Parser Text
 identifier = pack <$> ((:) <$> identStart <*> many identLetter)
-reserved  = symbol
+reserved   = symbol
 
 parens    = between (symbol "(") (symbol ")")
 braces    = between (symbol "{") (symbol "}")
@@ -155,7 +155,7 @@ stopWords = () <$
 whiteSpace :: Parser ()
 whiteSpace = L.space space1 lineCmnt blockCmnt
   where
-    lineCmnt  = L.skipLineComment "//"
+    lineCmnt  = L.skipLineComment "#"
     blockCmnt = L.skipBlockComment "/*" "*/"
 
 type Parser = ParsecT Void Text Identity

src/Nix/Parser/Operators.hs

@@ -41,9 +41,11 @@ annotateLocation p = do
 annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc
 annotateLocation1 = fmap annToAnnF . annotateLocation
 
+operator n = (lexeme . try) (string n <* notFollowedBy opStart)
+
 opWithLoc :: Text -> o -> (Ann SrcSpan o -> a) -> Parser a
 opWithLoc name op f = do
-    Ann ann _ <- annotateLocation (symbol name)
+    Ann ann _ <- annotateLocation (whiteSpace *> operator name)
     return $ f (Ann ann op)
 
 binaryN name op = (NBinaryDef name op NAssocNone,
@@ -66,7 +68,9 @@ nixOperators term selector seldot =
                        sel <- seldot *> selector
                        mor <- optional (reserved "or" *> term)
                        return $ \x -> nSelectLoc x sel mor) ]
-  , {-  2 -} [ binaryL " "  NApp ]
+  , {-  2 -} [ (NBinaryDef " " NApp NAssocLeft,
+                -- Thanks to Brent Yorgey for showing me this trick!
+                InfixL $ nApp <$ symbol "") ]
   , {-  3 -} [ prefix  "-"  NNeg ]
   , {-  4 -} [ (NSpecialDef "?" NHasAttrOp NAssocLeft,
                 Postfix $ symbol "?" *> (flip nHasAttr <$> selector)) ]

src/Nix/Stack.hs

@@ -38,7 +38,7 @@ class Monad m => MonadFile m where
     readFile :: FilePath -> m ByteString
 
 renderLocation :: MonadFile m => SrcSpan -> Doc -> m Doc
-renderLocation = error "NYI: renderLocation"
+renderLocation = error "NYI: renderLocation" -- jww (2018-04-09): NYI
 {-
 renderLocation (SrcSpan beg@(SourcePos "<string>" _ _) end) msg =
     return $ explain (addSpan (deltaToTrifecta beg) (deltaToTrifecta end)