620 lines
21 KiB
Haskell
620 lines
21 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DeriveTraversable #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE FunctionalDependencies #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
|
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
|
|
|
-- | The Nix expression type and supporting types.
|
|
--
|
|
-- For a brief introduction of the Nix expression language, see
|
|
-- <https://nixos.org/nix/manual/#ch-expression-language>.
|
|
module Nix.Expr.Types where
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
import Codec.Serialise ( Serialise )
|
|
import qualified Codec.Serialise as Ser
|
|
#endif
|
|
import Control.Applicative
|
|
import Control.DeepSeq
|
|
import Control.Monad
|
|
import Data.Aeson
|
|
import Data.Aeson.TH
|
|
import Data.Binary ( Binary )
|
|
import qualified Data.Binary as Bin
|
|
import Data.Data
|
|
import Data.Eq.Deriving
|
|
import Data.Fix
|
|
import Data.Functor.Classes
|
|
import Data.Hashable
|
|
import Data.Hashable.Lifted
|
|
import Data.List ( inits
|
|
, tails
|
|
)
|
|
import Data.List.NonEmpty ( NonEmpty(..) )
|
|
import qualified Data.List.NonEmpty as NE
|
|
import Data.Maybe ( fromMaybe )
|
|
import Data.Ord.Deriving
|
|
import Data.Text ( Text
|
|
, pack
|
|
, unpack
|
|
)
|
|
import Data.Traversable
|
|
import GHC.Exts
|
|
import GHC.Generics
|
|
import Language.Haskell.TH.Syntax
|
|
import Lens.Family2
|
|
import Lens.Family2.TH
|
|
import Nix.Atoms
|
|
import Nix.Utils
|
|
import Text.Megaparsec.Pos
|
|
import Text.Read.Deriving
|
|
import Text.Show.Deriving
|
|
import Type.Reflection ( eqTypeRep )
|
|
import qualified Type.Reflection as Reflection
|
|
|
|
type VarName = Text
|
|
|
|
hashAt :: VarName -> Lens' (AttrSet v) (Maybe v)
|
|
hashAt = flip alterF
|
|
|
|
-- unfortunate orphans
|
|
instance Hashable1 NonEmpty
|
|
|
|
-- | The main nix expression type. This is polymorphic so that it can be made
|
|
-- a functor, which allows us to traverse expressions and map functions over
|
|
-- them. The actual 'NExpr' type is a fixed point of this functor, defined
|
|
-- below.
|
|
data NExprF r
|
|
= NConstant !NAtom
|
|
-- ^ Constants: ints, floats, bools, URIs, and null.
|
|
| NStr !(NString r)
|
|
-- ^ A string, with interpolated expressions.
|
|
| NSym !VarName
|
|
-- ^ A variable. For example, in the expression @f a@, @f@ is represented
|
|
-- as @NSym "f"@ and @a@ as @NSym "a"@.
|
|
--
|
|
-- > NSym "x" ~ x
|
|
| NList ![r]
|
|
-- ^ A list literal.
|
|
--
|
|
-- > NList [x,y] ~ [ x y ]
|
|
| NSet !NRecordType ![Binding r]
|
|
-- ^ An attribute set literal
|
|
--
|
|
-- > NSet NRecursive [NamedVar x y _] ~ rec { x = y; }
|
|
-- > NSet NNonRecursive [Inherit Nothing [x] _] ~ { inherit x; }
|
|
| NLiteralPath !FilePath
|
|
-- ^ A path expression, which is evaluated to a store path. The path here
|
|
-- can be relative, in which case it's evaluated relative to the file in
|
|
-- which it appears.
|
|
--
|
|
-- > NLiteralPath "/x" ~ /x
|
|
-- > NLiteralPath "x/y" ~ x/y
|
|
| NEnvPath !FilePath
|
|
-- ^ A path which refers to something in the Nix search path (the NIX_PATH
|
|
-- environment variable. For example, @<nixpkgs/pkgs>@.
|
|
--
|
|
-- > NEnvPath "x" ~ <x>
|
|
| NUnary !NUnaryOp !r
|
|
-- ^ Application of a unary operator to an expression.
|
|
--
|
|
-- > NUnary NNeg x ~ - x
|
|
-- > NUnary NNot x ~ ! x
|
|
| NBinary !NBinaryOp !r !r
|
|
-- ^ Application of a binary operator to two expressions.
|
|
--
|
|
-- > NBinary NPlus x y ~ x + y
|
|
-- > NBinary NApp f x ~ f x
|
|
| NSelect !r !(NAttrPath r) !(Maybe r)
|
|
-- ^ Dot-reference into an attribute set, optionally providing an
|
|
-- alternative if the key doesn't exist.
|
|
--
|
|
-- > NSelect s (x :| []) Nothing ~ s.x
|
|
-- > NSelect s (x :| []) (Just y) ~ s.x or y
|
|
| NHasAttr !r !(NAttrPath r)
|
|
-- ^ Ask if a set contains a given attribute path.
|
|
--
|
|
-- > NHasAttr s (x :| []) ~ s ? x
|
|
| NAbs !(Params r) !r
|
|
-- ^ A function literal (lambda abstraction).
|
|
--
|
|
-- > NAbs (Param "x") y ~ x: y
|
|
| NLet ![Binding r] !r
|
|
-- ^ Evaluate the second argument after introducing the bindings.
|
|
--
|
|
-- > NLet [] x ~ let in x
|
|
-- > NLet [NamedVar x y _] z ~ let x = y; in z
|
|
-- > NLet [Inherit Nothing x _] y ~ let inherit x; in y
|
|
| NIf !r !r !r
|
|
-- ^ If-then-else statement.
|
|
--
|
|
-- > NIf x y z ~ if x then y else z
|
|
| NWith !r !r
|
|
-- ^ Evaluate an attribute set, bring its bindings into scope, and
|
|
-- evaluate the second argument.
|
|
--
|
|
-- > NWith x y ~ with x; y
|
|
| NAssert !r !r
|
|
-- ^ Assert that the first returns @true@ before evaluating the second.
|
|
--
|
|
-- > NAssert x y ~ assert x; y
|
|
| NSynHole !VarName
|
|
-- ^ Syntactic hole.
|
|
--
|
|
-- See <https://github.com/haskell-nix/hnix/issues/197> for context.
|
|
--
|
|
-- > NSynHole "x" ~ ^x
|
|
deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor,
|
|
Foldable, Traversable, Show, NFData, Hashable)
|
|
|
|
instance Hashable1 NExprF
|
|
|
|
instance NFData1 NExprF
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise r => Serialise (NExprF r)
|
|
#endif
|
|
|
|
-- | We make an `IsString` for expressions, where the string is interpreted
|
|
-- as an identifier. This is the most common use-case...
|
|
instance IsString NExpr where
|
|
fromString = Fix . NSym . fromString
|
|
|
|
instance Lift (Fix NExprF) where
|
|
lift = dataToExpQ $ \b ->
|
|
case Reflection.typeOf b `eqTypeRep` Reflection.typeRep @Text of
|
|
Just HRefl -> Just [| pack $(liftString $ unpack b) |]
|
|
Nothing -> Nothing
|
|
|
|
-- | The monomorphic expression type is a fixed point of the polymorphic one.
|
|
type NExpr = Fix NExprF
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise NExpr
|
|
#endif
|
|
|
|
-- | A single line of the bindings section of a let expression or of a set.
|
|
data Binding r
|
|
= NamedVar !(NAttrPath r) !r !SourcePos
|
|
-- ^ An explicit naming.
|
|
--
|
|
-- > NamedVar (StaticKey "x" :| [StaticKey "y"]) z SourcePos{} ~ x.y = z;
|
|
| Inherit !(Maybe r) ![NKeyName r] !SourcePos
|
|
-- ^ Using a name already in scope, such as @inherit x;@ which is shorthand
|
|
-- for @x = x;@ or @inherit (x) y;@ which means @y = x.y;@. The
|
|
-- @unsafeGetAttrPos@ for every name so inherited is the position of the
|
|
-- first name, whether that be the first argument to this constructor, or
|
|
-- the first member of the list in the second argument.
|
|
--
|
|
-- > Inherit Nothing [StaticKey "x"] SourcePos{} ~ inherit x;
|
|
-- > Inherit (Just x) [] SourcePos{} ~ inherit (x);
|
|
deriving (Generic, Generic1, Typeable, Data, Ord, Eq, Functor,
|
|
Foldable, Traversable, Show, NFData, Hashable)
|
|
|
|
instance Hashable1 Binding
|
|
|
|
instance NFData1 Binding
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise r => Serialise (Binding r)
|
|
#endif
|
|
|
|
-- | @Params@ represents all the ways the formal parameters to a
|
|
-- function can be represented.
|
|
data Params r
|
|
= Param !VarName
|
|
-- ^ For functions with a single named argument, such as @x: x + 1@.
|
|
--
|
|
-- > Param "x" ~ x
|
|
| ParamSet !(ParamSet r) !Bool !(Maybe VarName)
|
|
-- ^ Explicit parameters (argument must be a set). Might specify a name to
|
|
-- bind to the set in the function body. The bool indicates whether it is
|
|
-- variadic or not.
|
|
--
|
|
-- > ParamSet [("x",Nothing)] False Nothing ~ { x }
|
|
-- > ParamSet [("x",Just y)] True (Just "s") ~ s@{ x ? y, ... }
|
|
deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor, Show,
|
|
Foldable, Traversable, NFData, Hashable)
|
|
|
|
instance Hashable1 Params
|
|
|
|
instance NFData1 Params
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise r => Serialise (Params r)
|
|
#endif
|
|
|
|
-- This uses an association list because nix XML serialization preserves the
|
|
-- order of the param set.
|
|
type ParamSet r = [(VarName, Maybe r)]
|
|
|
|
instance IsString (Params r) where
|
|
fromString = Param . fromString
|
|
|
|
-- | 'Antiquoted' represents an expression that is either
|
|
-- antiquoted (surrounded by ${...}) or plain (not antiquoted).
|
|
data Antiquoted (v :: *) (r :: *)
|
|
= Plain !v
|
|
| EscapedNewline
|
|
-- ^ 'EscapedNewline' corresponds to the special newline form
|
|
--
|
|
-- > ''\n
|
|
--
|
|
-- in an indented string. It is equivalent to a single newline character:
|
|
--
|
|
-- > ''''\n'' ≡ "\n"
|
|
| Antiquoted !r
|
|
deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor, Foldable,
|
|
Traversable, Show, Read, NFData, Hashable)
|
|
|
|
instance Hashable v => Hashable1 (Antiquoted v)
|
|
|
|
instance Hashable2 Antiquoted where
|
|
liftHashWithSalt2 ha _ salt (Plain a) = ha (salt `hashWithSalt` (0 :: Int)) a
|
|
liftHashWithSalt2 _ _ salt EscapedNewline = salt `hashWithSalt` (1 :: Int)
|
|
liftHashWithSalt2 _ hb salt (Antiquoted b) =
|
|
hb (salt `hashWithSalt` (2 :: Int)) b
|
|
|
|
instance NFData v => NFData1 (Antiquoted v)
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance (Serialise v, Serialise r) => Serialise (Antiquoted v r)
|
|
#endif
|
|
|
|
-- | An 'NString' is a list of things that are either a plain string
|
|
-- or an antiquoted expression. After the antiquotes have been evaluated,
|
|
-- the final string is constructed by concatenating all the parts.
|
|
data NString r
|
|
= DoubleQuoted ![Antiquoted Text r]
|
|
-- ^ Strings wrapped with double-quotes (") can contain literal newline
|
|
-- characters, but the newlines are preserved and no indentation is stripped.
|
|
--
|
|
-- > DoubleQuoted [Plain "x",Antiquoted y] ~ "x${y}"
|
|
| Indented !Int ![Antiquoted Text r]
|
|
-- ^ Strings wrapped with two single quotes ('') can contain newlines, and
|
|
-- their indentation will be stripped, but the amount stripped is
|
|
-- remembered.
|
|
--
|
|
-- > Indented 1 [Plain "x"] ~ '' x''
|
|
-- >
|
|
-- > Indented 0 [EscapedNewline] ~ ''''\n''
|
|
-- >
|
|
-- > Indented 0 [Plain "x\n ",Antiquoted y] ~ ''
|
|
-- > x
|
|
-- > ${y}''
|
|
deriving (Eq, Ord, Generic, Generic1, Typeable, Data, Functor, Foldable,
|
|
Traversable, Show, Read, NFData, Hashable)
|
|
|
|
instance Hashable1 NString
|
|
|
|
instance NFData1 NString
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise r => Serialise (NString r)
|
|
#endif
|
|
|
|
-- | For the the 'IsString' instance, we use a plain doublequoted string.
|
|
instance IsString (NString r) where
|
|
fromString "" = DoubleQuoted []
|
|
fromString string = DoubleQuoted [Plain $ pack string]
|
|
|
|
-- | 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@.
|
|
--
|
|
-- Nix supports both static keynames (just an identifier) and dynamic
|
|
-- identifiers. Dynamic identifiers can be either a string (e.g.:
|
|
-- @{ "a" = 3; }@) or an antiquotation (e.g.: @let a = "example";
|
|
-- in { ${a} = 3; }.example@).
|
|
--
|
|
-- Note: There are some places where a dynamic keyname is not allowed.
|
|
-- In particular, those include:
|
|
--
|
|
-- * The RHS of a @binding@ inside @let@: @let ${"a"} = 3; in ...@
|
|
-- produces a syntax error.
|
|
-- * The attribute names of an 'inherit': @inherit ${"a"};@ is forbidden.
|
|
--
|
|
-- Note: In Nix, a simple string without antiquotes such as @"foo"@ is
|
|
-- allowed even if the context requires a static keyname, but the
|
|
-- parser still considers it a 'DynamicKey' for simplicity.
|
|
data NKeyName r
|
|
= DynamicKey !(Antiquoted (NString r) r)
|
|
-- ^
|
|
-- > DynamicKey (Plain (DoubleQuoted [Plain "x"])) ~ "x"
|
|
-- > DynamicKey (Antiquoted x) ~ ${x}
|
|
-- > DynamicKey (Plain (DoubleQuoted [Antiquoted x])) ~ "${x}"
|
|
| StaticKey !VarName
|
|
-- ^
|
|
-- > StaticKey "x" ~ x
|
|
deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData, Hashable)
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise r => Serialise (NKeyName r)
|
|
|
|
instance Serialise Pos where
|
|
encode x = Ser.encode (unPos x)
|
|
decode = mkPos <$> Ser.decode
|
|
|
|
instance Serialise SourcePos where
|
|
encode (SourcePos f l c) = Ser.encode f <> Ser.encode l <> Ser.encode c
|
|
decode = SourcePos <$> Ser.decode <*> Ser.decode <*> Ser.decode
|
|
#endif
|
|
|
|
instance Hashable Pos where
|
|
hashWithSalt salt x = hashWithSalt salt (unPos x)
|
|
|
|
instance Hashable SourcePos where
|
|
hashWithSalt salt (SourcePos f l c) =
|
|
salt `hashWithSalt` f `hashWithSalt` l `hashWithSalt` c
|
|
|
|
instance Generic1 NKeyName where
|
|
type Rep1 NKeyName = NKeyName
|
|
from1 = id
|
|
to1 = id
|
|
|
|
instance NFData1 NKeyName where
|
|
liftRnf _ (StaticKey !_ ) = ()
|
|
liftRnf _ (DynamicKey (Plain !_) ) = ()
|
|
liftRnf _ (DynamicKey EscapedNewline) = ()
|
|
liftRnf k (DynamicKey (Antiquoted r)) = k r
|
|
|
|
-- | Most key names are just static text, so this instance is convenient.
|
|
instance IsString (NKeyName r) where
|
|
fromString = StaticKey . fromString
|
|
|
|
instance Eq1 NKeyName where
|
|
liftEq eq (DynamicKey a) (DynamicKey b) = liftEq2 (liftEq eq) eq a b
|
|
liftEq _ (StaticKey a) (StaticKey b) = a == b
|
|
liftEq _ _ _ = False
|
|
|
|
-- | @since 0.10.1
|
|
instance Ord1 NKeyName where
|
|
liftCompare cmp (DynamicKey a) (DynamicKey b) = liftCompare2 (liftCompare cmp) cmp a b
|
|
liftCompare _ (DynamicKey _) (StaticKey _) = LT
|
|
liftCompare _ (StaticKey _) (DynamicKey _) = GT
|
|
liftCompare _ (StaticKey a) (StaticKey b) = compare a b
|
|
|
|
instance Hashable1 NKeyName where
|
|
liftHashWithSalt h salt (DynamicKey a) =
|
|
liftHashWithSalt2 (liftHashWithSalt h) h (salt `hashWithSalt` (0 :: Int)) a
|
|
liftHashWithSalt _ salt (StaticKey n) =
|
|
salt `hashWithSalt` (1 :: Int) `hashWithSalt` n
|
|
|
|
-- Deriving this instance automatically is not possible because @r@
|
|
-- occurs not only as last argument in @Antiquoted (NString r) r@
|
|
instance Show1 NKeyName where
|
|
liftShowsPrec sp sl p = \case
|
|
DynamicKey a -> showsUnaryWith
|
|
(liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl)
|
|
"DynamicKey"
|
|
p
|
|
a
|
|
StaticKey t -> showsUnaryWith showsPrec "StaticKey" p t
|
|
|
|
-- Deriving this instance automatically is not possible because @r@
|
|
-- occurs not only as last argument in @Antiquoted (NString r) r@
|
|
instance Functor NKeyName where
|
|
fmap = fmapDefault
|
|
|
|
-- Deriving this instance automatically is not possible because @r@
|
|
-- occurs not only as last argument in @Antiquoted (NString r) r@
|
|
instance Foldable NKeyName where
|
|
foldMap = foldMapDefault
|
|
|
|
-- Deriving this instance automatically is not possible because @r@
|
|
-- occurs not only as last argument in @Antiquoted (NString r) r@
|
|
instance Traversable NKeyName where
|
|
traverse f = \case
|
|
DynamicKey (Plain str) -> DynamicKey . Plain <$> traverse f str
|
|
DynamicKey (Antiquoted e ) -> DynamicKey . Antiquoted <$> f e
|
|
DynamicKey EscapedNewline -> pure $ DynamicKey EscapedNewline
|
|
StaticKey key -> pure (StaticKey key)
|
|
|
|
-- | A selector (for example in a @let@ or an attribute set) is made up
|
|
-- of strung-together key names.
|
|
--
|
|
-- > StaticKey "x" :| [DynamicKey (Antiquoted y)] ~ x.${y}
|
|
type NAttrPath r = NonEmpty (NKeyName r)
|
|
|
|
-- | There are two unary operations: logical not and integer negation.
|
|
data NUnaryOp
|
|
= NNeg -- ^ @-@
|
|
| NNot -- ^ @!@
|
|
deriving (Eq, Ord, Enum, Bounded, Generic, Typeable, Data, Show, Read,
|
|
NFData, Hashable)
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise NUnaryOp
|
|
#endif
|
|
|
|
-- | 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 attribute sets (@//@)
|
|
| NPlus -- ^ Addition (@+@)
|
|
| NMinus -- ^ Subtraction (@-@)
|
|
| NMult -- ^ Multiplication (@*@)
|
|
| NDiv -- ^ Division (@/@)
|
|
| NConcat -- ^ List concatenation (@++@)
|
|
| NApp -- ^ Apply a function to an argument.
|
|
--
|
|
-- > NBinary NApp f x ~ f x
|
|
deriving (Eq, Ord, Enum, Bounded, Generic, Typeable, Data, Show, Read,
|
|
NFData, Hashable)
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise NBinaryOp
|
|
#endif
|
|
|
|
-- | 'NRecordType' distinguishes between recursive and non-recursive attribute
|
|
-- sets.
|
|
data NRecordType
|
|
= NNonRecursive -- ^ > { ... }
|
|
| NRecursive -- ^ > rec { ... }
|
|
deriving (Eq, Ord, Enum, Bounded, Generic, Typeable, Data, Show, Read,
|
|
NFData, Hashable)
|
|
|
|
#ifdef MIN_VERSION_serialise
|
|
instance Serialise NRecordType
|
|
#endif
|
|
|
|
-- | Get the name out of the parameter (there might be none).
|
|
paramName :: Params r -> Maybe VarName
|
|
paramName (Param n ) = Just n
|
|
paramName (ParamSet _ _ n) = n
|
|
|
|
$(deriveEq1 ''NExprF)
|
|
$(deriveEq1 ''NString)
|
|
$(deriveEq1 ''Binding)
|
|
$(deriveEq1 ''Params)
|
|
$(deriveEq1 ''Antiquoted)
|
|
$(deriveEq2 ''Antiquoted)
|
|
|
|
$(deriveOrd1 ''NExprF)
|
|
$(deriveOrd1 ''NString)
|
|
$(deriveOrd1 ''Binding)
|
|
$(deriveOrd1 ''Params)
|
|
$(deriveOrd1 ''Antiquoted)
|
|
$(deriveOrd2 ''Antiquoted)
|
|
|
|
$(deriveRead1 ''NString)
|
|
$(deriveRead1 ''Params)
|
|
$(deriveRead1 ''Antiquoted)
|
|
$(deriveRead2 ''Antiquoted)
|
|
|
|
$(deriveShow1 ''NExprF)
|
|
$(deriveShow1 ''NString)
|
|
$(deriveShow1 ''Params)
|
|
$(deriveShow1 ''Binding)
|
|
$(deriveShow1 ''Antiquoted)
|
|
$(deriveShow2 ''Antiquoted)
|
|
|
|
--x $(deriveJSON1 defaultOptions ''NExprF)
|
|
$(deriveJSON1 defaultOptions ''NString)
|
|
$(deriveJSON1 defaultOptions ''Params)
|
|
--x $(deriveJSON1 defaultOptions ''Binding)
|
|
$(deriveJSON1 defaultOptions ''Antiquoted)
|
|
$(deriveJSON2 defaultOptions ''Antiquoted)
|
|
|
|
instance (Binary v, Binary a) => Binary (Antiquoted v a)
|
|
instance Binary a => Binary (NString a)
|
|
instance Binary a => Binary (Binding a)
|
|
instance Binary Pos where
|
|
put x = Bin.put (unPos x)
|
|
get = mkPos <$> Bin.get
|
|
instance Binary SourcePos
|
|
instance Binary a => Binary (NKeyName a)
|
|
instance Binary a => Binary (Params a)
|
|
instance Binary NAtom
|
|
instance Binary NUnaryOp
|
|
instance Binary NBinaryOp
|
|
instance Binary NRecordType
|
|
instance Binary a => Binary (NExprF a)
|
|
|
|
instance (ToJSON v, ToJSON a) => ToJSON (Antiquoted v a)
|
|
instance ToJSON a => ToJSON (NString a)
|
|
instance ToJSON a => ToJSON (Binding a)
|
|
instance ToJSON Pos where
|
|
toJSON x = toJSON (unPos x)
|
|
instance ToJSON SourcePos
|
|
instance ToJSON a => ToJSON (NKeyName a)
|
|
instance ToJSON a => ToJSON (Params a)
|
|
instance ToJSON NAtom
|
|
instance ToJSON NUnaryOp
|
|
instance ToJSON NBinaryOp
|
|
instance ToJSON NRecordType
|
|
instance ToJSON a => ToJSON (NExprF a)
|
|
|
|
instance (FromJSON v, FromJSON a) => FromJSON (Antiquoted v a)
|
|
instance FromJSON a => FromJSON (NString a)
|
|
instance FromJSON a => FromJSON (Binding a)
|
|
instance FromJSON Pos where
|
|
parseJSON = fmap mkPos . parseJSON
|
|
instance FromJSON SourcePos
|
|
instance FromJSON a => FromJSON (NKeyName a)
|
|
instance FromJSON a => FromJSON (Params a)
|
|
instance FromJSON NAtom
|
|
instance FromJSON NUnaryOp
|
|
instance FromJSON NBinaryOp
|
|
instance FromJSON NRecordType
|
|
instance FromJSON a => FromJSON (NExprF a)
|
|
|
|
$(makeTraversals ''NExprF)
|
|
$(makeTraversals ''Binding)
|
|
$(makeTraversals ''Params)
|
|
$(makeTraversals ''Antiquoted)
|
|
$(makeTraversals ''NString)
|
|
$(makeTraversals ''NKeyName)
|
|
$(makeTraversals ''NUnaryOp)
|
|
$(makeTraversals ''NBinaryOp)
|
|
|
|
--x $(makeLenses ''Fix)
|
|
|
|
class NExprAnn ann g | g -> ann where
|
|
fromNExpr :: g r -> (NExprF r, ann)
|
|
toNExpr :: (NExprF r, ann) -> g r
|
|
|
|
ekey
|
|
:: NExprAnn ann g
|
|
=> NonEmpty Text
|
|
-> SourcePos
|
|
-> Lens' (Fix g) (Maybe (Fix g))
|
|
ekey keys pos f e@(Fix x) | (NSet NNonRecursive xs, ann) <- fromNExpr x = case go xs of
|
|
((v, [] ) : _) -> fromMaybe e <$> f (Just v)
|
|
((v, r : rest) : _) -> ekey (r :| rest) pos f v
|
|
|
|
_ -> f Nothing <&> \case
|
|
Nothing -> e
|
|
Just v ->
|
|
let entry = NamedVar (NE.map StaticKey keys) v pos
|
|
in Fix (toNExpr (NSet NNonRecursive (entry : xs), ann))
|
|
where
|
|
go xs = do
|
|
let keys' = NE.toList keys
|
|
(ks, rest) <- zip (inits keys') (tails keys')
|
|
case ks of
|
|
[] -> empty
|
|
j : js -> do
|
|
NamedVar ns v _p <- xs
|
|
guard $ (j : js) == (NE.toList ns ^.. traverse . _StaticKey)
|
|
return (v, rest)
|
|
|
|
ekey _ _ f e = fromMaybe e <$> f Nothing
|
|
|
|
stripPositionInfo :: NExpr -> NExpr
|
|
stripPositionInfo = transport phi
|
|
where
|
|
phi (NSet recur binds) = NSet recur (map go binds)
|
|
phi (NLet binds body) = NLet (map go binds) body
|
|
phi x = x
|
|
|
|
go (NamedVar path r _pos) = NamedVar path r nullPos
|
|
go (Inherit ms names _pos) = Inherit ms names nullPos
|
|
|
|
nullPos :: SourcePos
|
|
nullPos = SourcePos "<string>" (mkPos 1) (mkPos 1)
|