Merge branch 'master' into string_context_255
This commit is contained in:
John Wiegley
GitHub
commit
dddf425a22
|
|
@ -82,7 +82,7 @@ import Nix.Frames
|
|||
import Nix.NixString
|
||||
import Nix.Normal
|
||||
import Nix.Options
|
||||
import Nix.Parser
|
||||
import Nix.Parser hiding (nixPath)
|
||||
import Nix.Render
|
||||
import Nix.Scope
|
||||
import Nix.Thunk
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
|
@ -14,6 +15,7 @@ module Nix.Parser
|
|||
, parseNixText
|
||||
, parseNixTextLoc
|
||||
, parseFromFileEx
|
||||
, Parser
|
||||
, parseFromText
|
||||
, Result(..)
|
||||
, reservedNames
|
||||
|
|
@ -24,6 +26,24 @@ module Nix.Parser
|
|||
, getUnaryOperator
|
||||
, getBinaryOperator
|
||||
, getSpecialOperator
|
||||
|
||||
, nixToplevelForm
|
||||
, nixExpr
|
||||
, nixSet
|
||||
, nixBinders
|
||||
, nixSelector
|
||||
|
||||
, nixSym
|
||||
, nixPath
|
||||
, nixString
|
||||
, nixUri
|
||||
, nixSearchPath
|
||||
, nixFloat
|
||||
, nixInt
|
||||
, nixBool
|
||||
, nixNull
|
||||
, symbol
|
||||
, whiteSpace
|
||||
) where
|
||||
|
||||
import Control.Applicative hiding (many, some)
|
||||
|
|
@ -60,8 +80,8 @@ infixl 3 <+>
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
nixExprLoc :: Parser NExprLoc
|
||||
nixExprLoc = makeExprParser nixTerm $ map (map snd) (nixOperators nixSelector)
|
||||
nixExpr :: Parser NExprLoc
|
||||
nixExpr = makeExprParser nixTerm $ map (map snd) (nixOperators nixSelector)
|
||||
|
||||
antiStart :: Parser Text
|
||||
antiStart = symbol "${" <?> show ("${" :: String)
|
||||
|
|
@ -112,10 +132,10 @@ nixTerm = do
|
|||
'(' -> nixSelect nixParens
|
||||
'{' -> nixSelect nixSet
|
||||
'[' -> nixList
|
||||
'<' -> nixSPath
|
||||
'<' -> nixSearchPath
|
||||
'/' -> nixPath
|
||||
'"' -> nixStringExpr
|
||||
'\'' -> nixStringExpr
|
||||
'"' -> nixString
|
||||
'\'' -> nixString
|
||||
_ -> msum $
|
||||
[ nixSelect nixSet | c == 'r' ] ++
|
||||
[ nixPath | pathChar c ] ++
|
||||
|
|
@ -128,7 +148,7 @@ nixTerm = do
|
|||
[ nixSelect nixSym ]
|
||||
|
||||
nixToplevelForm :: Parser NExprLoc
|
||||
nixToplevelForm = keywords <+> nixLambda <+> nixExprLoc
|
||||
nixToplevelForm = keywords <+> nixLambda <+> nixExpr
|
||||
where
|
||||
keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith
|
||||
|
||||
|
|
@ -164,8 +184,8 @@ slash = try (char '/' <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || i
|
|||
|
||||
-- | A path surrounded by angle brackets, indicating that it should be
|
||||
-- looked up in the NIX_PATH environment variable at evaluation.
|
||||
nixSPath :: Parser NExprLoc
|
||||
nixSPath = annotateLocation1
|
||||
nixSearchPath :: Parser NExprLoc
|
||||
nixSearchPath = annotateLocation1
|
||||
(mkPathF True <$> try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")
|
||||
<?> "spath")
|
||||
|
||||
|
|
@ -191,14 +211,14 @@ nixLet = annotateLocation1 (reserved "let"
|
|||
|
||||
nixIf :: Parser NExprLoc
|
||||
nixIf = annotateLocation1 (NIf
|
||||
<$> (reserved "if" *> nixExprLoc)
|
||||
<$> (reserved "if" *> nixExpr)
|
||||
<*> (reserved "then" *> nixToplevelForm)
|
||||
<*> (reserved "else" *> nixToplevelForm)
|
||||
<?> "if")
|
||||
|
||||
nixAssert :: Parser NExprLoc
|
||||
nixAssert = annotateLocation1 (NAssert
|
||||
<$> (reserved "assert" *> nixExprLoc)
|
||||
<$> (reserved "assert" *> nixExpr)
|
||||
<*> (semi *> nixToplevelForm)
|
||||
<?> "assert")
|
||||
|
||||
|
|
@ -211,8 +231,8 @@ nixWith = annotateLocation1 (NWith
|
|||
nixLambda :: Parser NExprLoc
|
||||
nixLambda = nAbs <$> annotateLocation (try argExpr) <*> nixToplevelForm
|
||||
|
||||
nixStringExpr :: Parser NExprLoc
|
||||
nixStringExpr = nStr <$> annotateLocation nixString
|
||||
nixString :: Parser NExprLoc
|
||||
nixString = nStr <$> annotateLocation nixString'
|
||||
|
||||
nixUri :: Parser NExprLoc
|
||||
nixUri = annotateLocation1 $ lexeme $ try $ do
|
||||
|
|
@ -225,8 +245,8 @@ nixUri = annotateLocation1 $ lexeme $ try $ do
|
|||
return $ NStr $
|
||||
DoubleQuoted [Plain $ pack $ start : protocol ++ ':' : address]
|
||||
|
||||
nixString :: Parser (NString NExprLoc)
|
||||
nixString = lexeme (doubleQuoted <+> indented <?> "string")
|
||||
nixString' :: Parser (NString NExprLoc)
|
||||
nixString' = lexeme (doubleQuoted <+> indented <?> "string")
|
||||
where
|
||||
doubleQuoted :: Parser (NString NExprLoc)
|
||||
doubleQuoted = DoubleQuoted . removePlainEmpty . mergePlain
|
||||
|
|
@ -330,7 +350,7 @@ nixBinders = (inherit <+> namedVar) `endBy` semi where
|
|||
keyName :: Parser (NKeyName NExprLoc)
|
||||
keyName = dynamicKey <+> staticKey where
|
||||
staticKey = StaticKey <$> identifier
|
||||
dynamicKey = DynamicKey <$> nixAntiquoted nixString
|
||||
dynamicKey = DynamicKey <$> nixAntiquoted nixString'
|
||||
|
||||
nixSet :: Parser NExprLoc
|
||||
nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set") where
|
||||
|
|
@ -417,7 +437,7 @@ reservedNames = HashSet.fromList
|
|||
|
||||
type Parser = ParsecT Void Text Identity
|
||||
|
||||
data Result a = Success a | Failure Doc deriving Show
|
||||
data Result a = Success a | Failure Doc deriving (Show, Functor)
|
||||
|
||||
parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a)
|
||||
parseFromFileEx p path = do
|
||||
|
|
|
|||
|
|
@ -318,6 +318,8 @@ dethunk = \case
|
|||
then pure $ Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
|
||||
else do
|
||||
eres <- readVar ref
|
||||
case eres of
|
||||
res <- case eres of
|
||||
Computed v -> removeEffectsM (_baseValue v)
|
||||
_ -> pure $ Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
|
||||
_ <- atomicModifyVar active (False,)
|
||||
return res
|
||||
|
|
@ -9,11 +9,12 @@
|
|||
module Nix.TH where
|
||||
|
||||
import Data.Fix
|
||||
import Data.Foldable
|
||||
import Data.Generics.Aliases
|
||||
import Data.Set (Set)
|
||||
import Data.Set (Set, (\\))
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as Text
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Quote
|
||||
import Nix.Atoms
|
||||
|
|
@ -22,22 +23,64 @@ import Nix.Parser
|
|||
|
||||
quoteExprExp :: String -> ExpQ
|
||||
quoteExprExp s = do
|
||||
expr <- case parseNixTextLoc (Text.pack s) of
|
||||
expr <- case parseNixText (Text.pack s) of
|
||||
Failure err -> fail $ show err
|
||||
Success e -> return e
|
||||
dataToExpQ (const Nothing `extQ` metaExp (freeVars expr)) expr
|
||||
|
||||
quoteExprPat :: String -> PatQ
|
||||
quoteExprPat s = do
|
||||
expr <- case parseNixTextLoc (Text.pack s) of
|
||||
expr <- case parseNixText (Text.pack s) of
|
||||
Failure err -> fail $ show err
|
||||
Success e -> return e
|
||||
dataToPatQ (const Nothing `extQ` metaPat (freeVars expr)) expr
|
||||
|
||||
freeVars :: NExprLoc -> Set VarName
|
||||
freeVars = cata $ \case
|
||||
NSym_ _ var -> Set.singleton var
|
||||
Compose (Ann _ x) -> fold x
|
||||
freeVars :: NExpr -> Set VarName
|
||||
freeVars e = case unFix e of
|
||||
(NConstant _) -> Set.empty
|
||||
(NStr string) -> foldMap freeVars string
|
||||
(NSym var) -> Set.singleton var
|
||||
(NList list) -> foldMap freeVars list
|
||||
(NSet bindings) -> foldMap bindFree bindings
|
||||
(NRecSet bindings) -> foldMap bindFree bindings \\ foldMap bindDefs bindings
|
||||
(NLiteralPath _) -> Set.empty
|
||||
(NEnvPath _) -> Set.empty
|
||||
(NUnary _ expr) -> freeVars expr
|
||||
(NBinary _ left right) -> freeVars left `Set.union` freeVars right
|
||||
(NSelect expr path orExpr) -> freeVars expr `Set.union` pathFree path `Set.union` maybe Set.empty freeVars orExpr
|
||||
(NHasAttr expr path) -> freeVars expr `Set.union` pathFree path
|
||||
(NAbs (Param varname) expr) -> Set.delete varname (freeVars expr)
|
||||
(NAbs (ParamSet set _ varname) expr) ->
|
||||
-- Include all free variables from the expression and the default arguments
|
||||
freeVars expr `Set.union` Set.unions (mapMaybe (fmap freeVars . snd) set)
|
||||
-- But remove the argument name if existing, and all arguments in the parameter set
|
||||
\\ maybe Set.empty Set.singleton varname \\ Set.fromList (map fst set)
|
||||
(NLet bindings expr) -> freeVars expr `Set.union` foldMap bindFree bindings \\ foldMap bindDefs bindings
|
||||
(NIf cond th el) -> freeVars cond `Set.union` freeVars th `Set.union` freeVars el
|
||||
-- Evaluation is needed to find out whether x is a "real" free variable in `with y; x`, we just include it
|
||||
-- This also makes sense because its value can be overridden by `x: with y; x`
|
||||
(NWith set expr) -> freeVars set `Set.union` freeVars expr
|
||||
(NAssert assertion expr) -> freeVars assertion `Set.union` freeVars expr
|
||||
|
||||
where
|
||||
|
||||
staticKey :: NKeyName r -> Maybe VarName
|
||||
staticKey (StaticKey varname) = Just varname
|
||||
staticKey (DynamicKey _) = Nothing
|
||||
|
||||
bindDefs :: Binding r -> Set VarName
|
||||
bindDefs (Inherit _ keys _) = Set.fromList $ mapMaybe staticKey keys
|
||||
bindDefs (NamedVar (StaticKey varname :| _) _ _) = Set.singleton varname
|
||||
bindDefs (NamedVar (DynamicKey _ :| _) _ _) = Set.empty
|
||||
|
||||
bindFree :: Binding NExpr -> Set VarName
|
||||
bindFree (Inherit Nothing keys _) = Set.fromList $ mapMaybe staticKey keys
|
||||
bindFree (Inherit (Just scope) _ _) = freeVars scope
|
||||
bindFree (NamedVar path expr _) = pathFree path `Set.union` freeVars expr
|
||||
|
||||
pathFree :: NAttrPath NExpr -> Set VarName
|
||||
pathFree = foldMap (foldMap freeVars)
|
||||
|
||||
|
||||
class ToExpr a where
|
||||
toExpr :: a -> NExprLoc
|
||||
|
|
|
|||
Loading…
Reference in a new issue