module Nix.Parser where
import qualified Prelude as P
import Text.Parsec hiding (many, (<|>), spaces, parse, State, uncons)
import qualified Text.Parsec as Parsec
import qualified Data.HashSet as HS
import qualified Data.HashMap.Strict as H
import Nix.Common
import Nix.Expr
type Parser = ParsecT String () Identity
parse :: Parser a -> Text -> Either ParseError a
parse p = Parsec.parse p "" . unpack
parseFull :: Parser a -> Text -> Either ParseError a
parseFull p = Parsec.parse (p <* eof) "" . unpack
comment :: Parser ()
comment = lineComment <|> blockComment >> return ()
where
lineComment = do
char '#'
manyTill anyChar (choice [char '\n' >> return (), eof])
blockComment = try $ do
string "/*"
manyTill anyChar (choice [try $ string "*/" >> return (), eof])
spaces :: Parser ()
spaces = many (oneOf "\n\t " *> return () <|> comment) >> return ()
spaces1 :: Parser ()
spaces1 = char ' ' >> spaces
sstring :: String -> Parser String
sstring = lexeme . string
schar :: Char -> Parser Char
schar = lexeme . char
lexeme :: Parser a -> Parser a
lexeme p = p <* spaces
pInt :: Parser Int
pInt = lexeme $ P.read <$> many1 digit
keyword :: String -> Parser String
keyword = try . sstring
pIdentifier :: Parser Text
pIdentifier = lexeme pIdentifier'
pIdentifier' :: Parser Text
pIdentifier' = notKeyword $ do
first <- letter <|> char '_'
rest <- many $ letter <|> digit <|> char '_' <|> char '-'
return $ pack $ first : rest
notKeyword :: Parser Text -> Parser Text
notKeyword p = try $ do
ident <- p
if ident `member` keywords then unexpected $ "keyword " <> show ident
else return ident
keywords :: HashSet Text
keywords = HS.fromList ["if", "then", "else", "null", "inherit", "rec",
"true", "false", "let", "in", "with", "assert"]
operators :: HashSet String
operators = HS.fromList ["+", "-", "*", "/", "++", "&&", "||", "//", "?",
"==", "!=", ">=", "<=", ">", "<"]
opChars :: [Char]
opChars = "+-*/&|?=><!$"
addLeft :: Text -> NixString -> NixString
addLeft txt (Plain p) = Plain (txt <> p)
addLeft txt (Antiquote s e s') = Antiquote (addLeft txt s) e s'
pInterp :: Parser NixString
pInterp = do
let stopChars = "$\\\""
plain <- pack <$> many (noneOf stopChars)
let stop = return $ Plain plain
continue = pInterp
continueWith s = fmap (addLeft (plain <> s)) continue
consume c = char c >> continueWith (singleton c)
option (Plain plain) $ do
lookAhead (oneOf stopChars) >>= \case
'$' -> char '$' >> lookAhead anyChar >>= \case
'{' -> Antiquote (Plain plain) <$> curlies <*> continue
'$' -> char '$' >> continueWith "$$"
c -> continueWith "$"
'\\' -> char '\\' >> anyChar >>= \case
'n' -> continueWith "\n"
'r' -> continueWith "\r"
't' -> continueWith "\t"
'b' -> continueWith "\b"
c -> continueWith $ singleton c
'"' -> stop
where curlies = between (schar '{') (char '}') pNixExpr
pInterpMultiLine :: Parser NixString
pInterpMultiLine = do
let stopChars = "$\\'"
plain <- pack <$> many (noneOf stopChars)
let stop = return (Plain plain)
continue = pInterpMultiLine
continueWith s = fmap (addLeft (plain <> s)) continue
consume c = char c >> continueWith (singleton c)
option (Plain plain) $ do
lookAhead (oneOf stopChars) >>= \case
'$' -> char '$' >> lookAhead anyChar >>= \case
'{' -> Antiquote (Plain plain) <$> curlies <*> continue
'$' -> char '$' >> continueWith "$$"
c -> continueWith "$"
'\\' -> char '\\' >> singleton <$> anyChar >>= continueWith
'\'' -> choice [lookAhead (string "''") >> stop,
consume '\'']
where curlies = between (schar '{') (char '}') pNixExpr
pOneLineString :: Parser NixString
pOneLineString = between (char '"') (schar '"') pInterp
pMultiLineString :: Parser NixString
pMultiLineString = between (string "''") (sstring "''") pInterpMultiLine
pString :: Parser NixExpr
pString = choice [OneLineString <$> pOneLineString,
MultiLineString <$> pMultiLineString]
pVar :: Parser NixExpr
pVar = try $ fmap Var $ pIdentifier <* notFollowedBy (char ':')
pBool :: Parser NixExpr
pBool = choice (map keyword ["true", "false"]) >>= \case
"true" -> return $ Bool True
"false" -> return $ Bool False
pNull :: Parser NixExpr
pNull = keyword "null" >> return Null
pFuncArgs :: Parser FuncArgs
pFuncArgs = choice [Arg <$> pIdentifier, pKwargs]
pKwargs :: Parser FuncArgs
pKwargs = do
(args, dotdots) <- between (schar '{') (schar '}') _getKwargs
argsNname <- optionMaybe $ schar '@' >> pIdentifier
return $ Kwargs (H.fromList args) dotdots argsNname
where
_getKwargs :: Parser ([(Name, Maybe NixExpr)], Bool)
_getKwargs = go [] where
go acc = (sstring "..." >> return (acc, True)) <|> getMore acc
getMore acc = do
option (acc, False) $ do
pair <- liftA2 (,) pIdentifier (optionMaybe $ schar '?' >> pNixExpr)
option (acc `snoc` pair, False) $ do
schar ','
go (acc `snoc` pair)
pFunction :: Parser NixExpr
pFunction = try $ do
args <- pFuncArgs
sstring ":"
body <- pNixExpr
return $ Function args body
pSet :: Parser NixExpr
pSet = try $ do
isRec <- isJust <$> optionMaybe (keyword "rec")
assigns <- between (schar '{') (schar '}') (many pNixAssign)
return $ Set isRec assigns
pLet :: Parser NixExpr
pLet = liftA2 Let (between (keyword "let") (keyword "in") $ many pNixAssign)
pNixExpr
pNixPathVar :: Parser Name
pNixPathVar = try $ between (char '<') (schar '>') pIdentifier'
pNixAssign :: Parser NixAssign
pNixAssign = choice [inherit, assign] <* schar ';' where
inherit = keyword "inherit" >> do
from <- optionMaybe pParens
names <- HS.fromList <$> many pIdentifier
return $ Inherit from names
assign = do
assignee <- pKeyPath
schar '='
val <- pNixExpr
return $ Assign assignee val
pPath :: Parser NixExpr
pPath = lexeme $ try $ do
dots <- option "" $ try (string "..") <|> string "."
rest <- try $ do
char '/' <* notFollowedBy (oneOf "*/")
path <- many1 (noneOf "\n\t ;#(){}")
return $ '/' : path
return $ Path $ fromString $ dots <> rest
pList :: Parser NixExpr
pList = fmap List $ between (schar '[') (schar ']') $ many pDot
pParens :: Parser NixExpr
pParens = between (schar '(') (schar ')') pNixExpr
pNixTerm :: Parser NixExpr
pNixTerm = choice [pString, pUriString, pVar, Num <$> pInt,
NixPathVar <$> pNixPathVar,
pBool, pNull, pList, pParens, pSet, pPath]
pKeyPath :: Parser [NixString]
pKeyPath = (Plain <$> pIdentifier <|> pOneLineString) `sepBy1` dot
where dot = try $ schar '.' <* notFollowedBy (char '.')
pDot :: Parser NixExpr
pDot = do
term <- pNixTerm
option term $ try $ do
schar '.'
keypath <- pKeyPath
alt <- optionMaybe (keyword "or" >> pNixExpr)
return $ Dot term keypath alt
pNot :: Parser NixExpr
pNot = do
optnot <- optionMaybe $ schar '!'
expr <- pApply
case optnot of
Nothing -> return expr
Just _ -> return $ Not expr
pNixExpr :: Parser NixExpr
pNixExpr = choice [pBinary, pFunction, pLet, pAssert, pWith, pIf, pNot]
pApply :: Parser NixExpr
pApply = pDot `chainl1` (pure Apply)
pBinary :: Parser NixExpr
pBinary = pNot `chainl1` fmap (flip BinOp) op where
op = try $ do
oper <- lexeme $ many1 (oneOf opChars)
if not $ HS.member oper operators
then unexpected $ "Invalid operator " <> show oper
else return $ pack oper
pAssert :: Parser NixExpr
pAssert = liftA2 Assert (keyword "assert" *> pNixExpr) (schar ';' *> pNixExpr)
pWith :: Parser NixExpr
pWith = liftA2 With (keyword "with" *> pNixExpr) (schar ';' *> pNixExpr)
pIf :: Parser NixExpr
pIf = liftA3 If (keyword "if" *> pNixExpr)
(keyword "then" *> pNixExpr)
(keyword "else" *> pNixExpr)
pUriString :: Parser NixExpr
pUriString = lexeme $ try $ do
scheme <- (:) <$> letter <*> many (letter <|> digit <|> char '+')
string ":"
rest <- many1 $ noneOf "\n\t ;"
return $ OneLineString $ Plain $ pack $ scheme <> ":" <> rest
pTopLevel :: Parser NixExpr
pTopLevel = pNixExpr
parseFile :: String -> IO (Either ParseError NixExpr)
parseFile = parseFileWith pTopLevel
parseFileWith :: Parser a -> String -> IO (Either ParseError a)
parseFileWith p path = parseFull (spaces >> p) <$> readFile path
parseNix :: Text -> Either ParseError NixExpr
parseNix = parseFull pTopLevel
parseNixA = parseFull pNixAssign