The Megaparsec version of Parser.hs is at least compiling
This commit is contained in:
John Wiegley
parent
b1fb73d363
commit
9beb9364e0
|
|
@ -248,7 +248,7 @@ unsafeGetAttrPos x y = force x $ \x' -> force y $ \y' -> case (x', y') of
|
|||
Nothing ->
|
||||
throwError $ "unsafeGetAttrPos: field '" ++ Text.unpack key
|
||||
++ "' does not exist in attr set: " ++ show apos
|
||||
Just delta -> return $ posFromDelta @m delta
|
||||
Just delta -> return $ posFromSourcePos @m delta
|
||||
(x, y) -> throwError $ "Invalid types for builtin.unsafeGetAttrPos: "
|
||||
++ show (void x, void y)
|
||||
|
||||
|
|
|
|||
|
|
@ -208,7 +208,7 @@ evalBinds :: forall e v t m. MonadNixEval e v t m
|
|||
=> Bool
|
||||
-> Bool
|
||||
-> [Binding (m v)]
|
||||
-> m (AttrSet t, AttrSet Delta)
|
||||
-> m (AttrSet t, AttrSet SourcePos)
|
||||
evalBinds allowDynamic recursive =
|
||||
buildResult . concat <=< mapM go . moveOverridesLast
|
||||
where
|
||||
|
|
@ -216,7 +216,7 @@ evalBinds allowDynamic recursive =
|
|||
partition (\case NamedVar [StaticKey "__overrides" _] _ -> True
|
||||
_ -> False)
|
||||
|
||||
go :: Binding (m v) -> m [([Text], Maybe Delta, m v)]
|
||||
go :: Binding (m v) -> m [([Text], Maybe SourcePos, m v)]
|
||||
go (NamedVar [StaticKey "__overrides" _] finalValue) =
|
||||
finalValue >>= \v -> case wantVal v of
|
||||
Just (o', p') ->
|
||||
|
|
@ -226,7 +226,7 @@ evalBinds allowDynamic recursive =
|
|||
++ show v
|
||||
|
||||
go (NamedVar pathExpr finalValue) = do
|
||||
let go :: NAttrPath (m v) -> m ([Text], Maybe Delta, m v)
|
||||
let go :: NAttrPath (m v) -> m ([Text], Maybe SourcePos, m v)
|
||||
go = \case
|
||||
[] -> pure ([], Nothing, finalValue)
|
||||
h : t -> evalSetterKeyName allowDynamic h >>= \case
|
||||
|
|
@ -257,8 +257,8 @@ evalBinds allowDynamic recursive =
|
|||
++ show (void name)
|
||||
Just v -> force v pure)
|
||||
|
||||
buildResult :: [([Text], Maybe Delta, m v)]
|
||||
-> m (AttrSet t, AttrSet Delta)
|
||||
buildResult :: [([Text], Maybe SourcePos, m v)]
|
||||
-> m (AttrSet t, AttrSet SourcePos)
|
||||
buildResult bindings = do
|
||||
s <- foldM insert M.empty bindings
|
||||
scope <- currentScopes @_ @t
|
||||
|
|
@ -285,7 +285,7 @@ evalSelect aset attr =
|
|||
where
|
||||
extract v [] = return $ Right v
|
||||
extract x (k:ks) =
|
||||
case wantVal @_ @(AttrSet t, AttrSet Delta) x of
|
||||
case wantVal @_ @(AttrSet t, AttrSet SourcePos) x of
|
||||
Just (s, p) -> case M.lookup k s of
|
||||
Just v -> force v $ extract ?? ks
|
||||
Nothing -> return $ Left (ofVal (s, p), k:ks)
|
||||
|
|
@ -299,20 +299,20 @@ evalSelector allowDynamic =
|
|||
-- | Evaluate a component of an attribute path in a context where we are
|
||||
-- *retrieving* a value
|
||||
evalGetterKeyName :: MonadEval v m
|
||||
=> Bool -> NKeyName (m v) -> m (Text, Maybe Delta)
|
||||
=> Bool -> NKeyName (m v) -> m (Text, Maybe SourcePos)
|
||||
evalGetterKeyName canBeDynamic
|
||||
| canBeDynamic = evalKeyNameDynamicNotNull
|
||||
| otherwise = evalKeyNameStatic
|
||||
|
||||
evalKeyNameStatic :: forall v m. MonadEval v m
|
||||
=> NKeyName (m v) -> m (Text, Maybe Delta)
|
||||
=> NKeyName (m v) -> m (Text, Maybe SourcePos)
|
||||
evalKeyNameStatic = \case
|
||||
StaticKey k p -> pure (k, p)
|
||||
DynamicKey _ ->
|
||||
evalError @v "dynamic attribute not allowed in this context"
|
||||
|
||||
evalKeyNameDynamicNotNull :: forall v m. MonadEval v m
|
||||
=> NKeyName (m v) -> m (Text, Maybe Delta)
|
||||
=> NKeyName (m v) -> m (Text, Maybe SourcePos)
|
||||
evalKeyNameDynamicNotNull = evalKeyNameDynamicNullable >=> \case
|
||||
(Nothing, _) ->
|
||||
evalError @v "value is null while a string was expected"
|
||||
|
|
@ -321,14 +321,15 @@ evalKeyNameDynamicNotNull = evalKeyNameDynamicNullable >=> \case
|
|||
-- | Evaluate a component of an attribute path in a context where we are
|
||||
-- *binding* a value
|
||||
evalSetterKeyName :: MonadEval v m
|
||||
=> Bool -> NKeyName (m v) -> m (Maybe Text, Maybe Delta)
|
||||
=> Bool -> NKeyName (m v) -> m (Maybe Text, Maybe SourcePos)
|
||||
evalSetterKeyName canBeDynamic
|
||||
| canBeDynamic = evalKeyNameDynamicNullable
|
||||
| otherwise = fmap (first Just) . evalKeyNameStatic
|
||||
|
||||
-- | Returns Nothing iff the key value is null
|
||||
evalKeyNameDynamicNullable :: forall v m. MonadEval v m
|
||||
=> NKeyName (m v) -> m (Maybe Text, Maybe Delta)
|
||||
=> NKeyName (m v)
|
||||
-> m (Maybe Text, Maybe SourcePos)
|
||||
evalKeyNameDynamicNullable = \case
|
||||
StaticKey k p -> pure (Just k, p)
|
||||
DynamicKey k -> runAntiquoted (embedMText <=< assembleString) id k
|
||||
|
|
|
|||
|
|
@ -90,7 +90,7 @@ instance ConvertValue (NValue m) [NThunk m] where
|
|||
wantVal = \case NVList l -> Just l; _ -> Nothing
|
||||
|
||||
instance ConvertValue (NValue m)
|
||||
(AttrSet (NThunk m), AttrSet Delta) where
|
||||
(AttrSet (NThunk m), AttrSet SourcePos) where
|
||||
ofVal (s, p) = NVSet s p
|
||||
wantVal = \case NVSet s p -> Just (s, p); _ -> Nothing
|
||||
|
||||
|
|
@ -111,7 +111,7 @@ instance MonadExec e m => MonadEval (NValue m) m where
|
|||
Compose (Ann (SrcSpan delta _) _):_ <-
|
||||
asks (mapMaybe (either (const Nothing) Just)
|
||||
. view @_ @Frames hasLens)
|
||||
return $ posFromDelta delta
|
||||
return $ posFromSourcePos delta
|
||||
|
||||
evalConstant = pure . NVConstant
|
||||
evalString = pure . uncurry NVStr
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ import Data.Monoid
|
|||
import Data.Text (Text)
|
||||
import Nix.Atoms
|
||||
import Nix.Expr.Types
|
||||
import Nix.Utils
|
||||
-- import Nix.Utils
|
||||
|
||||
-- | Make an integer literal expression.
|
||||
mkInt :: Integer -> NExpr
|
||||
|
|
@ -102,9 +102,6 @@ mkOper2 op a = Fix . NBinary op a
|
|||
mkParamset :: [(Text, Maybe NExpr)] -> Bool -> Params NExpr
|
||||
mkParamset params variadic = ParamSet (M.fromList params) variadic Nothing
|
||||
|
||||
mkApp :: NExpr -> NExpr -> NExpr
|
||||
mkApp e = Fix . NApp e
|
||||
|
||||
mkRecSet :: [Binding NExpr] -> NExpr
|
||||
mkRecSet = Fix . NRecSet
|
||||
|
||||
|
|
@ -129,6 +126,7 @@ mkIf e1 e2 = Fix . NIf e1 e2
|
|||
mkFunction :: Params NExpr -> NExpr -> NExpr
|
||||
mkFunction params = Fix . NAbs params
|
||||
|
||||
{-
|
||||
mkDot :: NExpr -> Text -> NExpr
|
||||
mkDot e key = mkDots e [key]
|
||||
|
||||
|
|
@ -140,6 +138,7 @@ mkDots (Fix (NSelect e keys' x)) keys =
|
|||
-- a dotted expression, just extend it.
|
||||
Fix (NSelect e (keys' <> map (StaticKey ?? Nothing) keys) x)
|
||||
mkDots e keys = Fix $ NSelect e (map (StaticKey ?? Nothing) keys) Nothing
|
||||
-}
|
||||
|
||||
-- | An `inherit` clause without an expression to pull from.
|
||||
inherit :: [NKeyName e] -> Binding e
|
||||
|
|
@ -195,10 +194,10 @@ recAttrsE pairs = Fix $ NRecSet (map (uncurry bindTo) pairs)
|
|||
mkNot :: NExpr -> NExpr
|
||||
mkNot = Fix . NUnary NNot
|
||||
|
||||
-- | Dot-reference into an attribute set.
|
||||
(!.) :: NExpr -> Text -> NExpr
|
||||
(!.) = mkDot
|
||||
infixl 8 !.
|
||||
-- -- | Dot-reference into an attribute set.
|
||||
-- (!.) :: NExpr -> Text -> NExpr
|
||||
-- (!.) = mkDot
|
||||
-- infixl 8 !.
|
||||
|
||||
mkBinop :: NBinaryOp -> NExpr -> NExpr -> NExpr
|
||||
mkBinop op e1 e2 = Fix (NBinary op e1 e2)
|
||||
|
|
@ -225,7 +224,7 @@ e1 $++ e2 = mkBinop NConcat e1 e2
|
|||
|
||||
-- | Function application expression.
|
||||
(@@) :: NExpr -> NExpr -> NExpr
|
||||
(@@) = mkApp
|
||||
f @@ arg = mkBinop NApp f arg
|
||||
infixl 1 @@
|
||||
|
||||
-- | Lambda shorthand.
|
||||
|
|
@ -233,3 +232,7 @@ infixl 1 @@
|
|||
(==>) = mkFunction
|
||||
|
||||
infixr 1 ==>
|
||||
|
||||
(@.) :: NExpr -> Text -> NExpr
|
||||
obj @. name = mkBinop NSelect obj (mkSym name)
|
||||
infixl 2 @.
|
||||
|
|
|
|||
|
|
@ -28,15 +28,15 @@ import Data.Data
|
|||
import Data.Eq.Deriving
|
||||
import Data.Fix
|
||||
import Data.Functor.Classes
|
||||
import qualified Data.HashMap.Strict.InsOrd as InsOrd
|
||||
import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
|
||||
import qualified Data.HashMap.Strict.InsOrd as InsOrd
|
||||
import Data.Text (Text, pack, unpack)
|
||||
import Data.Traversable
|
||||
import GHC.Exts
|
||||
import GHC.Generics
|
||||
import Language.Haskell.TH.Syntax
|
||||
import Nix.Atoms
|
||||
import Nix.Parser.Library (Delta(..))
|
||||
import Nix.Parser.Library (SourcePos(..))
|
||||
import Nix.Utils
|
||||
import Text.Show.Deriving
|
||||
import Type.Reflection (eqTypeRep)
|
||||
|
|
@ -73,15 +73,8 @@ data NExprF r
|
|||
-- ^ Application of a unary operator to an expression.
|
||||
| NBinary NBinaryOp r r
|
||||
-- ^ Application of a binary operator to two expressions.
|
||||
| NSelect r (NAttrPath r) (Maybe r)
|
||||
-- ^ Dot-reference into an attribute set, optionally providing an
|
||||
-- alternative if the key doesn't exist.
|
||||
| NHasAttr r (NAttrPath r)
|
||||
-- ^ Ask if a set contains a given attribute path.
|
||||
| NAbs (Params r) r
|
||||
-- ^ A function literal (lambda abstraction).
|
||||
| NApp r r
|
||||
-- ^ Apply a function to an argument.
|
||||
| NLet [Binding r] r
|
||||
-- ^ Evaluate the second argument after introducing the bindings.
|
||||
| NIf r r r
|
||||
|
|
@ -170,7 +163,7 @@ instance IsString (NString r) where
|
|||
fromString "" = DoubleQuoted []
|
||||
fromString string = DoubleQuoted [Plain $ pack string]
|
||||
|
||||
-- | A 'KeyName' is something that can appear at the right side of an
|
||||
-- | A 'KeyName' is something that can appear on the left side of an
|
||||
-- equals sign. For example, @a@ is a 'KeyName' in @{ a = 3; }@, @let a = 3;
|
||||
-- in ...@, @{}.a@ or @{} ? a@.
|
||||
--
|
||||
|
|
@ -191,7 +184,7 @@ instance IsString (NString r) where
|
|||
-- parser still considers it a 'DynamicKey' for simplicity.
|
||||
data NKeyName r
|
||||
= DynamicKey (Antiquoted (NString r) r)
|
||||
| StaticKey VarName (Maybe Delta)
|
||||
| StaticKey VarName (Maybe SourcePos)
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
|
||||
|
||||
instance Generic1 NKeyName where
|
||||
|
|
@ -202,7 +195,6 @@ instance NFData1 NKeyName where
|
|||
liftRnf _ (StaticKey !_ !_) = ()
|
||||
liftRnf _ (DynamicKey (Plain !_)) = ()
|
||||
liftRnf k (DynamicKey (Antiquoted r)) = k r
|
||||
instance NFData Delta
|
||||
|
||||
-- | Most key names are just static text, so this instance is convenient.
|
||||
instance IsString (NKeyName r) where
|
||||
|
|
@ -248,21 +240,25 @@ data NUnaryOp = NNeg | NNot
|
|||
|
||||
-- | Binary operators expressible in the nix language.
|
||||
data NBinaryOp
|
||||
= NEq -- ^ Equality (==)
|
||||
| NNEq -- ^ Inequality (!=)
|
||||
| NLt -- ^ Less than (<)
|
||||
| NLte -- ^ Less than or equal (<=)
|
||||
| NGt -- ^ Greater than (>)
|
||||
| NGte -- ^ Greater than or equal (>=)
|
||||
| NAnd -- ^ Logical and (&&)
|
||||
| NOr -- ^ Logical or (||)
|
||||
| NImpl -- ^ Logical implication (->)
|
||||
| NUpdate -- ^ Joining two attribut sets (//)
|
||||
| NPlus -- ^ Addition (+)
|
||||
| NMinus -- ^ Subtraction (-)
|
||||
| NMult -- ^ Multiplication (*)
|
||||
| NDiv -- ^ Division (/)
|
||||
| NConcat -- ^ List concatenation (++)
|
||||
= NEq -- ^ Equality (==)
|
||||
| NNEq -- ^ Inequality (!=)
|
||||
| NLt -- ^ Less than (<)
|
||||
| NLte -- ^ Less than or equal (<=)
|
||||
| NGt -- ^ Greater than (>)
|
||||
| NGte -- ^ Greater than or equal (>=)
|
||||
| NAnd -- ^ Logical and (&&)
|
||||
| NOr -- ^ Logical or (||)
|
||||
| NImpl -- ^ Logical implication (->)
|
||||
| NUpdate -- ^ Joining two attribut sets (//)
|
||||
| NPlus -- ^ Addition (+)
|
||||
| NMinus -- ^ Subtraction (-)
|
||||
| NMult -- ^ Multiplication (*)
|
||||
| NDiv -- ^ Division (/)
|
||||
| NConcat -- ^ List concatenation (++)
|
||||
| NApp -- ^ Apply a function to an argument.
|
||||
| NSelect -- ^ Dot-reference into an attribute set, optionally providing an
|
||||
-- alternative if the key doesn't exist.
|
||||
| NHasAttr -- ^ Ask if a set contains a given attribute path.
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
|
||||
|
||||
-- | Get the name out of the parameter (there might be none).
|
||||
|
|
@ -290,7 +286,6 @@ stripPositionInfo = transport phi
|
|||
phi (NSet binds) = NSet (map go binds)
|
||||
phi (NRecSet binds) = NRecSet (map go binds)
|
||||
phi (NLet binds body) = NLet (map go binds) body
|
||||
phi (NSelect s attr alt) = NSelect s (map clear attr) alt
|
||||
phi x = x
|
||||
|
||||
go (NamedVar path r) = NamedVar (map clear path) r
|
||||
|
|
@ -311,5 +306,5 @@ type Convertible v t =
|
|||
ConvertValue v Text,
|
||||
ConvertValue v (Maybe Text), -- text or null
|
||||
ConvertValue v [t],
|
||||
ConvertValue v (AttrSet t, AttrSet Delta),
|
||||
ConvertValue v (AttrSet t, AttrSet SourcePos),
|
||||
ConvertValue v (AttrSet t))
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@
|
|||
--
|
||||
module Nix.Expr.Types.Annotated
|
||||
( module Nix.Expr.Types.Annotated
|
||||
, Delta(..)
|
||||
, SourcePos(..)
|
||||
)where
|
||||
|
||||
import Control.DeepSeq
|
||||
|
|
@ -28,12 +28,13 @@ import Data.Semigroup
|
|||
import Data.Text (Text, pack)
|
||||
import GHC.Generics
|
||||
import Nix.Expr.Types
|
||||
import Nix.Parser.Library (Delta(..))
|
||||
import Nix.Parser.Library (SourcePos(..))
|
||||
import Text.Show.Deriving
|
||||
import Text.Megaparsec (unPos)
|
||||
|
||||
-- | A location in a source file
|
||||
data SrcSpan = SrcSpan{ spanBegin :: Delta
|
||||
, spanEnd :: Delta
|
||||
data SrcSpan = SrcSpan{ spanBegin :: SourcePos
|
||||
, spanEnd :: SourcePos
|
||||
}
|
||||
deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData)
|
||||
|
||||
|
|
@ -72,10 +73,6 @@ pattern AnnE ann a = Fix (Compose (Ann ann a))
|
|||
stripAnnotation :: Functor f => Fix (AnnF ann f) -> Fix f
|
||||
stripAnnotation = ana (annotated . getCompose . unFix)
|
||||
|
||||
nApp :: NExprLoc -> NExprLoc -> NExprLoc
|
||||
nApp e1@(AnnE s1 _) e2@(AnnE s2 _) = AnnE (s1 <> s2) (NApp e1 e2)
|
||||
nApp _ _ = error "nApp: unexpected"
|
||||
|
||||
nUnary :: Ann SrcSpan NUnaryOp -> NExprLoc -> NExprLoc
|
||||
nUnary (Ann s1 u) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NUnary u e1)
|
||||
nUnary _ _ = error "nUnary: unexpected"
|
||||
|
|
@ -85,18 +82,6 @@ nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =
|
|||
AnnE (s1 <> s2 <> s3) (NBinary b e1 e2)
|
||||
nBinary _ _ _ = error "nBinary: unexpected"
|
||||
|
||||
nSelectLoc :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc
|
||||
-> NExprLoc
|
||||
nSelectLoc e1@(AnnE s1 _) (Ann s2 ats) d = case d of
|
||||
Nothing -> AnnE (s1 <> s2) (NSelect e1 ats Nothing)
|
||||
Just (e2@(AnnE s3 _)) -> AnnE (s1 <> s2 <> s3) (NSelect e1 ats (Just e2))
|
||||
_ -> error "nSelectLoc: unexpected"
|
||||
nSelectLoc _ _ _ = error "nSelectLoc: unexpected"
|
||||
|
||||
nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc
|
||||
nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) (NHasAttr e1 ats)
|
||||
nHasAttr _ _ = error "nHasAttr: unexpected"
|
||||
|
||||
nAbs :: Ann SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc
|
||||
nAbs (Ann s1 ps) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NAbs ps e1)
|
||||
nAbs _ _ = error "nAbs: unexpected"
|
||||
|
|
@ -104,9 +89,5 @@ nAbs _ _ = error "nAbs: unexpected"
|
|||
nStr :: Ann SrcSpan (NString NExprLoc) -> NExprLoc
|
||||
nStr (Ann s1 s) = AnnE s1 (NStr s)
|
||||
|
||||
deltaInfo :: Delta -> (Text, Int, Int)
|
||||
deltaInfo = \case
|
||||
Columns c _ -> ("<string>", 1, fromIntegral c + 1)
|
||||
Tab {} -> ("<string>", 1, 1)
|
||||
Lines l _ _ _ -> ("<string>", fromIntegral l + 1, 1)
|
||||
Directed fn l c _ _ -> (pack fn, fromIntegral l + 1, fromIntegral c + 1)
|
||||
deltaInfo :: SourcePos -> (Text, Int, Int)
|
||||
deltaInfo (SourcePos fp l c) = (pack fp, unPos l, unPos c)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
||||
|
|
@ -6,8 +5,6 @@
|
|||
module Nix.Parser (
|
||||
parseNixFile,
|
||||
parseNixFileLoc,
|
||||
parseNixString,
|
||||
parseNixStringLoc,
|
||||
parseNixText,
|
||||
parseNixTextLoc,
|
||||
Result(..)
|
||||
|
|
@ -16,27 +13,15 @@ module Nix.Parser (
|
|||
import Control.Applicative hiding (many, some)
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Foldable hiding (concat)
|
||||
import Data.Functor
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.HashMap.Strict.InsOrd as M
|
||||
import Data.Text hiding (map, foldl', concat)
|
||||
import Data.Text hiding (map, concat)
|
||||
import Nix.Expr hiding (($>))
|
||||
import Nix.Parser.Library
|
||||
import Nix.Parser.Operators
|
||||
import Nix.StringOperations
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
annotateLocation :: Parser a -> Parser (Ann SrcSpan a)
|
||||
annotateLocation p = do
|
||||
begin <- position
|
||||
res <- p
|
||||
end <- position
|
||||
let span = SrcSpan begin end
|
||||
pure $ Ann span res
|
||||
|
||||
annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc
|
||||
annotateLocation1 = fmap annToAnnF . annotateLocation
|
||||
import Text.Megaparsec.Expr
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -45,28 +30,10 @@ nixExpr = stripAnnotation <$> nixExprLoc
|
|||
|
||||
-- | The lexer for this parser is defined in 'Nix.Parser.Library'.
|
||||
nixExprLoc :: Parser NExprLoc
|
||||
nixExprLoc =
|
||||
whiteSpace *> (nixToplevelForm <|> foldl' makeParser nixTerm nixOperators)
|
||||
where
|
||||
makeParser :: Parser NExprLoc -> Either NSpecialOp NOperatorDef
|
||||
-> Parser NExprLoc
|
||||
makeParser term (Left NSelectOp) = nixSelect term
|
||||
makeParser term (Left NAppOp) = chainl1 term (pure nApp)
|
||||
makeParser term (Left NHasAttrOp) = nixHasAttr term
|
||||
makeParser term (Right (NUnaryDef name op)) =
|
||||
build <$> many (annotateLocation (void $ symbol name)) <*> term
|
||||
where
|
||||
build :: [Ann SrcSpan ()] -> NExprLoc -> NExprLoc
|
||||
build = flip $ foldl' (\t' (Ann s ()) -> nUnary (Ann s op) t')
|
||||
nixExprLoc = whiteSpace *> (nixToplevelForm <|> exprParser)
|
||||
|
||||
makeParser term (Right (NBinaryDef assoc ops)) = case assoc of
|
||||
NAssocLeft -> chainl1 term op
|
||||
NAssocRight -> chainr1 term op
|
||||
NAssocNone -> term <**> (flip <$> op <*> term <|> pure id)
|
||||
where
|
||||
op :: Parser (NExprLoc -> NExprLoc -> NExprLoc)
|
||||
op = choice . map (\(n,o) -> (\(Ann a ()) -> nBinary (Ann a o))
|
||||
<$> annotateLocation (reservedOp n)) $ ops
|
||||
exprParser :: Parser NExprLoc
|
||||
exprParser = makeExprParser nixTerm (map (map (\(_,_,x) -> x)) nixOperators)
|
||||
|
||||
antiStart :: Parser Text
|
||||
antiStart = try (symbol "${") <?> show ("${" :: String)
|
||||
|
|
@ -81,24 +48,9 @@ selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whit
|
|||
nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
|
||||
nixSelector = annotateLocation $ keyName `sepBy1` selDot
|
||||
|
||||
nixSelect :: Parser NExprLoc -> Parser NExprLoc
|
||||
nixSelect term = build
|
||||
<$> term
|
||||
<*> optional ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixTerm))
|
||||
where
|
||||
build :: NExprLoc -> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc) -> NExprLoc
|
||||
build t Nothing = t
|
||||
build t (Just (s,o)) = nSelectLoc t s o
|
||||
|
||||
nixHasAttr :: Parser NExprLoc -> Parser NExprLoc
|
||||
nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) where
|
||||
build :: NExprLoc -> Maybe (Ann SrcSpan (NAttrPath NExprLoc)) -> NExprLoc
|
||||
build t Nothing = t
|
||||
build t (Just s) = nHasAttr t s
|
||||
|
||||
-- | A self-contained unit.
|
||||
nixTerm :: Parser NExprLoc
|
||||
nixTerm = nixSelect $ choice
|
||||
nixTerm = choice
|
||||
[ nixPath, nixSPath, nixFloat, nixInt, nixBool, nixNull, nixParens, nixList, nixUri
|
||||
, nixStringExpr, nixSet, nixSym ]
|
||||
|
||||
|
|
@ -109,24 +61,24 @@ nixSym :: Parser NExprLoc
|
|||
nixSym = annotateLocation1 $ mkSymF <$> identifier
|
||||
|
||||
nixInt :: Parser NExprLoc
|
||||
nixInt = annotateLocation1 $ (mkIntF <$> integer <?> "integer")
|
||||
nixInt = annotateLocation1 (mkIntF <$> integer <?> "integer")
|
||||
|
||||
nixFloat :: Parser NExprLoc
|
||||
nixFloat = annotateLocation1 $ (try (mkFloatF . realToFrac <$> float) <?> "float")
|
||||
nixFloat = annotateLocation1 (try (mkFloatF . realToFrac <$> float) <?> "float")
|
||||
|
||||
nixBool :: Parser NExprLoc
|
||||
nixBool = annotateLocation1 $ (try (true <|> false) <?> "bool") where
|
||||
nixBool = annotateLocation1 (try (true <|> false) <?> "bool") where
|
||||
true = mkBoolF True <$ reserved "true"
|
||||
false = mkBoolF False <$ reserved "false"
|
||||
|
||||
nixNull :: Parser NExprLoc
|
||||
nixNull = annotateLocation1 $ (mkNullF <$ try (reserved "null") <?> "null")
|
||||
nixNull = annotateLocation1 (mkNullF <$ try (reserved "null") <?> "null")
|
||||
|
||||
nixParens :: Parser NExprLoc
|
||||
nixParens = parens nixExprLoc <?> "parens"
|
||||
|
||||
nixList :: Parser NExprLoc
|
||||
nixList = annotateLocation1 $ (brackets (NList <$> many nixTerm) <?> "list")
|
||||
nixList = annotateLocation1 (brackets (NList <$> many nixTerm) <?> "list")
|
||||
|
||||
pathChars :: String
|
||||
pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']
|
||||
|
|
@ -134,26 +86,28 @@ pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']
|
|||
slash :: Parser Char
|
||||
slash = try (char '/' <* notFollowedBy (void (char '/') <|>
|
||||
void (char '*') <|>
|
||||
someSpace))
|
||||
whiteSpace))
|
||||
<?> "slash"
|
||||
|
||||
-- | 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 $ (mkPathF True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* symbol ">")
|
||||
nixSPath = annotateLocation1 (mkPathF True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* symbol ">")
|
||||
<?> "spath")
|
||||
|
||||
nixPath :: Parser NExprLoc
|
||||
nixPath = annotateLocation1 (token (fmap (mkPathF False) (((++)
|
||||
nixPath = annotateLocation1 (parseToken (fmap (mkPathF False) (((++)
|
||||
<$> (try ((++) <$> many (oneOf pathChars) <*> fmap (:[]) slash) <?> "path")
|
||||
<*> fmap concat
|
||||
( some (some (oneOf pathChars)
|
||||
<|> liftA2 (:) slash (some (oneOf pathChars)))
|
||||
))
|
||||
<?> "path")))
|
||||
where
|
||||
parseToken p = p <* whiteSpace
|
||||
|
||||
nixLet :: Parser NExprLoc
|
||||
nixLet = annotateLocation1 $ (reserved "let"
|
||||
nixLet = annotateLocation1 (reserved "let"
|
||||
*> whiteSpace
|
||||
*> (letBody <|> letBinders)
|
||||
<?> "let block")
|
||||
|
|
@ -163,26 +117,26 @@ nixLet = annotateLocation1 $ (reserved "let"
|
|||
<*> (whiteSpace *> reserved "in" *> nixExprLoc)
|
||||
-- Let expressions `let {..., body = ...}' are just desugared
|
||||
-- into `(rec {..., body = ...}).body'.
|
||||
letBody = (\x pos -> NSelect x [StaticKey "body" (Just pos)] Nothing)
|
||||
<$> aset <*> position
|
||||
letBody = liftM2 (NBinary NSelect) aset
|
||||
(annotateLocation1 (pure (mkSymF "body")))
|
||||
aset = annotateLocation1 $ NRecSet <$> braces nixBinders
|
||||
|
||||
|
||||
nixIf :: Parser NExprLoc
|
||||
nixIf = annotateLocation1 $ (NIf
|
||||
nixIf = annotateLocation1 (NIf
|
||||
<$> (reserved "if" *> nixExprLoc)
|
||||
<*> (whiteSpace *> reserved "then" *> nixExprLoc)
|
||||
<*> (whiteSpace *> reserved "else" *> nixExprLoc)
|
||||
<?> "if")
|
||||
|
||||
nixAssert :: Parser NExprLoc
|
||||
nixAssert = annotateLocation1 $ (NAssert
|
||||
nixAssert = annotateLocation1 (NAssert
|
||||
<$> (reserved "assert" *> nixExprLoc)
|
||||
<*> (semi *> nixExprLoc)
|
||||
<?> "assert")
|
||||
|
||||
nixWith :: Parser NExprLoc
|
||||
nixWith = annotateLocation1 $ (NWith
|
||||
nixWith = annotateLocation1 (NWith
|
||||
<$> (reserved "with" *> nixExprLoc)
|
||||
<*> (semi *> nixExprLoc)
|
||||
<?> "with")
|
||||
|
|
@ -194,14 +148,17 @@ nixStringExpr :: Parser NExprLoc
|
|||
nixStringExpr = nStr <$> annotateLocation nixString
|
||||
|
||||
uriAfterColonC :: Parser Char
|
||||
uriAfterColonC = alphaNumChar <|> oneOf "%/?:@&=+$,-_.!~*'"
|
||||
uriAfterColonC = alphaNumChar <|>
|
||||
satisfy (\x -> x `elem` ("%/?:@&=+$,-_.!~*'" :: String))
|
||||
|
||||
nixUri :: Parser NExprLoc
|
||||
nixUri = annotateLocation1 $ token $ fmap (mkUriF . pack) $ (++)
|
||||
nixUri = annotateLocation1 $ parseToken $ fmap (mkUriF . pack) $ (++)
|
||||
<$> try ((++) <$> (scheme <* char ':') <*> fmap (\x -> [':',x]) uriAfterColonC)
|
||||
<*> many uriAfterColonC
|
||||
where
|
||||
scheme = (:) <$> letterChar <*> many (alphaNumChar <|> oneOf "+-.")
|
||||
scheme = (:) <$> letterChar
|
||||
<*> many (alphaNumChar <|> satisfy (\x -> x `elem` ("+-." :: String)))
|
||||
parseToken p = p <* whiteSpace
|
||||
|
||||
nixString :: Parser (NString NExprLoc)
|
||||
nixString = doubleQuoted <|> indented <?> "string"
|
||||
|
|
@ -212,7 +169,7 @@ nixString = doubleQuoted <|> indented <?> "string"
|
|||
<* doubleQ)
|
||||
<?> "double quoted string"
|
||||
|
||||
doubleQ = char '"'
|
||||
doubleQ = void $ char '"'
|
||||
doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode)
|
||||
|
||||
indented :: Parser (NString NExprLoc)
|
||||
|
|
@ -221,17 +178,19 @@ nixString = doubleQuoted <|> indented <?> "string"
|
|||
<* indentedQ)
|
||||
<?> "indented string"
|
||||
|
||||
indentedQ = try (string "''") <?> "\"''\""
|
||||
indentedQ = void (try (string "''") <?> "\"''\"")
|
||||
indentedEscape = fmap Plain
|
||||
$ try (indentedQ *> char '\\') *> fmap singleton escapeCode
|
||||
<|> try (indentedQ *> ("''" <$ char '\'' <|> "$" <$ char '$'))
|
||||
|
||||
stringChar end escStart esc
|
||||
= esc
|
||||
<|> Antiquoted <$> (antiStart *> nixExprLoc <* char '}') -- don't skip trailing space
|
||||
<|> Plain . singleton <$> char '$'
|
||||
<|> Plain . pack <$> some plainChar
|
||||
where plainChar = notFollowedBy (end <|> void (char '$') <|> escStart) *> anyChar
|
||||
stringChar end escStart esc = esc
|
||||
<|> Antiquoted <$> (antiStart *> nixExprLoc <* char '}')
|
||||
-- ^ don't skip trailing space
|
||||
<|> Plain . singleton <$> char '$'
|
||||
<|> Plain . pack <$> some plainChar
|
||||
where
|
||||
plainChar =
|
||||
notFollowedBy (end <|> void (char '$') <|> escStart) *> anyChar
|
||||
|
||||
escapeCode = choice [ c <$ char e | (c,e) <- escapeCodes ] <|> anyChar
|
||||
|
||||
|
|
@ -242,7 +201,7 @@ argExpr = choice [atLeft, onlyname, atRight] <* symbol ":" where
|
|||
-- 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.
|
||||
onlyname = choice [nixUri >> unexpected "valid uri",
|
||||
onlyname = choice [nixUri >> unexpected (Label ('v' NE.:| "alid uri")),
|
||||
Param <$> identifier]
|
||||
|
||||
-- Parameters named by an identifier on the left (`args @ {x, y}`)
|
||||
|
|
@ -292,12 +251,12 @@ nixBinders = (inherit <|> namedVar) `endBy` semi where
|
|||
keyName :: Parser (NKeyName NExprLoc)
|
||||
keyName = dynamicKey <|> staticKey where
|
||||
staticKey = do
|
||||
beg <- position
|
||||
beg <- getPosition
|
||||
StaticKey <$> identifier <*> pure (Just beg)
|
||||
dynamicKey = DynamicKey <$> nixAntiquoted nixString
|
||||
|
||||
nixSet :: Parser NExprLoc
|
||||
nixSet = annotateLocation1 $ ((isRec <*> braces nixBinders) <?> "set") where
|
||||
nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set") where
|
||||
isRec = (try (reserved "rec" $> NRecSet) <?> "recursive set")
|
||||
<|> pure NSet
|
||||
|
||||
|
|
@ -307,14 +266,8 @@ parseNixFile = parseFromFileEx $ nixExpr <* eof
|
|||
parseNixFileLoc :: MonadIO m => FilePath -> m (Result NExprLoc)
|
||||
parseNixFileLoc = parseFromFileEx $ nixExprLoc <* eof
|
||||
|
||||
parseNixString :: String -> Result NExpr
|
||||
parseNixString = parseFromString $ nixExpr <* eof
|
||||
|
||||
parseNixStringLoc :: String -> Result NExprLoc
|
||||
parseNixStringLoc = parseFromString $ nixExprLoc <* eof
|
||||
|
||||
parseNixText :: Text -> Result NExpr
|
||||
parseNixText = parseNixString . unpack
|
||||
parseNixText = parseFromText $ nixExpr <* eof
|
||||
|
||||
parseNixTextLoc :: Text -> Result NExprLoc
|
||||
parseNixTextLoc = parseNixStringLoc . unpack
|
||||
parseNixTextLoc = parseFromText $ nixExprLoc <* eof
|
||||
|
|
|
|||
|
|
@ -1,28 +1,19 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
||||
|
||||
module Nix.Parser.Library
|
||||
( module Nix.Parser.Library
|
||||
, module X
|
||||
) where
|
||||
|
||||
import Control.Applicative hiding (many, some)
|
||||
import Control.Applicative hiding (many)
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Data
|
||||
import Data.Functor
|
||||
import Data.Functor.Identity
|
||||
import qualified Data.HashSet as HashSet
|
||||
import Data.Int (Int64)
|
||||
import Data.List (nub)
|
||||
import Data.Text
|
||||
import qualified Data.Text.IO as T
|
||||
import GHC.Generics
|
||||
import Text.Megaparsec as X
|
||||
import Text.Megaparsec.Char as X
|
||||
import qualified Text.Megaparsec.Char.Lexer as L
|
||||
|
|
@ -164,18 +155,10 @@ whiteSpace = L.space space1 lineCmnt blockCmnt
|
|||
lineCmnt = L.skipLineComment "//"
|
||||
blockCmnt = L.skipBlockComment "/*" "*/"
|
||||
|
||||
data Delta
|
||||
= Columns !Int64 !Int64
|
||||
| Tab !Int64 !Int64 !Int64
|
||||
| Lines !Int64 !Int64 !Int64 !Int64
|
||||
| Directed !FilePath !Int64 !Int64 !Int64 !Int64
|
||||
deriving (Generic, Data, Eq, Ord, Show, Read)
|
||||
|
||||
type Parser = ParsecT () Text Identity
|
||||
|
||||
parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a)
|
||||
parseFromString :: Parser a -> String -> Result a
|
||||
position :: Parser Delta
|
||||
parseFromText :: Parser a -> Text -> Result a
|
||||
|
||||
data Result a = Success a | Failure Doc deriving Show
|
||||
|
||||
|
|
@ -183,7 +166,5 @@ parseFromFileEx p path =
|
|||
(either (Failure . text . show) Success . parse p path)
|
||||
`liftM` liftIO (T.readFile path)
|
||||
|
||||
parseFromString p =
|
||||
either (Failure . text . show) Success . parse p "<string>" . pack
|
||||
|
||||
position = return $ Columns 0 0
|
||||
parseFromText p =
|
||||
either (Failure . text . show) Success . parse p "<string>"
|
||||
|
|
|
|||
|
|
@ -1,16 +1,21 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
||||
|
||||
module Nix.Parser.Operators where
|
||||
|
||||
import Data.Data (Data(..))
|
||||
import Data.Foldable (concat)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Text (Text)
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics
|
||||
import GHC.Generics hiding (Prefix)
|
||||
import Nix.Expr
|
||||
import Nix.Parser.Library
|
||||
import Text.Megaparsec.Expr
|
||||
|
||||
data NSpecialOp = NHasAttrOp | NSelectOp | NAppOp
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
|
@ -19,64 +24,76 @@ data NAssoc = NAssocNone | NAssocLeft | NAssocRight
|
|||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
data NOperatorDef
|
||||
= NUnaryDef String NUnaryOp
|
||||
| NBinaryDef NAssoc [(String, NBinaryOp)]
|
||||
= NUnaryDef Text NUnaryOp
|
||||
| NBinaryDef NAssoc [(Text, NBinaryOp)]
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
nixOperators :: [Either NSpecialOp NOperatorDef]
|
||||
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
|
||||
|
||||
opWithLoc :: Text -> o -> (Ann SrcSpan o -> a) -> Parser a
|
||||
opWithLoc name op f = do
|
||||
Ann ann _ <- annotateLocation (symbol name)
|
||||
return $ f (Ann ann op)
|
||||
|
||||
binaryN name op = (Right (op, NAssocNone),
|
||||
name, InfixN (opWithLoc name op nBinary))
|
||||
binaryL name op = (Right (op, NAssocLeft),
|
||||
name, InfixL (opWithLoc name op nBinary))
|
||||
binaryR name op = (Right (op, NAssocRight),
|
||||
name, InfixR (opWithLoc name op nBinary))
|
||||
prefix name op = (Left op, name, Prefix (opWithLoc name op nUnary))
|
||||
postfix name op = (Left op, name, Postfix (opWithLoc name op nUnary))
|
||||
|
||||
nixOperators
|
||||
:: [[(Either NUnaryOp (NBinaryOp, NAssoc),
|
||||
Text, Operator Parser NExprLoc)]]
|
||||
nixOperators =
|
||||
[ Left NSelectOp
|
||||
, Left NAppOp
|
||||
, Right $ NUnaryDef "-" NNeg
|
||||
, Left NHasAttrOp
|
||||
] ++ map Right
|
||||
[ NBinaryDef NAssocRight [("++", NConcat)]
|
||||
, NBinaryDef NAssocLeft [("*", NMult), ("/", NDiv)]
|
||||
, NBinaryDef NAssocLeft [("+", NPlus), ("-", NMinus)]
|
||||
, NUnaryDef "!" NNot
|
||||
, NBinaryDef NAssocRight [("//", NUpdate)]
|
||||
, NBinaryDef NAssocLeft [("<", NLt), (">", NGt), ("<=", NLte), (">=", NGte)]
|
||||
, NBinaryDef NAssocNone [("==", NEq), ("!=", NNEq)]
|
||||
, NBinaryDef NAssocLeft [("&&", NAnd)]
|
||||
, NBinaryDef NAssocLeft [("||", NOr)]
|
||||
, NBinaryDef NAssocNone [("->", NImpl)]
|
||||
[ {- 1 -} [ binaryL "." NSelect ]
|
||||
, {- 2 -} [ binaryL " " NApp ]
|
||||
, {- 3 -} [ prefix "-" NNeg ]
|
||||
, {- 4 -} [ binaryL "?" NHasAttr ]
|
||||
, {- 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 :: String
|
||||
, operatorName :: Text
|
||||
} deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
getUnaryOperator :: NUnaryOp -> OperatorInfo
|
||||
getUnaryOperator = (m Map.!) where
|
||||
m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $
|
||||
nixOperators
|
||||
buildEntry i = \case
|
||||
Right (NUnaryDef name op) -> [(op, OperatorInfo i NAssocNone name)]
|
||||
m = Map.fromList $ concat $ zipWith buildEntry [1..] nixOperators
|
||||
buildEntry i = concatMap $ \case
|
||||
(Left op, name, _) -> [(op, OperatorInfo i NAssocNone name)]
|
||||
_ -> []
|
||||
|
||||
getBinaryOperator :: NBinaryOp -> OperatorInfo
|
||||
getBinaryOperator = (m Map.!) where
|
||||
m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $
|
||||
nixOperators
|
||||
buildEntry i = \case
|
||||
Right (NBinaryDef assoc ops) ->
|
||||
[(op, OperatorInfo i assoc name) | (name,op) <- ops]
|
||||
m = Map.fromList $ concat $ zipWith buildEntry [1..] nixOperators
|
||||
buildEntry i = concatMap $ \case
|
||||
(Right (op, assoc), name, _) -> [(op, OperatorInfo i assoc name)]
|
||||
_ -> []
|
||||
|
||||
getSpecialOperatorPrec :: NSpecialOp -> Int
|
||||
getSpecialOperatorPrec = (m Map.!) where
|
||||
m = Map.fromList . catMaybes . zipWith buildEntry [1..] . reverse $
|
||||
nixOperators
|
||||
buildEntry _ (Right _) = Nothing
|
||||
buildEntry i (Left op) = Just (op, i)
|
||||
|
||||
selectOp :: OperatorInfo
|
||||
selectOp = OperatorInfo (getSpecialOperatorPrec NSelectOp) NAssocLeft "."
|
||||
|
||||
hasAttrOp :: OperatorInfo
|
||||
hasAttrOp = OperatorInfo (getSpecialOperatorPrec NHasAttrOp) NAssocLeft "?"
|
||||
|
||||
appOp :: OperatorInfo
|
||||
appOp = OperatorInfo (getSpecialOperatorPrec NAppOp) NAssocLeft " "
|
||||
|
|
|
|||
|
|
@ -29,7 +29,6 @@ import GHC.Generics
|
|||
import Nix.Atoms
|
||||
import Nix.Expr.Types
|
||||
import Nix.Expr.Types.Annotated (deltaInfo)
|
||||
import Nix.Parser.Library (Delta(..))
|
||||
import Nix.Thunk
|
||||
import Nix.Utils
|
||||
|
||||
|
|
@ -42,7 +41,7 @@ data NValueF m r
|
|||
| NVStr Text (DList Text)
|
||||
| NVPath FilePath
|
||||
| NVList [r]
|
||||
| NVSet (AttrSet r) (AttrSet Delta)
|
||||
| NVSet (AttrSet r) (AttrSet SourcePos)
|
||||
| NVClosure (Params ()) (m (NValue m) -> m (NValue m))
|
||||
-- ^ A function is a closed set of parameters representing the "call
|
||||
-- signature", used at application time to check the type of arguments
|
||||
|
|
@ -113,8 +112,9 @@ builtin3 :: Monad m
|
|||
builtin3 name f =
|
||||
builtin name $ \a -> builtin name $ \b -> builtin name $ \c -> f a b c
|
||||
|
||||
posFromDelta :: forall m v t. (MonadThunk v t m, Convertible v t) => Delta -> v
|
||||
posFromDelta (deltaInfo -> (f, l, c)) =
|
||||
posFromSourcePos :: forall m v t. (MonadThunk v t m, Convertible v t)
|
||||
=> SourcePos -> v
|
||||
posFromSourcePos (SourcePos f l c) =
|
||||
ofVal $ M.fromList
|
||||
[ ("file" :: Text, value @_ @_ @m $ ofVal f)
|
||||
, ("line", value @_ @_ @m $ ofVal l)
|
||||
|
|
|
|||
Loading…
Reference in a new issue