(#1038) Expr.Types: add & use NPos & NSourcePos

This is a type & type boundary lifting groundwork to do #1026 & #746 design in this release.

The `NPos` & `NSourcePos` next can be freely shaped into what comes out of the #1026 & #746.

src/Nix/Builtins.hs

@@ -1986,7 +1986,7 @@ builtinsList =
  , add Normal "tail" tailNix
  , add2 Normal "toFile" toFileNix
  , add Normal "toJSON" toJSONNix
- , add Normal "toPath" toPathNix
+ , add Normal "toPath" toPathNix -- Deprecated in Nix: https://github.com/NixOS/nix/pull/2524
  , add Normal "toXML" toXMLNix
  , add0 Normal "true" (pure $ mkNVBool True)
  , add Normal "tryEval" tryEvalNix

src/Nix/Convert.hs

@@ -21,7 +21,6 @@ import qualified Data.HashMap.Lazy as M
 import Nix.Atoms
 import Nix.Effects
 import Nix.Expr.Types
-import Nix.Expr.Types.Annotated
 import Nix.Frames
 import Nix.String
 import Nix.Value
@@ -410,11 +409,11 @@ instance Convertible e t f m
  toValue = toValue @Path . coerce
 
 instance Convertible e t f m
- => ToValue SourcePos m (NValue' t f m (NValue t f m)) where
- toValue (SourcePos f l c) = do
- f' <- toValue $ mkNixStringWithoutContext $ fromString f
- l' <- toValue $ unPos l
- c' <- toValue $ unPos c
+ => ToValue NSourcePos m (NValue' t f m (NValue t f m)) where
+ toValue (NSourcePos f l c) = do
+ f' <- toValue $ mkNixStringWithoutContext $ fromString $ coerce f
+ l' <- toValue $ unPos $ coerce l
+ c' <- toValue $ unPos $ coerce c
  let pos = M.fromList [("file" :: VarName, f'), ("line", l'), ("column", c')]
  pure $ mkNVSet' mempty pos
 

src/Nix/Eval.hs

@@ -213,7 +213,7 @@ attrSetAlter
  :: forall v m
  . MonadNixEval v m
  => [VarName]
- -> SourcePos
+ -> NSourcePos
  -> AttrSet (m v)
  -> PositionSet
  -> m v
@@ -267,32 +267,32 @@ desugarBinds embed = (`evalState` mempty) . traverse (findBinding <=< collect)
  collect
  :: Binding r
  -> State
- (AttrSet (SourcePos, [Binding r]))
+ (AttrSet (NSourcePos, [Binding r]))
  (Either VarName (Binding r))
  collect (NamedVar (StaticKey x :| y : ys) val oldPosition) =
  do
  modify updateBindingInformation
  pure $ Left x
  where
  updateBindingInformation
- :: AttrSet (SourcePos, [Binding r])
- -> AttrSet (SourcePos, [Binding r])
+ :: AttrSet (NSourcePos, [Binding r])
+ -> AttrSet (NSourcePos, [Binding r])
  updateBindingInformation =
  M.insert x
  =<< maybe
  (mkBindingSingleton oldPosition)
  (\ (foundPosition, newBindings) -> second (<> newBindings) $ mkBindingSingleton foundPosition)
  . M.lookup x
- mkBindingSingleton :: SourcePos -> (SourcePos, [Binding r])
+ mkBindingSingleton :: NSourcePos -> (NSourcePos, [Binding r])
  mkBindingSingleton np = (np , one $ bindValAt np)
  where
- bindValAt :: SourcePos -> Binding r
+ bindValAt :: NSourcePos -> Binding r
  bindValAt = NamedVar (y :| ys) val
  collect x = pure $ pure x
 
  findBinding
  :: Either VarName (Binding r)
- -> State (AttrSet (SourcePos, [Binding r])) (Binding r)
+ -> State (AttrSet (NSourcePos, [Binding r])) (Binding r)
  findBinding =
  either
  (\ x ->
@@ -320,7 +320,7 @@ evalBinds isRecursive binds =
  where
  buildResult
  :: Scopes m v
- -> [([VarName], SourcePos, m v)]
+ -> [([VarName], NSourcePos, m v)]
  -> m (AttrSet v, PositionSet)
  buildResult scopes bindings =
  do
@@ -335,13 +335,14 @@ evalBinds isRecursive binds =
  pure (coerce res, p)
 
  where
+ insert :: (AttrSet (m v), PositionSet) -> ([VarName], NSourcePos, m v) -> m (AttrSet (m v), PositionSet)
  insert (m, p) (path, pos, value) = attrSetAlter path pos m p value
 
  mkThunk = defer . withScopes scopes
 
  encapsulate f attrs = mkThunk $ pushScope attrs f
 
- applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]
+ applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([VarName], NSourcePos, m v)]
  applyBindToAdt _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =
  do
  (o', p') <- fromValue =<< finalValue
@@ -363,7 +364,7 @@ evalBinds isRecursive binds =
  ) <$> processAttrSetKeys pathExpr
 
  where
- processAttrSetKeys :: NAttrPath (m v) -> m ([VarName], SourcePos, m v)
+ processAttrSetKeys :: NAttrPath (m v) -> m ([VarName], NSourcePos, m v)
  processAttrSetKeys (h :| t) =
  maybe
  -- Empty attrset - return a stub.
@@ -387,7 +388,7 @@ evalBinds isRecursive binds =
  where
  processScope
  :: VarName
- -> ([VarName], SourcePos, m v)
+ -> ([VarName], NSourcePos, m v)
  processScope var =
  ( one var
  , pos

src/Nix/Expr/Types.hs

@@ -18,7 +18,13 @@
 -- [Brief on shallow & deep embedding.](https://web.archive.org/web/20201112031804/https://alessandrovermeulen.me/2013/07/13/the-difference-between-shallow-and-deep-embedding/)
 --
 -- (additiona info for dev): Big use of TemplateHaskell in the module requires proper (top-down) organization of declarations.
-module Nix.Expr.Types where
+module Nix.Expr.Types
+ ( module Nix.Expr.Types
+ , SourcePos(..)
+ , unPos
+ , mkPos
+ )
+where
 
 import Nix.Prelude
 import qualified Codec.Serialise as Serialise
@@ -40,10 +46,10 @@ import GHC.Generics
 import qualified Language.Haskell.TH.Syntax as TH
 import Lens.Family2
 import Lens.Family2.TH
-import Text.Megaparsec.Pos ( SourcePos(SourcePos)
- , Pos
+import Text.Megaparsec.Pos ( Pos
  , mkPos
  , unPos
+ , SourcePos(SourcePos)
  )
 import Text.Show.Deriving ( deriveShow1, deriveShow2 )
 import Text.Read.Deriving ( deriveRead1, deriveRead2 )
@@ -60,57 +66,100 @@ import Instances.TH.Lift () -- importing Lift Text for G
 
 -- * utils
 
+newtype NPos = NPos Pos
+ deriving
+ ( Eq, Ord
+ , Read, Show
+ , Data, NFData
+ , Generic
+ )
+
+instance Semigroup NPos where
+ (NPos x) <> (NPos y) = NPos (x <> y)
+
+-- | Represents source positions.
+-- Source line & column positions change intensively during parsing,
+-- so they are declared strict to avoid memory leaks.
+--
+-- The data type is a reimplementation of 'Text.Megaparsec.Pos' 'SourcePos'.
+data NSourcePos =
+ NSourcePos
+ { -- | Name of source file
+ getSourceName :: Path,
+ -- | Line number
+ getSourceLine :: !NPos,
+ -- | Column number
+ getSourceColumn :: !NPos
+ }
+ deriving
+ ( Eq, Ord
+ , Read, Show
+ , Data, NFData
+ , Generic
+ )
+
+-- | Helper for 'SourcePos' -> 'NSourcePos' coersion.
+toNSourcePos :: SourcePos -> NSourcePos
+toNSourcePos (SourcePos f l c) =
+ NSourcePos (coerce f) (coerce l) (coerce c)
+
+-- | Helper for 'NSourcePos' -> 'SourcePos' coersion.
+toSourcePos :: NSourcePos -> SourcePos
+toSourcePos (NSourcePos f l c) =
+ SourcePos (coerce f) (coerce l) (coerce c)
+
 -- 2021-07-16: NOTE: Should replace @ParamSet@ List
 -- | > Hashmap VarName -- type synonym
 type AttrSet = HashMap VarName
 
 -- | Holds file positionng information for abstrations.
--- A type synonym for @HashMap VarName SourcePos@.
-type PositionSet = AttrSet SourcePos
+-- A type synonym for @HashMap VarName NSourcePos@.
+type PositionSet = AttrSet NSourcePos
 
 -- ** orphan instances
 
 -- Placed here because TH inference depends on declaration sequence.
 
 -- Upstreaming so far was not pursued.
 
-instance Serialise Pos where
- encode = Serialise.encode . unPos
- decode = mkPos <$> Serialise.decode
+instance Serialise NPos where
+ encode = Serialise.encode . unPos . coerce
+ decode = coerce . mkPos <$> Serialise.decode
 
-instance Serialise SourcePos where
- encode (SourcePos f l c) =
+instance Serialise NSourcePos where
+ encode (NSourcePos f l c) =
+ coerce $
  Serialise.encode f <>
  Serialise.encode l <>
  Serialise.encode c
  decode =
- liftA3 SourcePos
+ liftA3 NSourcePos
  Serialise.decode
  Serialise.decode
  Serialise.decode
 
-instance Hashable Pos where
- hashWithSalt salt = hashWithSalt salt . unPos
+instance Hashable NPos where
+ hashWithSalt salt = hashWithSalt salt . unPos . coerce
 
-instance Hashable SourcePos where
- hashWithSalt salt (SourcePos f l c) =
+instance Hashable NSourcePos where
+ hashWithSalt salt (NSourcePos f l c) =
  salt
  `hashWithSalt` f
  `hashWithSalt` l
  `hashWithSalt` c
 
-instance Binary Pos where
- put = Binary.put . unPos
- get = mkPos <$> Binary.get
-instance Binary SourcePos
+instance Binary NPos where
+ put = (Binary.put @Int) . unPos . coerce
+ get = coerce . mkPos <$> Binary.get
+instance Binary NSourcePos
 
-instance ToJSON Pos where
- toJSON = toJSON . unPos
-instance ToJSON SourcePos
+instance ToJSON NPos where
+ toJSON = toJSON . unPos . coerce
+instance ToJSON NSourcePos
 
-instance FromJSON Pos where
- parseJSON = fmap mkPos . parseJSON
-instance FromJSON SourcePos
+instance FromJSON NPos where
+ parseJSON = coerce . fmap mkPos . parseJSON
+instance FromJSON NSourcePos
 
 -- * Components of Nix expressions
 
@@ -405,23 +454,23 @@ instance Hashable1 NonEmpty
 
 -- | A single line of the bindings section of a let expression or of a set.
 data Binding r
- = NamedVar !(NAttrPath r) !r !SourcePos
+ = NamedVar !(NAttrPath r) !r !NSourcePos
  -- ^ An explicit naming.
  --
- -- > NamedVar (StaticKey "x" :| [StaticKey "y"]) z SourcePos{} ~ x.y = z;
- | Inherit !(Maybe r) ![VarName] !SourcePos
+ -- > NamedVar (StaticKey "x" :| [StaticKey "y"]) z NSourcePos{} ~ x.y = z;
+ | Inherit !(Maybe r) ![VarName] !NSourcePos
  -- ^ Inheriting an attribute (binding) into the attribute set from the other scope (attribute set). No denoted scope means to inherit from the closest outside scope.
  --
- -- +---------------------------------------------------------------+--------------------+-----------------------+
- -- | Hask | Nix | pseudocode |
- -- +===============================================================+====================+=======================+
- -- | @Inherit Nothing [StaticKey "a"] SourcePos{}@ | @inherit a;@ | @a = outside.a;@ |
- -- +---------------------------------------------------------------+--------------------+-----------------------+
- -- | @Inherit (pure x) [StaticKey "a"] SourcePos{}@ | @inherit (x) a;@ | @a = x.a;@ |
- -- +---------------------------------------------------------------+--------------------+-----------------------+
- -- | @Inherit (pure x) [StaticKey "a", StaticKey "b"] SourcePos{}@ | @inherit (x) a b;@ | @a = x.a;@ |
- -- | | | @b = x.b;@ |
- -- +---------------------------------------------------------------+--------------------+-----------------------+
+ -- +----------------------------------------------------------------+--------------------+-----------------------+
+ -- | Hask  | Nix | pseudocode |
+ -- +================================================================+====================+=======================+
+ -- | @Inherit Nothing [StaticKey "a"] NSourcePos{}@ | @inherit a;@ | @a = outside.a;@ |
+ -- +----------------------------------------------------------------+--------------------+-----------------------+
+ -- | @Inherit (pure x) [StaticKey "a"] NSourcePos{}@ | @inherit (x) a;@ | @a = x.a;@ |
+ -- +----------------------------------------------------------------+--------------------+-----------------------+
+ -- | @Inherit (pure x) [StaticKey "a", StaticKey "b"] NSourcePos{}@ | @inherit (x) a b;@ | @a = x.a;@ |
+ -- |  | | @b = x.b;@ |
+ -- +----------------------------------------------------------------+--------------------+-----------------------+
  --
  -- (2021-07-07 use details):
  -- Inherits the position of the first name through @unsafeGetAttrPos@. The position of the scope inherited from else - the position of the first member of the binds list.
@@ -701,8 +750,8 @@ stripPositionInfo = transport phi
  erasePositions (NamedVar path r _pos) = NamedVar path r nullPos
  erasePositions (Inherit ms names _pos) = Inherit ms names nullPos
 
-nullPos :: SourcePos
-nullPos = on (SourcePos "<string>") mkPos 1 1
+nullPos :: NSourcePos
+nullPos = on (NSourcePos "<string>") (coerce . mkPos) 1 1
 
 -- * Dead code
 
@@ -718,7 +767,7 @@ ekey
  :: forall ann g
  . NExprAnn ann g
  => NonEmpty VarName
- -> SourcePos
+ -> NSourcePos
  -> Lens' (Fix g) (Maybe (Fix g))
 ekey keys pos f e@(Fix x)
  | (NSet NonRecursive xs, ann) <- fromNExpr x =

src/Nix/Expr/Types/Annotated.hs

@@ -10,9 +10,6 @@
 module Nix.Expr.Types.Annotated
  ( module Nix.Expr.Types.Annotated
  , module Data.Functor.Compose
- , SourcePos(..)
- , unPos
- , mkPos
  )
 where
 
@@ -35,19 +32,15 @@ import Data.Ord.Deriving
 import GHC.Generics
 import Nix.Atoms
 import Nix.Expr.Types
-import Text.Megaparsec ( unPos
- , mkPos
- )
-import Text.Megaparsec.Pos ( SourcePos(..) )
 import Text.Read.Deriving
 import Text.Show.Deriving
 
 -- * data type @SrcSpan@ - a zone in a source file
 
 -- | Demarcation of a chunk in a source file.
 data SrcSpan = SrcSpan
- { spanBegin :: SourcePos
- , spanEnd :: SourcePos
+ { getSpanBegin :: NSourcePos
+ , getSpanEnd :: NSourcePos
  }
  deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData, Hashable)
 
@@ -56,8 +49,8 @@ data SrcSpan = SrcSpan
 instance Semigroup SrcSpan where
  s1 <> s2 =
  SrcSpan
- (on min spanBegin s1 s2)
- (on max spanEnd s1 s2)
+ (on min getSpanBegin s1 s2)
+ (on max getSpanEnd s1 s2)
 
 instance Binary SrcSpan
 instance ToJSON SrcSpan
@@ -183,8 +176,8 @@ annNAbs (AnnUnit s1 ps) e1@(Ann s2 _) = NAbsAnn (s1 <> s2) ps e1
 annNStr :: AnnUnit SrcSpan (NString NExprLoc) -> NExprLoc
 annNStr (AnnUnit s1 s) = NStrAnn s1 s
 
-deltaInfo :: SourcePos -> (Text, Int, Int)
-deltaInfo (SourcePos fp l c) = (fromString fp, unPos l, unPos c)
+deltaInfo :: NSourcePos -> (Text, Int, Int)
+deltaInfo (NSourcePos fp l c) = (fromString $ coerce fp, unPos $ coerce l, unPos $ coerce c)
 
 annNNull :: NExprLoc
 annNNull = NConstantAnn nullSpan NNull