175 lines
5.9 KiB
Haskell
175 lines
5.9 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
module Nix.Parser (parseNixFile, Result(..)) where
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Control.Monad.IO.Class
|
|
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 Prelude hiding (elem)
|
|
|
|
-- | The lexer for this parser is defined in 'Nix.Parser.Library'.
|
|
nixApp :: Parser NExpr
|
|
nixApp = go <$>
|
|
someTill (whiteSpace *> nixExpr True)
|
|
(try (lookAhead (() <$ oneOf "=,;])}" <|> reserved "then" <|> reserved "else" <|> eof)))
|
|
where
|
|
go [] = error "some has failed us"
|
|
go [x] = x
|
|
go (f:xs) = Fix (NApp f (go xs))
|
|
|
|
nixExpr :: Bool -> Parser NExpr
|
|
nixExpr = buildExpressionParser table . nixTerm
|
|
where
|
|
table =
|
|
[ [ prefix "-" NNeg ]
|
|
, [ prefix "~" NNeg ]
|
|
, [ prefix "?" NNeg ]
|
|
, [ binary "++" NConcat AssocRight ]
|
|
, [ binary "*" NMult AssocLeft, binary "/" NDiv AssocLeft ]
|
|
, [ binary "+" NPlus AssocLeft, binary "-" NMinus AssocLeft ]
|
|
, [ prefix "!" NNot ]
|
|
, [ binary "//" NUpdate AssocRight ]
|
|
, [ binary "<" NLt AssocLeft, binary ">" NGt AssocLeft
|
|
, binary "<=" NLte AssocLeft, binary ">=" NGte AssocLeft ]
|
|
, [ binary "==" NEq AssocNone, binary "!=" NNEq AssocNone ]
|
|
, [ binary "&&" NAnd AssocLeft ]
|
|
, [ binary "||" NOr AssocLeft ]
|
|
, [ binary "->" NImpl AssocNone ]
|
|
]
|
|
|
|
binary name fun = Infix ((\x y -> Fix (NOper (fun x y))) <$ symbol name)
|
|
prefix name fun = Prefix (Fix . NOper . fun <$ symbol name)
|
|
-- postfix name fun = Postfix (Fix . NOper . fun <$ symbol name)
|
|
|
|
nixTerm :: Bool -> Parser NExpr
|
|
nixTerm allowLambdas = choice
|
|
[ nixInt
|
|
, nixBool
|
|
, nixNull
|
|
, nixParens
|
|
, nixList
|
|
, nixPath
|
|
, nixLet
|
|
, nixIf
|
|
, setLambdaStringOrSym allowLambdas
|
|
]
|
|
|
|
nixInt :: Parser NExpr
|
|
nixInt = mkInt <$> decimal <?> "integer"
|
|
|
|
nixBool :: Parser NExpr
|
|
nixBool = try (mkBool . (== "true") <$> string "true") <?> "bool"
|
|
|
|
nixNull :: Parser NExpr
|
|
nixNull = try (mkNull <$ string "null") <?> "null"
|
|
|
|
nixParens :: Parser NExpr
|
|
nixParens = parens nixApp <?> "parens"
|
|
|
|
nixList :: Parser NExpr
|
|
nixList = brackets (Fix . NList <$> many (nixTerm False)) <?> "list"
|
|
|
|
nixPath :: Parser NExpr
|
|
nixPath = try $ fmap mkPath $ mfilter ('/' `elem`) $ some (oneOf "A-Za-z_0-9.:/")
|
|
|
|
nixLet :: Parser NExpr
|
|
nixLet = (Fix .) . NLet
|
|
<$> (reserved "let" *> nixBinders)
|
|
<*> (whiteSpace *> reserved "in" *> nixApp)
|
|
|
|
nixIf :: Parser NExpr
|
|
nixIf = Fix <$> (NIf
|
|
<$> (reserved "if" *> nixApp)
|
|
<*> (reserved "then" *> nixApp)
|
|
<*> (reserved "else" *> nixApp))
|
|
|
|
-- | This is a bit tricky because we don't know whether we're looking at a set
|
|
-- or a lambda until we've looked ahead a bit. And then it may be neither,
|
|
-- in which case we fall back to expected a plain string or identifier.
|
|
setLambdaStringOrSym :: Bool -> Parser NExpr
|
|
setLambdaStringOrSym allowLambdas = do
|
|
trace "setLambdaStringOrSym" $ return ()
|
|
x <- try (lookAhead identifier)
|
|
<|> try (lookAhead (singleton <$> char '{'))
|
|
<|> return ""
|
|
if x == "rec" || x == "{"
|
|
then setOrArgs
|
|
else do
|
|
trace "might still have a lambda" $ return ()
|
|
y <- try (lookAhead (True <$ (identifier *> whiteSpace *> symbolic ':')))
|
|
<|> return False
|
|
trace ("results are = " ++ show y) $ return ()
|
|
if y
|
|
then if allowLambdas
|
|
then setOrArgs
|
|
else error "Unexpected lambda"
|
|
else keyName <?> "string"
|
|
|
|
stringish :: Parser NExpr
|
|
stringish = (char '"' *> (merge <$> manyTill stringChar (char '"')))
|
|
<|> (char '$' *> braces nixApp)
|
|
where
|
|
merge = foldl1' (\x y -> Fix (NOper (NConcat x y)))
|
|
|
|
stringChar = char '\\' *> (mkStr . singleton <$> anyChar)
|
|
<|> (string "${" *> nixApp <* char '}')
|
|
<|> (mkStr . pack <$> many (noneOf "\"\\"))
|
|
|
|
argExpr :: Parser NExpr
|
|
argExpr = (Fix . NArgSet . Map.fromList <$> argList)
|
|
<|> ((mkSym <$> identifier) <?> "argname")
|
|
where
|
|
argList = braces ((argName <* whiteSpace) `sepBy` symbolic ',')
|
|
<?> "arglist"
|
|
|
|
argName = (,) <$> (identifier <* whiteSpace)
|
|
<*> optional (symbolic '?' *> nixExpr False)
|
|
|
|
nvPair :: Parser (NExpr, NExpr)
|
|
nvPair = (,) <$> keyName <*> (symbolic '=' *> nixApp)
|
|
|
|
nixBinders :: Parser [(NExpr, NExpr)]
|
|
nixBinders = nvPair `endBy` symbolic ';'
|
|
|
|
keyName :: Parser NExpr
|
|
keyName = (stringish <|> (mkSym <$> identifier)) <* whiteSpace
|
|
|
|
setOrArgs :: Parser NExpr
|
|
setOrArgs = do
|
|
trace "setOrArgs" $ return ()
|
|
sawRec <- try (reserved "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 braces (Fix . NSet sawRec <$> nixBinders) <?> "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 do
|
|
trace "still in lookaheadForSet" $ return ()
|
|
(symbolic '=' *> return True) <|> return False
|
|
|
|
parseNixFile :: MonadIO m => FilePath -> m (Result NExpr)
|
|
parseNixFile = parseFromFileEx nixApp
|