Cleaned up the parsing code

This commit is contained in:
John Wiegley 2014-07-01 00:15:49 -05:00
parent 8158557bb9
commit 52bfdd126b
1 changed files with 115 additions and 55 deletions

View File

@ -25,27 +25,43 @@ nixApp = go <$> some (whiteSpace *> nixTerm True)
nixTerm :: Bool -> Parser NExpr
nixTerm allowLambdas = choice
[ mkInt <$> decimal <?> "integer"
, (string "true" *> pure (mkBool True)) <?> "bool"
, (string "false" *> pure (mkBool False)) <?> "bool"
, (string "null" *> pure mkNull) <?> "null"
, between (symbolic '(') (symbolic ')') nixApp
<?> "parens"
, between (symbolic '[') (symbolic ']')
(Fix . NList <$> many (nixTerm False))
<?> "list"
, try (do chars <- some (satisfy isPathChar)
trace ("Path chars: " ++ show chars) $ return ()
guard ('/' `elem` chars)
return $ mkPath chars)
[ nixInt
, nixBool
, nixNull
, nixParens
, nixList
, nixPath
, maybeSetOrLambda allowLambdas
]
nixInt :: Parser NExpr
nixInt = mkInt <$> decimal <?> "integer"
nixBool :: Parser NExpr
nixBool = (string "true" *> pure (mkBool True))
<|> (string "false" *> pure (mkBool False))
<?> "bool"
nixNull :: Parser NExpr
nixNull = string "null" *> pure mkNull <?> "null"
nixParens :: Parser NExpr
nixParens = between (symbolic '(') (symbolic ')') nixApp <?> "parens"
nixList :: Parser NExpr
nixList = between (symbolic '[') (symbolic ']')
(Fix . NList <$> many (nixTerm False))
<?> "list"
nixPath :: Parser NExpr
nixPath = try $ do
chars <- some (satisfy isPathChar)
trace ("Path chars: " ++ show chars) $ return ()
guard ('/' `elem` chars)
return $ mkPath chars
where
isPathChar c = isAlpha c || c `Prelude.elem` ".:/"
maybeSetOrLambda :: Bool -> Parser NExpr
maybeSetOrLambda allowLambdas = do
trace "maybeSetOrLambda" $ return ()
@ -66,17 +82,6 @@ maybeSetOrLambda allowLambdas = do
else error "Unexpected lambda"
else keyName <?> "string"
isPathChar :: Char -> Bool
isPathChar c = isAlpha c || c `Prelude.elem` ".:/"
oneChar :: Parser NExpr
oneChar = mkStr . singleton <$> anyChar
stringChar :: Parser NExpr
stringChar = char '\\' *> oneChar
<|> (string "${" *> nixApp <* char '}')
<|> (mkStr . pack <$> many (noneOf "\"\\"))
symName :: Parser Text
symName = do
chars <- some (satisfy (\c -> isAlpha c || c == '.'))
@ -89,38 +94,30 @@ stringish
= (char '"' *>
(Fix . NConcat <$> manyTill stringChar (char '"')))
<|> (char '$' *> between (symbolic '{') (symbolic '}') nixApp)
keyName :: Parser NExpr
keyName = (stringish <|> (mkSym <$> symName)) <* whiteSpace
nvPair :: Parser (NExpr, NExpr)
nvPair = (,) <$> keyName
<*> (symbolic '=' *> nixApp)
where
stringChar :: Parser NExpr
stringChar = char '\\' *> oneChar
<|> (string "${" *> nixApp <* char '}')
<|> (mkStr . pack <$> many (noneOf "\"\\"))
where
oneChar = mkStr . singleton <$> anyChar
argExpr :: Parser NExpr
argExpr = (Fix . NArgSet . Map.fromList <$> argList)
<|> ((mkSym <$> symName) <?> "argname")
where
argList = between (symbolic '{') (symbolic '}')
((argName <* whiteSpace) `sepBy` symbolic ',')
<?> "arglist"
argList :: Parser [(Text, Maybe NExpr)]
argList = between (symbolic '{') (symbolic '}')
((argName <* whiteSpace) `sepBy` symbolic ',')
<?> "arglist"
argName = (,) <$> (symName <* whiteSpace)
<*> optional (try (symbolic '?' *> nixApp))
1
nvPair :: Parser (NExpr, NExpr)
nvPair = (,) <$> keyName <*> (symbolic '=' *> nixApp)
argName :: Parser (Text, Maybe NExpr)
argName = (,) <$> (symName <* whiteSpace)
<*> optional (try (symbolic '?' *> nixApp))
-- whiteSymbolic :: Char -> Parser Char
-- whiteSymbolic c = whiteSpace *> symbolic c
lookaheadForSet :: Parser Bool
lookaheadForSet = do
trace "lookaheadForSet" $ return ()
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
(symbolic '=' *> return True) <|> return False
keyName :: Parser NExpr
keyName = (stringish <|> (mkSym <$> symName)) <* whiteSpace
setOrArgs :: Parser NExpr
setOrArgs = do
@ -143,5 +140,68 @@ setOrArgs = do
symbolic ':' *> ((Fix .) . NAbs <$> pure args <*> nixApp)
<|> pure args
lookaheadForSet :: Parser Bool
lookaheadForSet = do
trace "lookaheadForSet" $ return ()
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
(symbolic '=' *> return True) <|> return False
parseNixFile :: MonadIO m => FilePath -> m (Result NExpr)
parseNixFile = parseFromFileEx nixApp
{-
Grammar of the Nix language (LL(n)). I conditionalize terms in the grammar
with a predicate suffix in square brackets. If the predicate fails, we
back-track. WS is used to indicate where arbitrary whitespace is allowed.
top ::= app
Applied expressions, or "expr expr", express function application. Since they
do not mean this within lists, we must call it out as a separate grammar rule so
that we can make clear when it is allowed.
app ::= expr WS+ app | (epsilon)
expr ::= atom
| '(' app ')'
| '[' list_members ']'
| "rec"[opt] '{' set_members[one kv_pair exists] '}'
| argspec ':' app
atom ::= INTEGER
| "true" | "false"
| "null"
| CHAR(0-9A-Za-z_./)+[elem '/']
| '"' string '"'
Strings are a bit special in that not only do they observe escaping conventions,
but they allow for interpolation of arbitrary Nix expressions. This means
they form a sub-grammar, so we assume a lexical context switch here.
string ::= string_elem string | (epsilon)
string_elem ::= '\' ANYCHAR | subexpr | ANYCHAR+
subexpr ::= "${" WS* app "}"
list_members ::= expr WS+ list_members | (epsilon)
set_members ::= kv_pair WS* ';' WS* set_members | (epsilon)
kv_pair ::= stringish WS* '=' WS* app
stringish ::= string | CHAR(0-9A-Za-z_.)+ | subexpr
argspec ::= CHAR(0-9A-Za-z_)+ | '{' arg_list '}'
arg_list ::= arg_specifier | arg_specifier ',' arg_list
arg_specifier ::= CHAR(0-9A-Za-z_)+ default_value[opt]
default_value ::= '?' app
-}