231 lines
7.0 KiB
Haskell
231 lines
7.0 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
module Nix.Parser (parseNixFile, Result(..)) where
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Control.Monad.IO.Class
|
|
import Data.Char
|
|
import Data.Foldable
|
|
import Data.List (foldl1')
|
|
import qualified Data.Map as Map
|
|
import Data.Text hiding (head, map, foldl1')
|
|
import Nix.Types
|
|
import Nix.Internal
|
|
import Nix.Parser.Library
|
|
import qualified Prelude
|
|
import Prelude hiding (elem)
|
|
|
|
nixApp :: Parser NExpr
|
|
nixApp = go <$> some (whiteSpace *> nixExpr True)
|
|
where
|
|
go [] = error "some has failed us"
|
|
go [x] = x
|
|
go (f:xs) = Fix (NApp f (go xs))
|
|
|
|
nixExpr :: Bool -> Parser NExpr
|
|
nixExpr allowLambdas =
|
|
buildExpressionParser table (nixTerm allowLambdas) <?> "expression"
|
|
where
|
|
table :: OperatorTable Parser NExpr
|
|
table =
|
|
[ [ prefix "-" NNeg ]
|
|
, [ binary "++" NConcat AssocRight ]
|
|
, [ binary "*" NMult AssocLeft,
|
|
binary "/" NDiv AssocLeft ]
|
|
, [ binary "+" NPlus AssocLeft,
|
|
binary "-" NMinus AssocLeft ]
|
|
]
|
|
|
|
binary name fun =
|
|
Infix (pure (\x y -> Fix (NOper (fun x y))) <* symbol name)
|
|
prefix name fun =
|
|
Prefix (pure (Fix . NOper . fun) <* symbol name)
|
|
-- postfix name fun =
|
|
-- Postfix (pure (Fix . NOper . fun) <* symbol name)
|
|
|
|
nixTerm :: Bool -> Parser NExpr
|
|
nixTerm allowLambdas = choice
|
|
[ 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 ()
|
|
x <- try (lookAhead symName)
|
|
<|> try (lookAhead (singleton <$> char '{'))
|
|
<|> return ""
|
|
if x == "rec" || x == "{"
|
|
then setOrArgs
|
|
else do
|
|
trace "might still have a lambda" $ return ()
|
|
y <- try (lookAhead (symName *> whiteSpace *> symbolic ':'
|
|
*> return True))
|
|
<|> return False
|
|
trace ("results are = " ++ show y) $ return ()
|
|
if y
|
|
then if allowLambdas
|
|
then setOrArgs
|
|
else error "Unexpected lambda"
|
|
else keyName <?> "string"
|
|
|
|
symName :: Parser Text
|
|
symName = do
|
|
chars <- some (satisfy (\c -> isAlpha c || c == '.'))
|
|
trace ("chars = " ++ show chars) $ return ()
|
|
guard (isLower (head chars))
|
|
return $ pack (trace ("chars: " ++ show chars) chars)
|
|
|
|
stringish :: Parser NExpr
|
|
stringish
|
|
= (char '"' *>
|
|
(merge <$> manyTill stringChar (char '"')))
|
|
<|> (char '$' *> between (symbolic '{') (symbolic '}') nixApp)
|
|
where
|
|
merge = foldl1' (\x y -> Fix (NOper (NConcat x y)))
|
|
|
|
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"
|
|
|
|
argName = (,) <$> (symName <* whiteSpace)
|
|
<*> optional (symbolic '?' *> nixTerm False)
|
|
|
|
nvPair :: Parser (NExpr, NExpr)
|
|
nvPair = (,) <$> keyName <*> (symbolic '=' *> nixApp)
|
|
|
|
keyName :: Parser NExpr
|
|
keyName = (stringish <|> (mkSym <$> symName)) <* whiteSpace
|
|
|
|
setOrArgs :: Parser NExpr
|
|
setOrArgs = do
|
|
trace "setOrArgs" $ return ()
|
|
sawRec <- try (symbol "rec" *> pure True) <|> pure False
|
|
trace ("Do we have sawRec: " ++ show sawRec) $ return ()
|
|
haveSet <-
|
|
if sawRec
|
|
then return True
|
|
else try (lookAhead lookaheadForSet)
|
|
trace ("Do we have a set: " ++ show haveSet) $ return ()
|
|
if haveSet
|
|
then between (symbolic '{') (symbolic '}')
|
|
(Fix . NSet sawRec <$> nvPair `endBy` symbolic ';')
|
|
<?> "set"
|
|
else do
|
|
trace "parsing arguments" $ return ()
|
|
args <- argExpr <?> "arguments"
|
|
trace ("args: " ++ show args) $ return ()
|
|
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
|
|
|
|
-}
|