2018-04-10 17:34:21 +02:00
|
|
|
{-# LANGUAGE CPP #-}
|
2018-05-07 21:06:56 +02:00
|
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
2018-09-10 03:30:15 +02:00
|
|
|
{-# LANGUAGE DeriveFunctor #-}
|
2018-05-07 21:06:56 +02:00
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
|
|
{-# LANGUAGE LambdaCase #-}
|
2018-04-07 21:02:50 +02:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
|
|
|
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
2018-05-07 21:06:56 +02:00
|
|
|
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
|
|
|
|
|
|
|
module Nix.Parser
|
|
|
|
( parseNixFile
|
|
|
|
, parseNixFileLoc
|
|
|
|
, parseNixText
|
|
|
|
, parseNixTextLoc
|
|
|
|
, parseFromFileEx
|
2018-09-10 04:09:11 +02:00
|
|
|
, Parser
|
2018-05-07 21:06:56 +02:00
|
|
|
, parseFromText
|
|
|
|
, Result(..)
|
|
|
|
, reservedNames
|
|
|
|
, OperatorInfo(..)
|
|
|
|
, NSpecialOp(..)
|
|
|
|
, NAssoc(..)
|
|
|
|
, NOperatorDef
|
|
|
|
, getUnaryOperator
|
|
|
|
, getBinaryOperator
|
|
|
|
, getSpecialOperator
|
2018-09-10 04:09:11 +02:00
|
|
|
|
|
|
|
, nixToplevelForm
|
|
|
|
, nixExpr
|
|
|
|
, nixSet
|
|
|
|
, nixBinders
|
|
|
|
, nixSelector
|
|
|
|
|
|
|
|
, nixSym
|
|
|
|
, nixPath
|
|
|
|
, nixString
|
|
|
|
, nixUri
|
|
|
|
, nixSearchPath
|
|
|
|
, nixFloat
|
|
|
|
, nixInt
|
|
|
|
, nixBool
|
|
|
|
, nixNull
|
2018-09-10 05:10:35 +02:00
|
|
|
, symbol
|
|
|
|
, whiteSpace
|
2018-05-07 21:06:56 +02:00
|
|
|
) where
|
|
|
|
|
2018-11-17 00:30:19 +01:00
|
|
|
import Prelude hiding (readFile)
|
|
|
|
|
2018-05-07 21:06:56 +02:00
|
|
|
import Control.Applicative hiding (many, some)
|
|
|
|
import Control.DeepSeq
|
2018-04-07 21:02:50 +02:00
|
|
|
import Control.Monad
|
2018-04-10 06:35:46 +02:00
|
|
|
import Data.Char (isAlpha, isDigit, isSpace)
|
2018-05-07 21:06:56 +02:00
|
|
|
import Data.Data (Data(..))
|
|
|
|
import Data.Foldable (concat)
|
2018-04-07 21:02:50 +02:00
|
|
|
import Data.Functor
|
2018-05-07 21:06:56 +02:00
|
|
|
import Data.Functor.Identity
|
|
|
|
import Data.HashSet (HashSet)
|
|
|
|
import qualified Data.HashSet as HashSet
|
2018-04-17 21:46:41 +02:00
|
|
|
import Data.List.NonEmpty (NonEmpty(..))
|
2018-04-10 01:11:31 +02:00
|
|
|
import qualified Data.List.NonEmpty as NE
|
2018-05-07 21:06:56 +02:00
|
|
|
import qualified Data.Map as Map
|
|
|
|
import Data.Text (Text)
|
|
|
|
import Data.Text hiding (map, foldr1, concat, concatMap, zipWith)
|
2018-11-17 05:51:18 +01:00
|
|
|
import Data.Text.Prettyprint.Doc (Doc, pretty)
|
2018-11-17 00:30:19 +01:00
|
|
|
import Data.Text.Encoding
|
2018-05-07 21:06:56 +02:00
|
|
|
import Data.Typeable (Typeable)
|
|
|
|
import Data.Void
|
|
|
|
import GHC.Generics hiding (Prefix)
|
2018-04-07 21:02:50 +02:00
|
|
|
import Nix.Expr hiding (($>))
|
2018-11-17 00:30:19 +01:00
|
|
|
import Nix.Render
|
2018-04-21 02:05:21 +02:00
|
|
|
import Nix.Strings
|
2018-05-07 21:06:56 +02:00
|
|
|
import Text.Megaparsec
|
|
|
|
import Text.Megaparsec.Char
|
|
|
|
import qualified Text.Megaparsec.Char.Lexer as L
|
2018-04-10 01:11:31 +02:00
|
|
|
import Text.Megaparsec.Expr
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-04-17 06:39:41 +02:00
|
|
|
infixl 3 <+>
|
|
|
|
(<+>) :: MonadPlus m => m a -> m a -> m a
|
|
|
|
(<+>) = mplus
|
|
|
|
|
2018-04-07 21:02:50 +02:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
2018-09-10 04:10:53 +02:00
|
|
|
nixExpr :: Parser NExprLoc
|
|
|
|
nixExpr = makeExprParser nixTerm $ map (map snd) (nixOperators nixSelector)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-04-09 19:16:25 +02:00
|
|
|
antiStart :: Parser Text
|
2018-04-11 08:40:32 +02:00
|
|
|
antiStart = symbol "${" <?> show ("${" :: String)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixAntiquoted :: Parser a -> Parser (Antiquoted a NExprLoc)
|
2018-04-10 06:35:46 +02:00
|
|
|
nixAntiquoted p =
|
2018-04-10 19:11:55 +02:00
|
|
|
Antiquoted <$> (antiStart *> nixToplevelForm <* symbol "}")
|
2018-04-17 06:39:41 +02:00
|
|
|
<+> Plain <$> p
|
2018-04-10 08:34:21 +02:00
|
|
|
<?> "anti-quotation"
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
selDot :: Parser ()
|
2018-04-10 08:34:21 +02:00
|
|
|
selDot = try (symbol "." *> notFollowedBy nixPath) <?> "."
|
|
|
|
|
|
|
|
nixSelect :: Parser NExprLoc -> Parser NExprLoc
|
2018-04-11 03:02:31 +02:00
|
|
|
nixSelect term = do
|
|
|
|
res <- build
|
|
|
|
<$> term
|
|
|
|
<*> optional ((,) <$> (selDot *> nixSelector)
|
|
|
|
<*> optional (reserved "or" *> nixTerm))
|
|
|
|
continues <- optional $ lookAhead selDot
|
|
|
|
case continues of
|
|
|
|
Nothing -> pure res
|
|
|
|
Just _ -> nixSelect (pure res)
|
2018-04-10 08:34:21 +02:00
|
|
|
where
|
|
|
|
build :: NExprLoc
|
|
|
|
-> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc)
|
|
|
|
-> NExprLoc
|
|
|
|
build t Nothing = t
|
|
|
|
build t (Just (s,o)) = nSelectLoc t s o
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
|
2018-04-17 21:46:41 +02:00
|
|
|
nixSelector = annotateLocation $ do
|
|
|
|
(x:xs) <- keyName `sepBy1` selDot
|
|
|
|
return $ x :| xs
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-04-10 08:34:21 +02:00
|
|
|
nixTerm :: Parser NExprLoc
|
2018-04-11 03:02:31 +02:00
|
|
|
nixTerm = do
|
2018-04-10 19:11:55 +02:00
|
|
|
c <- try $ lookAhead $ satisfy $ \x ->
|
|
|
|
pathChar x ||
|
|
|
|
x == '(' ||
|
|
|
|
x == '{' ||
|
|
|
|
x == '[' ||
|
|
|
|
x == '<' ||
|
|
|
|
x == '/' ||
|
|
|
|
x == '"' ||
|
|
|
|
x == '\''
|
|
|
|
case c of
|
2018-04-11 03:02:31 +02:00
|
|
|
'(' -> nixSelect nixParens
|
|
|
|
'{' -> nixSelect nixSet
|
2018-04-10 19:11:55 +02:00
|
|
|
'[' -> nixList
|
2018-09-10 04:10:53 +02:00
|
|
|
'<' -> nixSearchPath
|
2018-04-10 19:11:55 +02:00
|
|
|
'/' -> nixPath
|
2018-09-10 04:10:53 +02:00
|
|
|
'"' -> nixString
|
|
|
|
'\'' -> nixString
|
2018-04-17 06:39:41 +02:00
|
|
|
_ -> msum $
|
2018-04-11 03:02:31 +02:00
|
|
|
[ nixSelect nixSet | c == 'r' ] ++
|
2018-04-10 19:11:55 +02:00
|
|
|
[ nixPath | pathChar c ] ++
|
2018-04-17 03:45:28 +02:00
|
|
|
if isDigit c
|
|
|
|
then [ nixFloat
|
|
|
|
, nixInt ]
|
|
|
|
else [ nixUri | isAlpha c ] ++
|
|
|
|
[ nixBool | c == 't' || c == 'f' ] ++
|
|
|
|
[ nixNull | c == 'n' ] ++
|
|
|
|
[ nixSelect nixSym ]
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixToplevelForm :: Parser NExprLoc
|
2018-09-10 04:10:53 +02:00
|
|
|
nixToplevelForm = keywords <+> nixLambda <+> nixExpr
|
2018-04-10 19:11:55 +02:00
|
|
|
where
|
2018-04-17 06:39:41 +02:00
|
|
|
keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixSym :: Parser NExprLoc
|
|
|
|
nixSym = annotateLocation1 $ mkSymF <$> identifier
|
|
|
|
|
|
|
|
nixInt :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixInt = annotateLocation1 (mkIntF <$> integer <?> "integer")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixFloat :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixFloat = annotateLocation1 (try (mkFloatF . realToFrac <$> float) <?> "float")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixBool :: Parser NExprLoc
|
2018-04-17 06:39:41 +02:00
|
|
|
nixBool = annotateLocation1 (bool "true" True <+>
|
2018-04-11 08:40:32 +02:00
|
|
|
bool "false" False) <?> "bool" where
|
2018-04-11 03:02:31 +02:00
|
|
|
bool str b = mkBoolF b <$ reserved str
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixNull :: Parser NExprLoc
|
2018-04-11 03:02:31 +02:00
|
|
|
nixNull = annotateLocation1 (mkNullF <$ reserved "null" <?> "null")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixParens :: Parser NExprLoc
|
2018-04-10 19:11:55 +02:00
|
|
|
nixParens = parens nixToplevelForm <?> "parens"
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixList :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixList = annotateLocation1 (brackets (NList <$> many nixTerm) <?> "list")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-04-10 18:45:04 +02:00
|
|
|
pathChar :: Char -> Bool
|
2018-04-21 08:17:57 +02:00
|
|
|
pathChar x = isAlpha x || isDigit x || x == '.' || x == '_' || x == '-' || x == '+' || x == '~'
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
slash :: Parser Char
|
2018-04-10 06:35:46 +02:00
|
|
|
slash = try (char '/' <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x)))
|
2018-04-07 21:02:50 +02:00
|
|
|
<?> "slash"
|
|
|
|
|
|
|
|
-- | A path surrounded by angle brackets, indicating that it should be
|
|
|
|
-- looked up in the NIX_PATH environment variable at evaluation.
|
2018-09-10 04:10:53 +02:00
|
|
|
nixSearchPath :: Parser NExprLoc
|
|
|
|
nixSearchPath = annotateLocation1
|
2018-04-17 06:39:41 +02:00
|
|
|
(mkPathF True <$> try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")
|
2018-04-10 06:35:46 +02:00
|
|
|
<?> "spath")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-04-10 08:34:21 +02:00
|
|
|
pathStr :: Parser FilePath
|
2018-04-10 18:45:04 +02:00
|
|
|
pathStr = lexeme $ liftM2 (++) (many (satisfy pathChar))
|
|
|
|
(Prelude.concat <$> some (liftM2 (:) slash (some (satisfy pathChar))))
|
2018-04-10 08:34:21 +02:00
|
|
|
|
2018-04-07 21:02:50 +02:00
|
|
|
nixPath :: Parser NExprLoc
|
2018-04-10 09:40:11 +02:00
|
|
|
nixPath = annotateLocation1 (try (mkPathF False <$> pathStr) <?> "path")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixLet :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixLet = annotateLocation1 (reserved "let"
|
2018-04-17 06:39:41 +02:00
|
|
|
*> (letBody <+> letBinders)
|
2018-04-09 19:16:25 +02:00
|
|
|
<?> "let block")
|
2018-04-07 21:02:50 +02:00
|
|
|
where
|
2018-04-19 08:42:13 +02:00
|
|
|
letBinders = NLet
|
|
|
|
<$> nixBinders
|
|
|
|
<*> (reserved "in" *> nixToplevelForm)
|
2018-04-07 21:02:50 +02:00
|
|
|
-- Let expressions `let {..., body = ...}' are just desugared
|
|
|
|
-- into `(rec {..., body = ...}).body'.
|
2018-05-09 10:25:01 +02:00
|
|
|
letBody = (\x -> NSelect x (StaticKey "body" :| []) Nothing) <$> aset
|
2018-04-07 21:02:50 +02:00
|
|
|
aset = annotateLocation1 $ NRecSet <$> braces nixBinders
|
|
|
|
|
|
|
|
nixIf :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixIf = annotateLocation1 (NIf
|
2018-09-10 04:10:53 +02:00
|
|
|
<$> (reserved "if" *> nixExpr)
|
2018-04-10 19:11:55 +02:00
|
|
|
<*> (reserved "then" *> nixToplevelForm)
|
|
|
|
<*> (reserved "else" *> nixToplevelForm)
|
2018-04-09 19:16:25 +02:00
|
|
|
<?> "if")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixAssert :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixAssert = annotateLocation1 (NAssert
|
2018-09-10 04:10:53 +02:00
|
|
|
<$> (reserved "assert" *> nixExpr)
|
2018-04-10 19:11:55 +02:00
|
|
|
<*> (semi *> nixToplevelForm)
|
2018-04-09 19:16:25 +02:00
|
|
|
<?> "assert")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixWith :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixWith = annotateLocation1 (NWith
|
2018-04-10 19:11:55 +02:00
|
|
|
<$> (reserved "with" *> nixToplevelForm)
|
|
|
|
<*> (semi *> nixToplevelForm)
|
2018-04-09 19:16:25 +02:00
|
|
|
<?> "with")
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixLambda :: Parser NExprLoc
|
2018-04-10 19:11:55 +02:00
|
|
|
nixLambda = nAbs <$> annotateLocation (try argExpr) <*> nixToplevelForm
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-09-10 04:10:53 +02:00
|
|
|
nixString :: Parser NExprLoc
|
|
|
|
nixString = nStr <$> annotateLocation nixString'
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixUri :: Parser NExprLoc
|
2018-04-10 17:34:21 +02:00
|
|
|
nixUri = annotateLocation1 $ lexeme $ try $ do
|
|
|
|
start <- letterChar
|
|
|
|
protocol <- many $ satisfy $ \x ->
|
|
|
|
isAlpha x || isDigit x || x `elem` ("+-." :: String)
|
|
|
|
_ <- string ":"
|
|
|
|
address <- some $ satisfy $ \x ->
|
|
|
|
isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)
|
2018-05-08 21:15:50 +02:00
|
|
|
return $ NStr $
|
|
|
|
DoubleQuoted [Plain $ pack $ start : protocol ++ ':' : address]
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-09-10 04:10:53 +02:00
|
|
|
nixString' :: Parser (NString NExprLoc)
|
|
|
|
nixString' = lexeme (doubleQuoted <+> indented <?> "string")
|
2018-04-07 21:02:50 +02:00
|
|
|
where
|
|
|
|
doubleQuoted :: Parser (NString NExprLoc)
|
|
|
|
doubleQuoted = DoubleQuoted . removePlainEmpty . mergePlain
|
2018-04-11 08:26:00 +02:00
|
|
|
<$> (doubleQ *> many (stringChar doubleQ (void $ char '\\')
|
|
|
|
doubleEscape)
|
2018-04-09 19:16:25 +02:00
|
|
|
<* doubleQ)
|
2018-04-07 21:02:50 +02:00
|
|
|
<?> "double quoted string"
|
|
|
|
|
2018-04-10 08:34:21 +02:00
|
|
|
doubleQ = void (char '"')
|
2018-04-07 21:02:50 +02:00
|
|
|
doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode)
|
|
|
|
|
|
|
|
indented :: Parser (NString NExprLoc)
|
|
|
|
indented = stripIndent
|
2018-04-11 08:26:00 +02:00
|
|
|
<$> (indentedQ *> many (stringChar indentedQ indentedQ
|
|
|
|
indentedEscape)
|
2018-04-09 19:16:25 +02:00
|
|
|
<* indentedQ)
|
2018-04-07 21:02:50 +02:00
|
|
|
<?> "indented string"
|
|
|
|
|
2018-04-11 08:26:00 +02:00
|
|
|
indentedQ = void (string "''" <?> "\"''\"")
|
2018-04-11 03:45:57 +02:00
|
|
|
indentedEscape = try $ do
|
|
|
|
indentedQ
|
2018-04-17 06:39:41 +02:00
|
|
|
(Plain <$> ("''" <$ char '\'' <+> "$" <$ char '$')) <+> do
|
2018-04-11 03:45:57 +02:00
|
|
|
_ <- char '\\'
|
|
|
|
c <- escapeCode
|
|
|
|
pure $ if c == '\n'
|
|
|
|
then EscapedNewline
|
|
|
|
else Plain $ singleton c
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-04-11 08:26:00 +02:00
|
|
|
stringChar end escStart esc =
|
|
|
|
Antiquoted <$> (antiStart *> nixToplevelForm <* char '}')
|
2018-04-17 06:39:41 +02:00
|
|
|
<+> Plain . singleton <$> char '$'
|
|
|
|
<+> esc
|
|
|
|
<+> Plain . pack <$> some plainChar
|
2018-04-10 01:11:31 +02:00
|
|
|
where
|
|
|
|
plainChar =
|
2018-04-17 06:39:41 +02:00
|
|
|
notFollowedBy (end <+> void (char '$') <+> escStart) *> anyChar
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-04-17 06:39:41 +02:00
|
|
|
escapeCode = msum [ c <$ char e | (c,e) <- escapeCodes ] <+> anyChar
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
-- | Gets all of the arguments for a function.
|
|
|
|
argExpr :: Parser (Params NExprLoc)
|
2018-04-17 06:39:41 +02:00
|
|
|
argExpr = msum [atLeft, onlyname, atRight] <* symbol ":" where
|
2018-04-07 21:02:50 +02:00
|
|
|
-- An argument not in curly braces. There's some potential ambiguity
|
|
|
|
-- in the case of, for example `x:y`. Is it a lambda function `x: y`, or
|
|
|
|
-- a URI `x:y`? Nix syntax says it's the latter. So we need to fail if
|
|
|
|
-- there's a valid URI parse here.
|
2018-04-17 06:39:41 +02:00
|
|
|
onlyname = msum [nixUri >> unexpected (Label ('v' NE.:| "alid uri")),
|
2018-04-07 21:02:50 +02:00
|
|
|
Param <$> identifier]
|
|
|
|
|
|
|
|
-- Parameters named by an identifier on the left (`args @ {x, y}`)
|
|
|
|
atLeft = try $ do
|
2018-04-09 19:16:25 +02:00
|
|
|
name <- identifier <* symbol "@"
|
2018-04-07 21:02:50 +02:00
|
|
|
(variadic, params) <- params
|
|
|
|
return $ ParamSet params variadic (Just name)
|
|
|
|
|
|
|
|
-- Parameters named by an identifier on the right, or none (`{x, y} @ args`)
|
|
|
|
atRight = do
|
|
|
|
(variadic, params) <- params
|
2018-04-09 19:16:25 +02:00
|
|
|
name <- optional $ symbol "@" *> identifier
|
2018-04-07 21:02:50 +02:00
|
|
|
return $ ParamSet params variadic name
|
|
|
|
|
|
|
|
-- Return the parameters set.
|
|
|
|
params = do
|
|
|
|
(args, dotdots) <- braces getParams
|
2018-04-10 20:58:08 +02:00
|
|
|
return (dotdots, args)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
-- Collects the parameters within curly braces. Returns the parameters and
|
|
|
|
-- a boolean indicating if the parameters are variadic.
|
|
|
|
getParams :: Parser ([(Text, Maybe NExprLoc)], Bool)
|
|
|
|
getParams = go [] where
|
|
|
|
-- Attempt to parse `...`. If this succeeds, stop and return True.
|
|
|
|
-- Otherwise, attempt to parse an argument, optionally with a
|
|
|
|
-- default. If this fails, then return what has been accumulated
|
|
|
|
-- so far.
|
2018-04-17 06:39:41 +02:00
|
|
|
go acc = ((acc, True) <$ symbol "...") <+> getMore acc
|
2018-04-07 21:02:50 +02:00
|
|
|
getMore acc =
|
|
|
|
-- Could be nothing, in which just return what we have so far.
|
|
|
|
option (acc, False) $ do
|
|
|
|
-- Get an argument name and an optional default.
|
2018-04-17 06:39:41 +02:00
|
|
|
pair <- liftM2 (,) identifier (optional $ question *> nixToplevelForm)
|
2018-04-07 21:02:50 +02:00
|
|
|
-- Either return this, or attempt to get a comma and restart.
|
2018-04-09 19:16:25 +02:00
|
|
|
option (acc ++ [pair], False) $ comma >> go (acc ++ [pair])
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixBinders :: Parser [Binding NExprLoc]
|
2018-04-17 06:39:41 +02:00
|
|
|
nixBinders = (inherit <+> namedVar) `endBy` semi where
|
2018-05-09 10:25:01 +02:00
|
|
|
inherit = do
|
2018-05-13 23:10:02 +02:00
|
|
|
-- We can't use 'reserved' here because it would consume the whitespace
|
|
|
|
-- after the keyword, which is not exactly the semantics of C++ Nix.
|
|
|
|
try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))
|
2018-05-09 10:25:01 +02:00
|
|
|
p <- getPosition
|
2018-05-10 09:00:50 +02:00
|
|
|
x <- whiteSpace *> optional scope
|
2018-05-09 10:25:01 +02:00
|
|
|
Inherit x <$> many keyName <*> pure p <?> "inherited binding"
|
|
|
|
namedVar = do
|
|
|
|
p <- getPosition
|
|
|
|
NamedVar <$> (annotated <$> nixSelector)
|
|
|
|
<*> (equals *> nixToplevelForm)
|
|
|
|
<*> pure p
|
|
|
|
<?> "variable binding"
|
2018-04-10 19:11:55 +02:00
|
|
|
scope = parens nixToplevelForm <?> "inherit scope"
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
keyName :: Parser (NKeyName NExprLoc)
|
2018-04-17 06:39:41 +02:00
|
|
|
keyName = dynamicKey <+> staticKey where
|
2018-05-09 10:25:01 +02:00
|
|
|
staticKey = StaticKey <$> identifier
|
2018-09-10 04:10:53 +02:00
|
|
|
dynamicKey = DynamicKey <$> nixAntiquoted nixString'
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
nixSet :: Parser NExprLoc
|
2018-04-10 01:11:31 +02:00
|
|
|
nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set") where
|
2018-04-11 08:40:32 +02:00
|
|
|
isRec = (reserved "rec" $> NRecSet <?> "recursive set")
|
2018-04-17 06:39:41 +02:00
|
|
|
<+> pure NSet
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-11-17 00:30:19 +01:00
|
|
|
parseNixFile :: MonadFile m => FilePath -> m (Result NExpr)
|
2018-04-10 19:11:55 +02:00
|
|
|
parseNixFile =
|
|
|
|
parseFromFileEx $ stripAnnotation <$> (whiteSpace *> nixToplevelForm <* eof)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
2018-11-17 00:30:19 +01:00
|
|
|
parseNixFileLoc :: MonadFile m => FilePath -> m (Result NExprLoc)
|
2018-04-10 19:11:55 +02:00
|
|
|
parseNixFileLoc = parseFromFileEx (whiteSpace *> nixToplevelForm <* eof)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
parseNixText :: Text -> Result NExpr
|
2018-04-10 19:11:55 +02:00
|
|
|
parseNixText =
|
|
|
|
parseFromText $ stripAnnotation <$> (whiteSpace *> nixToplevelForm <* eof)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
parseNixTextLoc :: Text -> Result NExprLoc
|
2018-04-10 19:11:55 +02:00
|
|
|
parseNixTextLoc = parseFromText (whiteSpace *> nixToplevelForm <* eof)
|
2018-05-07 21:06:56 +02:00
|
|
|
|
|
|
|
{- Parser.Library -}
|
|
|
|
|
|
|
|
skipLineComment' :: Tokens Text -> Parser ()
|
|
|
|
skipLineComment' prefix =
|
|
|
|
string prefix
|
|
|
|
*> void (takeWhileP (Just "character") (\x -> x /= '\n' && x /= '\r'))
|
|
|
|
|
|
|
|
whiteSpace :: Parser ()
|
|
|
|
whiteSpace = L.space space1 lineCmnt blockCmnt
|
|
|
|
where
|
|
|
|
lineCmnt = skipLineComment' "#"
|
|
|
|
blockCmnt = L.skipBlockComment "/*" "*/"
|
|
|
|
|
|
|
|
lexeme :: Parser a -> Parser a
|
|
|
|
lexeme p = p <* whiteSpace
|
|
|
|
|
|
|
|
symbol :: Text -> Parser Text
|
|
|
|
symbol = lexeme . string
|
|
|
|
|
|
|
|
reservedEnd :: Char -> Bool
|
|
|
|
reservedEnd x = isSpace x ||
|
|
|
|
x == '{' || x == '(' || x == '[' ||
|
|
|
|
x == '}' || x == ')' || x == ']' ||
|
|
|
|
x == ';' || x == ':' || x == '.' ||
|
|
|
|
x == '"' || x == '\'' || x == ','
|
|
|
|
|
|
|
|
reserved :: Text -> Parser ()
|
|
|
|
reserved n = lexeme $ try $
|
|
|
|
string n *> lookAhead (void (satisfy reservedEnd) <|> eof)
|
|
|
|
|
|
|
|
identifier = lexeme $ try $ do
|
|
|
|
ident <- cons <$> satisfy (\x -> isAlpha x || x == '_')
|
|
|
|
<*> takeWhileP Nothing identLetter
|
|
|
|
guard (not (ident `HashSet.member` reservedNames))
|
|
|
|
return ident
|
|
|
|
where
|
|
|
|
identLetter x = isAlpha x || isDigit x || x == '_' || x == '\'' || x == '-'
|
|
|
|
|
|
|
|
parens = between (symbol "(") (symbol ")")
|
|
|
|
braces = between (symbol "{") (symbol "}")
|
|
|
|
-- angles = between (symbol "<") (symbol ">")
|
|
|
|
brackets = between (symbol "[") (symbol "]")
|
|
|
|
semi = symbol ";"
|
|
|
|
comma = symbol ","
|
|
|
|
-- colon = symbol ":"
|
|
|
|
-- dot = symbol "."
|
|
|
|
equals = symbol "="
|
|
|
|
question = symbol "?"
|
|
|
|
|
|
|
|
integer :: Parser Integer
|
|
|
|
integer = lexeme L.decimal
|
|
|
|
|
|
|
|
float :: Parser Double
|
|
|
|
float = lexeme L.float
|
|
|
|
|
|
|
|
reservedNames :: HashSet Text
|
|
|
|
reservedNames = HashSet.fromList
|
|
|
|
[ "let", "in"
|
|
|
|
, "if", "then", "else"
|
|
|
|
, "assert"
|
|
|
|
, "with"
|
|
|
|
, "rec"
|
2018-08-05 18:20:00 +02:00
|
|
|
, "inherit" ]
|
2018-05-07 21:06:56 +02:00
|
|
|
|
|
|
|
type Parser = ParsecT Void Text Identity
|
|
|
|
|
2018-11-17 05:51:18 +01:00
|
|
|
data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
|
2018-05-07 21:06:56 +02:00
|
|
|
|
2018-11-17 00:30:19 +01:00
|
|
|
parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a)
|
2018-05-07 21:06:56 +02:00
|
|
|
parseFromFileEx p path = do
|
2018-11-17 00:30:19 +01:00
|
|
|
txt <- decodeUtf8 <$> readFile path
|
2018-11-17 05:51:18 +01:00
|
|
|
return $ either (Failure . pretty . parseErrorPretty' txt) Success
|
2018-05-07 21:06:56 +02:00
|
|
|
$ parse p path txt
|
|
|
|
|
|
|
|
parseFromText :: Parser a -> Text -> Result a
|
|
|
|
parseFromText p txt =
|
2018-11-17 05:51:18 +01:00
|
|
|
either (Failure . pretty . parseErrorPretty' txt) Success $
|
2018-05-07 21:06:56 +02:00
|
|
|
parse p "<string>" txt
|
|
|
|
|
|
|
|
{- Parser.Operators -}
|
|
|
|
|
|
|
|
data NSpecialOp = NHasAttrOp | NSelectOp
|
|
|
|
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
|
|
|
|
|
|
|
|
data NAssoc = NAssocNone | NAssocLeft | NAssocRight
|
|
|
|
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
|
|
|
|
|
|
|
|
data NOperatorDef
|
|
|
|
= NUnaryDef Text NUnaryOp
|
|
|
|
| NBinaryDef Text NBinaryOp NAssoc
|
|
|
|
| NSpecialDef Text NSpecialOp NAssoc
|
|
|
|
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
|
|
|
|
|
|
|
|
annotateLocation :: Parser a -> Parser (Ann SrcSpan a)
|
|
|
|
annotateLocation p = do
|
|
|
|
begin <- getPosition
|
|
|
|
res <- p
|
|
|
|
end <- getPosition
|
|
|
|
pure $ Ann (SrcSpan begin end) res
|
|
|
|
|
|
|
|
annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc
|
|
|
|
annotateLocation1 = fmap annToAnnF . annotateLocation
|
|
|
|
|
|
|
|
manyUnaryOp f = foldr1 (.) <$> some f
|
|
|
|
|
|
|
|
operator "-" = lexeme . try $ string "-" <* notFollowedBy (char '>')
|
|
|
|
operator "/" = lexeme . try $ string "/" <* notFollowedBy (char '/')
|
|
|
|
operator "<" = lexeme . try $ string "<" <* notFollowedBy (char '=')
|
|
|
|
operator ">" = lexeme . try $ string ">" <* notFollowedBy (char '=')
|
|
|
|
operator n = symbol n
|
|
|
|
|
|
|
|
opWithLoc :: Text -> o -> (Ann SrcSpan o -> a) -> Parser a
|
|
|
|
opWithLoc name op f = do
|
|
|
|
Ann ann _ <- annotateLocation $ {- dbg (unpack name) $ -} operator name
|
|
|
|
return $ f (Ann ann op)
|
|
|
|
|
|
|
|
binaryN name op = (NBinaryDef name op NAssocNone,
|
|
|
|
InfixN (opWithLoc name op nBinary))
|
|
|
|
binaryL name op = (NBinaryDef name op NAssocLeft,
|
|
|
|
InfixL (opWithLoc name op nBinary))
|
|
|
|
binaryR name op = (NBinaryDef name op NAssocRight,
|
|
|
|
InfixR (opWithLoc name op nBinary))
|
|
|
|
prefix name op = (NUnaryDef name op,
|
|
|
|
Prefix (manyUnaryOp (opWithLoc name op nUnary)))
|
|
|
|
-- postfix name op = (NUnaryDef name op,
|
|
|
|
-- Postfix (opWithLoc name op nUnary))
|
|
|
|
|
|
|
|
nixOperators
|
|
|
|
:: Parser (Ann SrcSpan (NAttrPath NExprLoc))
|
|
|
|
-> [[(NOperatorDef, Operator Parser NExprLoc)]]
|
|
|
|
nixOperators selector =
|
|
|
|
[ -- This is not parsed here, even though technically it's part of the
|
|
|
|
-- expression table. The problem is that in some cases, such as list
|
|
|
|
-- membership, it's also a term. And since terms are effectively the
|
|
|
|
-- highest precedence entities parsed by the expression parser, it ends up
|
|
|
|
-- working out that we parse them as a kind of "meta-term".
|
|
|
|
|
|
|
|
-- {- 1 -} [ (NSpecialDef "." NSelectOp NAssocLeft,
|
|
|
|
-- Postfix $ do
|
|
|
|
-- sel <- seldot *> selector
|
|
|
|
-- mor <- optional (reserved "or" *> term)
|
|
|
|
-- return $ \x -> nSelectLoc x sel mor) ]
|
|
|
|
|
|
|
|
{- 2 -} [ (NBinaryDef " " NApp NAssocLeft,
|
|
|
|
-- Thanks to Brent Yorgey for showing me this trick!
|
|
|
|
InfixL $ nApp <$ symbol "") ]
|
|
|
|
, {- 3 -} [ prefix "-" NNeg ]
|
|
|
|
, {- 4 -} [ (NSpecialDef "?" NHasAttrOp NAssocLeft,
|
|
|
|
Postfix $ symbol "?" *> (flip nHasAttr <$> selector)) ]
|
|
|
|
, {- 5 -} [ binaryR "++" NConcat ]
|
|
|
|
, {- 6 -} [ binaryL "*" NMult
|
|
|
|
, binaryL "/" NDiv ]
|
|
|
|
, {- 7 -} [ binaryL "+" NPlus
|
|
|
|
, binaryL "-" NMinus ]
|
|
|
|
, {- 8 -} [ prefix "!" NNot ]
|
|
|
|
, {- 9 -} [ binaryR "//" NUpdate ]
|
|
|
|
, {- 10 -} [ binaryL "<" NLt
|
|
|
|
, binaryL ">" NGt
|
|
|
|
, binaryL "<=" NLte
|
|
|
|
, binaryL ">=" NGte ]
|
|
|
|
, {- 11 -} [ binaryN "==" NEq
|
|
|
|
, binaryN "!=" NNEq ]
|
|
|
|
, {- 12 -} [ binaryL "&&" NAnd ]
|
|
|
|
, {- 13 -} [ binaryL "||" NOr ]
|
|
|
|
, {- 14 -} [ binaryN "->" NImpl ]
|
|
|
|
]
|
|
|
|
|
|
|
|
data OperatorInfo = OperatorInfo
|
|
|
|
{ precedence :: Int
|
|
|
|
, associativity :: NAssoc
|
|
|
|
, operatorName :: Text
|
|
|
|
} deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
|
|
|
|
|
|
|
getUnaryOperator :: NUnaryOp -> OperatorInfo
|
|
|
|
getUnaryOperator = (m Map.!) where
|
|
|
|
m = Map.fromList $ concat $ zipWith buildEntry [1..]
|
|
|
|
(nixOperators (error "unused"))
|
|
|
|
buildEntry i = concatMap $ \case
|
|
|
|
(NUnaryDef name op, _) -> [(op, OperatorInfo i NAssocNone name)]
|
|
|
|
_ -> []
|
|
|
|
|
|
|
|
getBinaryOperator :: NBinaryOp -> OperatorInfo
|
|
|
|
getBinaryOperator = (m Map.!) where
|
|
|
|
m = Map.fromList $ concat $ zipWith buildEntry [1..]
|
|
|
|
(nixOperators (error "unused"))
|
|
|
|
buildEntry i = concatMap $ \case
|
|
|
|
(NBinaryDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
|
|
|
|
_ -> []
|
|
|
|
|
|
|
|
getSpecialOperator :: NSpecialOp -> OperatorInfo
|
|
|
|
getSpecialOperator NSelectOp = OperatorInfo 1 NAssocLeft "."
|
|
|
|
getSpecialOperator o = m Map.! o where
|
|
|
|
m = Map.fromList $ concat $ zipWith buildEntry [1..]
|
|
|
|
(nixOperators (error "unused"))
|
|
|
|
buildEntry i = concatMap $ \case
|
|
|
|
(NSpecialDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
|
|
|
|
_ -> []
|