treewide: migrate to use of N{Pos,SourcePos}

This is work towards: haskell-nix#1026 & haskell-nix#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 )
@@ -107,52 +113,53 @@ toSourcePos (NSourcePos f l c) =
 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
 
@@ -447,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.
@@ -743,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
 
@@ -760,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

src/Nix/Parser.hs

@@ -108,10 +108,10 @@ annotateLocation1 :: Parser a -> Parser (AnnUnit SrcSpan a)
 annotateLocation1 p =
   do
     begin <- getSourcePos
-    res <- p
+    res   <- p
     end   <- get -- The state set before the last whitespace
 
-    pure $ AnnUnit (SrcSpan begin end) res
+    pure $ AnnUnit (SrcSpan (toNSourcePos begin) (toNSourcePos end)) res
 
 annotateLocation :: Parser (NExprF NExprLoc) -> Parser NExprLoc
 annotateLocation = (annUnitToAnn <$>) . annotateLocation1
@@ -401,15 +401,15 @@ nixBinders = (inherit <|> namedVar) `endBy` symbol ';' where
       label "inherited binding" $
         liftA2 (Inherit x)
           (many identifier)
-          (pure p)
+          (pure (toNSourcePos p))
   namedVar =
     do
       p <- getSourcePos
       label "variable binding" $
         liftA3 NamedVar
           (annotated <$> nixSelector)
           (exprAfterSymbol '=')
-          (pure p)
+          (pure (toNSourcePos p))
   scope = label "inherit scope" nixParens
 
 nixSet :: Parser NExprLoc

src/Nix/Reduce.hs

@@ -102,7 +102,7 @@ staticImport pann path =
           (\ err -> fail $ "Parse failed: " <> show err)
           (\ x -> do
             let
-              pos  = join (SourcePos "Reduce.hs") $ mkPos 1
+              pos  = join (NSourcePos "Reduce.hs") $ (coerce . mkPos) 1
               span = join SrcSpan pos
               cur  =
                 NamedVar