mirror of
https://github.com/haskell-nix/hnix.git
synced 2024-09-20 03:08:45 +03:00
More work on the megaparsec parser
This commit is contained in:
parent
3deb142a93
commit
2694f6ffaf
10
main/Main.hs
10
main/Main.hs
@ -4,8 +4,8 @@
|
|||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
-- import Control.DeepSeq
|
import Control.DeepSeq
|
||||||
-- import qualified Control.Exception as Exc
|
import qualified Control.Exception as Exc
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.ST
|
import Control.Monad.ST
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
@ -25,6 +25,7 @@ data Options = Options
|
|||||||
, debug :: Bool
|
, debug :: Bool
|
||||||
, evaluate :: Bool
|
, evaluate :: Bool
|
||||||
, check :: Bool
|
, check :: Bool
|
||||||
|
, parseOnly :: Bool
|
||||||
, expression :: Maybe Text
|
, expression :: Maybe Text
|
||||||
, fromFile :: Maybe FilePath
|
, fromFile :: Maybe FilePath
|
||||||
, filePaths :: [FilePath]
|
, filePaths :: [FilePath]
|
||||||
@ -46,6 +47,9 @@ mainOptions = Options
|
|||||||
<*> switch
|
<*> switch
|
||||||
( long "check"
|
( long "check"
|
||||||
<> help "Whether to check for syntax errors after parsing")
|
<> 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
|
<*> optional (strOption
|
||||||
( short 'e'
|
( short 'e'
|
||||||
<> long "expr"
|
<> long "expr"
|
||||||
@ -105,6 +109,8 @@ main = do
|
|||||||
putStrLn . printNix =<< Nix.evalLoc mpath expr
|
putStrLn . printNix =<< Nix.evalLoc mpath expr
|
||||||
| debug opts ->
|
| debug opts ->
|
||||||
print $ stripAnnotation expr
|
print $ stripAnnotation expr
|
||||||
|
| parseOnly opts ->
|
||||||
|
void $ Exc.evaluate $ force expr
|
||||||
| otherwise ->
|
| otherwise ->
|
||||||
displayIO stdout
|
displayIO stdout
|
||||||
. renderPretty 0.4 80
|
. renderPretty 0.4 80
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
||||||
@ -64,7 +65,8 @@ nixSelect term = build
|
|||||||
nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
|
nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
|
||||||
nixSelector = annotateLocation $ keyName `sepBy1` selDot
|
nixSelector = annotateLocation $ keyName `sepBy1` selDot
|
||||||
|
|
||||||
{-
|
-- #define DEBUG_PARSER 1
|
||||||
|
#if DEBUG_PARSER
|
||||||
-- | A self-contained unit.
|
-- | A self-contained unit.
|
||||||
nixTerm :: Parser NExprLoc
|
nixTerm :: Parser NExprLoc
|
||||||
nixTerm = nixSelect $ choice
|
nixTerm = nixSelect $ choice
|
||||||
@ -88,8 +90,7 @@ nixToplevelForm = choice
|
|||||||
, dbg "If" nixIf
|
, dbg "If" nixIf
|
||||||
, dbg "Assert" nixAssert
|
, dbg "Assert" nixAssert
|
||||||
, dbg "With" nixWith ]
|
, dbg "With" nixWith ]
|
||||||
-}
|
#else
|
||||||
|
|
||||||
nixTerm :: Parser NExprLoc
|
nixTerm :: Parser NExprLoc
|
||||||
nixTerm = nixSelect $ choice
|
nixTerm = nixSelect $ choice
|
||||||
[ nixPath
|
[ nixPath
|
||||||
@ -112,6 +113,7 @@ nixToplevelForm = choice
|
|||||||
, nixIf
|
, nixIf
|
||||||
, nixAssert
|
, nixAssert
|
||||||
, nixWith ]
|
, nixWith ]
|
||||||
|
#endif
|
||||||
|
|
||||||
nixSym :: Parser NExprLoc
|
nixSym :: Parser NExprLoc
|
||||||
nixSym = annotateLocation1 $ mkSymF <$> identifier
|
nixSym = annotateLocation1 $ mkSymF <$> identifier
|
||||||
@ -199,18 +201,15 @@ nixLambda = nAbs <$> annotateLocation (try argExpr) <*> nixExprLoc
|
|||||||
nixStringExpr :: Parser NExprLoc
|
nixStringExpr :: Parser NExprLoc
|
||||||
nixStringExpr = nStr <$> annotateLocation nixString
|
nixStringExpr = nStr <$> annotateLocation nixString
|
||||||
|
|
||||||
uriAfterColonC :: Parser Char
|
|
||||||
uriAfterColonC = alphaNumChar <|>
|
|
||||||
satisfy (\x -> x `elem` ("%/?:@&=+$,-_.!~*'" :: String))
|
|
||||||
|
|
||||||
nixUri :: Parser NExprLoc
|
nixUri :: Parser NExprLoc
|
||||||
nixUri = annotateLocation1 (fmap (mkUriF . pack) ((++)
|
nixUri = annotateLocation1 $ lexeme $ try $ do
|
||||||
<$> try ((++) <$> (scheme <* char ':') <*> fmap (\x -> [':',x]) uriAfterColonC)
|
start <- letterChar
|
||||||
<*> many uriAfterColonC
|
protocol <- many $ satisfy $ \x ->
|
||||||
<?> "uri"))
|
isAlpha x || isDigit x || x `elem` ("+-." :: String)
|
||||||
where
|
_ <- string ":"
|
||||||
scheme = (:) <$> letterChar
|
address <- some $ satisfy $ \x ->
|
||||||
<*> many (alphaNumChar <|> satisfy (\x -> x `elem` ("+-." :: String)))
|
isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)
|
||||||
|
return $ mkUriF $ pack $ start : protocol ++ ':' : address
|
||||||
|
|
||||||
nixString :: Parser (NString NExprLoc)
|
nixString :: Parser (NString NExprLoc)
|
||||||
nixString = lexeme (doubleQuoted <|> indented <?> "string")
|
nixString = lexeme (doubleQuoted <|> indented <?> "string")
|
||||||
|
@ -36,10 +36,11 @@ lexeme p = p <* whiteSpace
|
|||||||
symbol = lexeme . string
|
symbol = lexeme . string
|
||||||
|
|
||||||
reserved :: Text -> Parser ()
|
reserved :: Text -> Parser ()
|
||||||
reserved n = lexeme $ do
|
reserved n = lexeme $ try $ do
|
||||||
_ <- string n <*
|
_ <- string n <* lookAhead (satisfy endMarker)
|
||||||
lookAhead (satisfy (\x -> isSpace x || x == '{' || x == '(' || x == ';'))
|
|
||||||
return ()
|
return ()
|
||||||
|
where
|
||||||
|
endMarker x = isSpace x || x == '{' || x == '(' || x == ';'
|
||||||
|
|
||||||
opStart :: Parser Char
|
opStart :: Parser Char
|
||||||
opStart = satisfy $ \x ->
|
opStart = satisfy $ \x ->
|
||||||
|
Loading…
Reference in New Issue
Block a user