More work on the megaparsec parser

main/Main.hs

@@ -4,8 +4,8 @@
 
 module Main where
 
--- import           Control.DeepSeq
--- import qualified Control.Exception as Exc
+import           Control.DeepSeq
+import qualified Control.Exception as Exc
 import           Control.Monad
 import           Control.Monad.ST
 import           Data.Text (Text)
@@ -25,6 +25,7 @@ data Options = Options
     , debug      :: Bool
     , evaluate   :: Bool
     , check      :: Bool
+    , parseOnly  :: Bool
     , expression :: Maybe Text
     , fromFile   :: Maybe FilePath
     , filePaths  :: [FilePath]
@@ -46,6 +47,9 @@ mainOptions = Options
     <*> switch
         (   long "check"
          <> help "Whether to check for syntax errors after parsing")
+    <*> switch
+        (   long "parse-only"
+         <> help "Whether to parse only, no pretty printing or checking")
     <*> optional (strOption
         (   short 'e'
          <> long "expr"
@@ -105,6 +109,8 @@ main = do
                      putStrLn . printNix =<< Nix.evalLoc mpath expr
                | debug opts ->
                      print $ stripAnnotation expr
+               | parseOnly opts ->
+                     void $ Exc.evaluate $ force expr
                | otherwise ->
                      displayIO stdout
                          . renderPretty 0.4 80

src/Nix/Parser.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
@@ -64,7 +65,8 @@ nixSelect term = build
 nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
 nixSelector = annotateLocation $ keyName `sepBy1` selDot
 
-{-
+-- #define DEBUG_PARSER 1
+#if DEBUG_PARSER
 -- | A self-contained unit.
 nixTerm :: Parser NExprLoc
 nixTerm = nixSelect $ choice
@@ -88,8 +90,7 @@ nixToplevelForm = choice
     , dbg "If"     nixIf
     , dbg "Assert" nixAssert
     , dbg "With"   nixWith ]
--}
-
+#else
 nixTerm :: Parser NExprLoc
 nixTerm = nixSelect $ choice
     [ nixPath
@@ -112,6 +113,7 @@ nixToplevelForm = choice
     , nixIf
     , nixAssert
     , nixWith ]
+#endif
 
 nixSym :: Parser NExprLoc
 nixSym = annotateLocation1 $ mkSymF <$> identifier
@@ -199,18 +201,15 @@ nixLambda = nAbs <$> annotateLocation (try argExpr) <*> nixExprLoc
 nixStringExpr :: Parser NExprLoc
 nixStringExpr = nStr <$> annotateLocation nixString
 
-uriAfterColonC :: Parser Char
-uriAfterColonC = alphaNumChar <|>
-    satisfy (\x -> x `elem` ("%/?:@&=+$,-_.!~*'" :: String))
-
 nixUri :: Parser NExprLoc
-nixUri = annotateLocation1 (fmap (mkUriF . pack) ((++)
-  <$> try ((++) <$> (scheme <* char ':') <*> fmap (\x -> [':',x]) uriAfterColonC)
-  <*> many uriAfterColonC
-  <?> "uri"))
- where
-  scheme = (:) <$> letterChar
-               <*> many (alphaNumChar <|> satisfy (\x -> x `elem` ("+-." :: String)))
+nixUri = annotateLocation1 $ lexeme $ try $ do
+    start <- letterChar
+    protocol <- many $ satisfy $ \x ->
+        isAlpha x || isDigit x || x `elem` ("+-." :: String)
+    _ <- string ":"
+    address  <- some $ satisfy $ \x ->
+        isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)
+    return $ mkUriF $ pack $ start : protocol ++ ':' : address
 
 nixString :: Parser (NString NExprLoc)
 nixString = lexeme (doubleQuoted <|> indented <?> "string")

src/Nix/Parser/Library.hs

@@ -36,10 +36,11 @@ lexeme p = p <* whiteSpace
 symbol = lexeme . string
 
 reserved :: Text -> Parser ()
-reserved n = lexeme $ do
-    _ <- string n <*
-        lookAhead (satisfy (\x -> isSpace x || x == '{' || x == '(' || x == ';'))
+reserved n = lexeme $ try $ do
+    _ <- string n <* lookAhead (satisfy endMarker)
     return ()
+  where
+    endMarker x = isSpace x || x == '{' || x == '(' || x == ';'
 
 opStart :: Parser Char
 opStart = satisfy $ \x ->