From 9ef12ef163c0f4c947c11933ce50d9d3fcd30248 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 18:33:50 +0200
Subject: [PATCH 1/8] Expr.Types: NExprF: add NApp

This commit takes-put the NApp out of NBinaryOp & places it as a proper citizen
on NExprF.

Addresses https://github.com/haskell-nix/hnix/issues/1041 &
https://github.com/haskell-nix/hnix/issues/377.
---
 src/Nix/Eval.hs                 |  2 +-
 src/Nix/Exec.hs                 | 15 +++++++++---
 src/Nix/Expr/Shorthands.hs      | 10 ++++++--
 src/Nix/Expr/Types.hs           | 16 ++++++++++---
 src/Nix/Expr/Types/Annotated.hs | 14 +++++++++--
 src/Nix/Lint.hs                 | 42 ++++++++++++++++-----------------
 src/Nix/Parser.hs               | 13 +++++++++-
 src/Nix/Pretty.hs               |  4 ++--
 src/Nix/Reduce.hs               | 14 +++++------
 src/Nix/Type/Infer.hs           |  3 +--
 tests/ParserTests.hs            |  6 ++---
 11 files changed, 90 insertions(+), 49 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index f701b3596..7a3f970e5 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -119,7 +119,7 @@ eval (NLiteralPath p      ) = evalLiteralPath p
 eval (NEnvPath     p      ) = evalEnvPath p
 eval (NUnary op arg       ) = evalUnary op =<< arg
 
-eval (NBinary NApp fun arg) =
+eval (NApp NAppOp fun arg) =
   do
     f <- fun
     scope <- askScopes
diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index 3f9dc07e8..93a30866a 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -103,6 +103,17 @@ mkNVUnaryOpWithProvenance
 mkNVUnaryOpWithProvenance scope span op val =
   addProvenance (Provenance scope $ NUnaryAnnF span op val)
 
+mkNVAppOpWithProvenance
+  :: MonadCited t f m
+  => Scopes m (NValue t f m)
+  -> SrcSpan
+  -> Maybe (NValue t f m)
+  -> Maybe (NValue t f m)
+  -> NValue t f m
+  -> NValue t f m
+mkNVAppOpWithProvenance scope span lval rval =
+  addProvenance (Provenance scope $ NAppAnnF span lval rval)
+
 mkNVBinaryOpWithProvenance
   :: MonadCited t f m
   => Scopes m (NValue t f m)
@@ -274,7 +285,7 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
     do
       scope <- askScopes
       span  <- askSpan
-      mkNVBinaryOpWithProvenance scope span NApp (pure f) Nothing <$> (callFunc f =<< defer x)
+      mkNVAppOpWithProvenance scope span (pure f) Nothing <$> (callFunc f =<< defer x)
 
   evalAbs
     :: Params (m (NValue t f m))
@@ -444,8 +455,6 @@ execBinaryOpForced scope span op lval rval =
           mkStrP . (ls <>) <$>
             coerceAnyToNixString callFunc DontCopyToStore rs
         _ -> unsupportedTypes
-
-    NApp  -> throwError $ ErrorCall "NApp should be handled by evalApp"
     _other   -> shouldBeAlreadyHandled
 
  where
diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs
index bddf4d7bc..df1df712c 100644
--- a/src/Nix/Expr/Shorthands.hs
+++ b/src/Nix/Expr/Shorthands.hs
@@ -84,6 +84,11 @@ mkNot = mkOp NNot
 mkNeg :: NExpr -> NExpr
 mkNeg = mkOp NNeg
 
+-- | Put a binary operator.
+--  @since 0.15.0
+mkApp :: NExpr -> NExpr -> NExpr
+mkApp a = Fix . NApp NAppOp a
+
 -- | Put a binary operator.
 --  @since 0.15.0
 mkOp2 :: NBinaryOp -> NExpr -> NExpr -> NExpr
@@ -325,7 +330,7 @@ recAttrsE pairs = mkRecSet $ uncurry ($=) <$> pairs
 
 -- * Nix binary operators
 
-(@@), ($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++)
+($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++)
   :: NExpr -> NExpr -> NExpr
 --  2021-07-10: NOTE: Probably the presedence of some operators is still needs to be tweaked.
 
@@ -343,7 +348,8 @@ infix 9 @.
 infix 9 @.<|>
 
 -- | Function application (@' '@ in @f x@)
-(@@) = mkOp2 NApp
+(@@) :: NExpr -> NExpr -> NExpr
+(@@) = mkApp
 infixl 8 @@
 
 -- | List concatenation: @++@
diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs
index fb6e82042..17782ac4c 100644
--- a/src/Nix/Expr/Types.hs
+++ b/src/Nix/Expr/Types.hs
@@ -529,6 +529,14 @@ data NUnaryOp
 
 $(makeTraversals ''NUnaryOp)
 
+-- **
+
+data NAppOp = NAppOp
+  deriving
+    ( Eq, Ord, Generic
+    , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON
+    , Show, Hashable
+    )
 
 -- ** data NBinaryOp
 
@@ -549,9 +557,6 @@ data NBinaryOp
   | 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, NFData, Serialise, Binary, ToJSON, FromJSON
@@ -605,6 +610,10 @@ data NExprF r
   --
   -- > NUnary NNeg x                               ~  - x
   -- > NUnary NNot x                               ~  ! x
+  | NApp NAppOp !r !r
+  -- ^ Functional application (aka F.A., apply a function to an argument).
+  --
+  -- > NApp f x  ~  f x
   | NBinary !NBinaryOp !r !r
   -- ^ Application of a binary operator to two expressions.
   --
@@ -814,6 +823,7 @@ getFreeVars e =
     (NLiteralPath _               ) -> mempty
     (NEnvPath     _               ) -> mempty
     (NUnary       _    expr       ) -> getFreeVars expr
+    (NApp         _    left right ) -> collectFreeVars left right
     (NBinary      _    left right ) -> collectFreeVars left right
     (NSelect      orExpr expr path) ->
       Set.unions
diff --git a/src/Nix/Expr/Types/Annotated.hs b/src/Nix/Expr/Types/Annotated.hs
index 8b739c267..98e37ab42 100644
--- a/src/Nix/Expr/Types/Annotated.hs
+++ b/src/Nix/Expr/Types/Annotated.hs
@@ -168,7 +168,7 @@ annNHasAttr :: NExprLoc -> AnnUnit SrcSpan (NAttrPath NExprLoc) -> NExprLoc
 annNHasAttr e1@(Ann s1 _) (AnnUnit s2 ats) = NHasAttrAnn (s1 <> s2) e1 ats
 
 annNApp :: NExprLoc -> NExprLoc -> NExprLoc
-annNApp e1@(Ann s1 _) e2@(Ann s2 _) = NBinaryAnn (s1 <> s2) NApp e1 e2
+annNApp e1@(Ann s1 _) e2@(Ann s2 _) = NAppAnn (s1 <> s2) e1 e2
 
 annNAbs :: AnnUnit SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc
 annNAbs (AnnUnit s1 ps) e1@(Ann s2 _) = NAbsAnn (s1 <> s2) ps e1
@@ -187,7 +187,9 @@ nullSpan :: SrcSpan
 nullSpan = SrcSpan nullPos nullPos
 {-# inline nullSpan #-}
 
--- | Pattern systems for matching on @NExprLocF@ constructions.
+-- ** Patterns
+
+-- *** Patterns to match on 'NExprLocF' constructions (for 'SrcSpan'-based annotations).
 
 pattern NConstantAnnF    :: SrcSpan -> NAtom -> NExprLocF r
 pattern NConstantAnnF    ann x      = AnnF ann (NConstant x)
@@ -213,6 +215,9 @@ pattern NEnvPathAnnF     ann x      = AnnF ann (NEnvPath x)
 pattern NUnaryAnnF       :: SrcSpan -> NUnaryOp -> r -> NExprLocF r
 pattern NUnaryAnnF       ann op x   = AnnF ann (NUnary op x)
 
+pattern NAppAnnF         :: SrcSpan -> r -> r -> NExprLocF r
+pattern NAppAnnF         ann x y    = AnnF ann (NApp NAppOp x y)
+
 pattern NBinaryAnnF      :: SrcSpan -> NBinaryOp -> r -> r -> NExprLocF r
 pattern NBinaryAnnF      ann op x y = AnnF ann (NBinary op x y)
 
@@ -242,6 +247,8 @@ pattern NSynHoleAnnF     ann x      = AnnF ann (NSynHole x)
 {-# complete NConstantAnnF, NStrAnnF, NSymAnnF, NListAnnF, NSetAnnF, NLiteralPathAnnF, NEnvPathAnnF, NUnaryAnnF, NBinaryAnnF, NSelectAnnF, NHasAttrAnnF, NAbsAnnF, NLetAnnF, NIfAnnF, NWithAnnF, NAssertAnnF, NSynHoleAnnF #-}
 
 
+-- *** Patterns to match on 'NExprLoc' constructions (for 'SrcSpan'-based annotations).
+
 pattern NConstantAnn    :: SrcSpan -> NAtom -> NExprLoc
 pattern NConstantAnn    ann x      = Ann ann (NConstant x)
 
@@ -266,6 +273,9 @@ pattern NEnvPathAnn     ann x      = Ann ann (NEnvPath x)
 pattern NUnaryAnn       :: SrcSpan -> NUnaryOp -> NExprLoc -> NExprLoc
 pattern NUnaryAnn       ann op x   = Ann ann (NUnary op x)
 
+pattern NAppAnn         :: SrcSpan -> NExprLoc -> NExprLoc -> NExprLoc
+pattern NAppAnn         ann x y    = Ann ann (NApp NAppOp x y)
+
 pattern NBinaryAnn      :: SrcSpan -> NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc
 pattern NBinaryAnn      ann op x y = Ann ann (NBinary op x y)
 
diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index f231a774d..fa8648ef5 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -391,7 +391,7 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
       _ <- unify (void e) cond =<< mkSymbolic (one $ TConstant $ one TBool)
       pure body'
 
-  evalApp = (fmap snd .) . lintApp (join (NBinary NApp) mempty)
+  evalApp = (fmap snd .) . lintApp (join (NApp NAppOp) mempty)
   evalAbs params _ = mkSymbolic (one $ TClosure $ void params)
 
   evalError = throwError
@@ -408,33 +408,31 @@ lintBinaryOp op lsym rarg =
     rsym <- rarg
     y    <- defer everyPossible
 
-    case op of
-      NApp    -> symerr "lintBinaryOp:NApp: should never get here"
-      _ -> check lsym rsym $
-        case op of
-          NEq     -> [TConstant [TInt, TBool, TNull], TStr, TList y]
-          NNEq    -> [TConstant [TInt, TBool, TNull], TStr, TList y]
+    check lsym rsym $
+      case op of
+        NEq     -> [TConstant [TInt, TBool, TNull], TStr, TList y]
+        NNEq    -> [TConstant [TInt, TBool, TNull], TStr, TList y]
 
-          NLt     -> one $ TConstant [TInt, TBool, TNull]
-          NLte    -> one $ TConstant [TInt, TBool, TNull]
-          NGt     -> one $ TConstant [TInt, TBool, TNull]
-          NGte    -> one $ TConstant [TInt, TBool, TNull]
+        NLt     -> one $ TConstant [TInt, TBool, TNull]
+        NLte    -> one $ TConstant [TInt, TBool, TNull]
+        NGt     -> one $ TConstant [TInt, TBool, TNull]
+        NGte    -> one $ TConstant [TInt, TBool, TNull]
 
-          NAnd    -> one $ TConstant $ one TBool
-          NOr     -> one $ TConstant $ one TBool
-          NImpl   -> one $ TConstant $ one TBool
+        NAnd    -> one $ TConstant $ one TBool
+        NOr     -> one $ TConstant $ one TBool
+        NImpl   -> one $ TConstant $ one TBool
 
-          -- jww (2018-04-01): NYI: Allow Path + Str
-          NPlus   -> [TConstant $ one TInt, TStr, TPath]
-          NMinus  -> one $ TConstant $ one TInt
-          NMult   -> one $ TConstant $ one TInt
-          NDiv    -> one $ TConstant $ one TInt
+        -- jww (2018-04-01): NYI: Allow Path + Str
+        NPlus   -> [TConstant $ one TInt, TStr, TPath]
+        NMinus  -> one $ TConstant $ one TInt
+        NMult   -> one $ TConstant $ one TInt
+        NDiv    -> one $ TConstant $ one TInt
 
-          NUpdate -> one $ TSet mempty
+        NUpdate -> one $ TSet mempty
 
-          NConcat -> one $ TList y
+        NConcat -> one $ TList y
 #if __GLASGOW_HASKELL__ < 900
-          _ -> fail "Should not be possible"  -- symerr or this fun signature should be changed to work in type scope
+        _ -> fail "Should not be possible"  -- symerr or this fun signature should be changed to work in type scope
 #endif
 
 
diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index a5959d278..92ca57a2d 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -20,6 +20,7 @@ module Nix.Parser
   , NAssoc(..)
   , NOperatorDef
   , getUnaryOperator
+  , getAppOperator
   , getBinaryOperator
   , getSpecialOperator
   , nixExpr
@@ -472,6 +473,7 @@ data NAssoc = NAssocNone | NAssocLeft | NAssocRight
 
 data NOperatorDef
   = NUnaryDef          NUnaryOp   Text
+  | NAppDef            NAssoc     Text
   | NBinaryDef  NAssoc NBinaryOp  Text
   | NSpecialDef NAssoc NSpecialOp Text
   deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
@@ -548,7 +550,7 @@ nixOperators selector =
 
     {-  2 -}
     one
-      ( NBinaryDef NAssocLeft NApp " "
+      ( NAppDef NAssocLeft " "
       ,
         -- Thanks to Brent Yorgey for showing me this trick!
         InfixL $ annNApp <$ symbols mempty
@@ -640,6 +642,15 @@ getUnaryOperator = detectPrecedence spec
       (NUnaryDef op name, _) -> one (op, OperatorInfo i NAssocNone name)
       _                      -> mempty
 
+getAppOperator :: NAppOp -> OperatorInfo
+getAppOperator = detectPrecedence spec
+ where
+  spec :: Int -> (NOperatorDef, b) -> [(NAppOp, OperatorInfo)]
+  spec i =
+    \case
+      (NAppDef assoc name, _) -> one (NAppOp, OperatorInfo i assoc name)
+      _                             -> mempty
+
 getBinaryOperator :: NBinaryOp -> OperatorInfo
 getBinaryOperator = detectPrecedence spec
  where
diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index 6a87953e9..d38c20ec6 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -74,7 +74,7 @@ leastPrecedence =
   mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"
 
 appOp :: OperatorInfo
-appOp = getBinaryOperator NApp
+appOp = getAppOperator NAppOp
 
 appOpNonAssoc :: OperatorInfo
 appOpNonAssoc = appOp { associativity = NAssocNone }
@@ -255,7 +255,7 @@ exprFNixDoc = \case
           [ prettyParams args <> ":"
           , getDoc body
           ]
-  NBinary NApp fun arg ->
+  NApp NAppOp fun arg ->
     mkNixDoc appOp (precedenceWrap appOp fun <> " " <> precedenceWrap appOpNonAssoc arg)
   NBinary op r1 r2 ->
     mkNixDoc
diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index b360a5263..27f0c81dd 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -171,13 +171,13 @@ reduce (NUnaryAnnF uann op arg) =
 --
 --     * Reduce a lambda function by adding its name to the local
 --       scope and recursively reducing its body.
-reduce (NBinaryAnnF bann NApp fun arg) =
+reduce (NAppAnnF bann fun arg) =
   (\case
     f@(NSymAnn _ "import") ->
       (\case
           -- NEnvPathAnn     pann origPath -> staticImport pann origPath
         NLiteralPathAnn pann origPath -> staticImport pann origPath
-        v -> pure $ NBinaryAnn bann NApp f v
+        v -> pure $ NAppAnn bann f v
       ) =<< arg
 
     NAbsAnn _ (Param name) body ->
@@ -187,7 +187,7 @@ reduce (NBinaryAnnF bann NApp fun arg) =
           (coerce $ HM.singleton name x)
           (foldFix reduce body)
 
-    f -> NBinaryAnn bann NApp f <$> arg
+    f -> NAppAnn bann f <$> arg
   ) =<< fun
 
 -- | Reduce an integer addition to its result.
@@ -391,14 +391,14 @@ pruneTree opts =
     NSelect alt (Just aset) attr ->
       pure $ NSelect (join alt) aset $ pruneKeyName <$> attr
 
+    -- If the function was never called, it means its argument was in a
+    -- thunk that was forced elsewhere.
+    NApp NAppOp Nothing (Just _) -> Nothing
+
     -- These are the only short-circuiting binary operators
     NBinary NAnd (Just (Ann _ larg)) _ -> pure larg
     NBinary NOr  (Just (Ann _ larg)) _ -> pure larg
 
-    -- If the function was never called, it means its argument was in a
-    -- thunk that was forced elsewhere.
-    NBinary NApp Nothing (Just _) -> Nothing
-
     -- The idea behind emitted a binary operator where one side may be
     -- invalid is that we're trying to emit what will reproduce whatever
     -- fail the user encountered, which means providing all aspects of
diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index 795219bc9..77d07795c 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -677,9 +677,8 @@ unops u1 op =
 binops :: Type -> NBinaryOp -> [Constraint]
 binops u1 op =
   if
-    -- NApp in fact is handled separately
     -- Equality tells nothing about the types, because any two types are allowed.
-    | op `elem` [ NApp  , NEq  , NNEq        ] -> mempty
+    | op `elem` [ NEq   , NNEq               ] -> mempty
     | op `elem` [ NGt   , NGte , NLt  , NLte ] -> inequality
     | op `elem` [ NAnd  , NOr  , NImpl       ] -> gate
     | op ==       NConcat                      -> concatenation
diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs
index 6094572c9..d18220520 100644
--- a/tests/ParserTests.hs
+++ b/tests/ParserTests.hs
@@ -662,12 +662,10 @@ case_simpleLoc =
       (one $
         NamedVar
           (one $ StaticKey "foo")
-          (NBinaryAnn
+          (NAppAnn
             (mkSpan (2, 7) (3, 15))
-            NApp
-            (NBinaryAnn
+            (NAppAnn
               (mkSpan (2, 7) (3, 9))
-              NApp
               (NSymAnn (mkSpan (2, 7) (2, 10)) "bar")
               (NSymAnn (mkSpan (3, 6) (3, 9 )) "baz")
             )

From bdf87e853af983bd21be12fff4bf193a63bf5ae4 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 18:57:14 +0200
Subject: [PATCH 2/8] Expr.Types: upd N{,Source}Pos instance messaging

Since this is no longer Megaparsec types - these instances are no longer orphaned.
---
 src/Nix/Expr/Types.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs
index 17782ac4c..74f7e1fc6 100644
--- a/src/Nix/Expr/Types.hs
+++ b/src/Nix/Expr/Types.hs
@@ -116,12 +116,10 @@ type AttrSet = HashMap VarName
 -- A type synonym for @HashMap VarName NSourcePos@.
 type PositionSet = AttrSet NSourcePos
 
--- ** orphan instances
+-- ** Additional N{,Source}Pos instances
 
 -- Placed here because TH inference depends on declaration sequence.
 
--- Upstreaming so far was not pursued.
-
 instance Serialise NPos where
   encode = Serialise.encode . unPos . coerce
   decode = coerce . mkPos <$> Serialise.decode

From 843e2da349c7cd7a440eda4c2542b1aab4e52e0f Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 19:58:52 +0200
Subject: [PATCH 3/8] Expr.Types: rm building berth NAppOp

It was used to simplify NApp migration.
---
 src/Nix/Eval.hs                 |  2 +-
 src/Nix/Expr/Shorthands.hs      |  4 ++--
 src/Nix/Expr/Types.hs           | 13 ++-----------
 src/Nix/Expr/Types/Annotated.hs |  4 ++--
 src/Nix/Lint.hs                 |  2 +-
 src/Nix/Parser.hs               | 15 +++++++--------
 src/Nix/Pretty.hs               |  4 ++--
 src/Nix/Reduce.hs               |  2 +-
 8 files changed, 18 insertions(+), 28 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 7a3f970e5..7e90a0d39 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -119,7 +119,7 @@ eval (NLiteralPath p      ) = evalLiteralPath p
 eval (NEnvPath     p      ) = evalEnvPath p
 eval (NUnary op arg       ) = evalUnary op =<< arg
 
-eval (NApp NAppOp fun arg) =
+eval (NApp fun arg        ) =
   do
     f <- fun
     scope <- askScopes
diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs
index df1df712c..84b9e4c39 100644
--- a/src/Nix/Expr/Shorthands.hs
+++ b/src/Nix/Expr/Shorthands.hs
@@ -85,9 +85,9 @@ mkNeg :: NExpr -> NExpr
 mkNeg = mkOp NNeg
 
 -- | Put a binary operator.
---  @since 0.15.0
+--  @since 0.16.0
 mkApp :: NExpr -> NExpr -> NExpr
-mkApp a = Fix . NApp NAppOp a
+mkApp a = Fix . NApp a
 
 -- | Put a binary operator.
 --  @since 0.15.0
diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs
index 74f7e1fc6..ee2733217 100644
--- a/src/Nix/Expr/Types.hs
+++ b/src/Nix/Expr/Types.hs
@@ -527,15 +527,6 @@ data NUnaryOp
 
 $(makeTraversals ''NUnaryOp)
 
--- **
-
-data NAppOp = NAppOp
-  deriving
-    ( Eq, Ord, Generic
-    , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON
-    , Show, Hashable
-    )
-
 -- ** data NBinaryOp
 
 -- | Binary operators expressible in the nix language.
@@ -608,7 +599,7 @@ data NExprF r
   --
   -- > NUnary NNeg x                               ~  - x
   -- > NUnary NNot x                               ~  ! x
-  | NApp NAppOp !r !r
+  | NApp !r !r
   -- ^ Functional application (aka F.A., apply a function to an argument).
   --
   -- > NApp f x  ~  f x
@@ -821,7 +812,7 @@ getFreeVars e =
     (NLiteralPath _               ) -> mempty
     (NEnvPath     _               ) -> mempty
     (NUnary       _    expr       ) -> getFreeVars expr
-    (NApp         _    left right ) -> collectFreeVars left right
+    (NApp         left right      ) -> collectFreeVars left right
     (NBinary      _    left right ) -> collectFreeVars left right
     (NSelect      orExpr expr path) ->
       Set.unions
diff --git a/src/Nix/Expr/Types/Annotated.hs b/src/Nix/Expr/Types/Annotated.hs
index 98e37ab42..829725682 100644
--- a/src/Nix/Expr/Types/Annotated.hs
+++ b/src/Nix/Expr/Types/Annotated.hs
@@ -216,7 +216,7 @@ pattern NUnaryAnnF       :: SrcSpan -> NUnaryOp -> r -> NExprLocF r
 pattern NUnaryAnnF       ann op x   = AnnF ann (NUnary op x)
 
 pattern NAppAnnF         :: SrcSpan -> r -> r -> NExprLocF r
-pattern NAppAnnF         ann x y    = AnnF ann (NApp NAppOp x y)
+pattern NAppAnnF         ann x y    = AnnF ann (NApp x y)
 
 pattern NBinaryAnnF      :: SrcSpan -> NBinaryOp -> r -> r -> NExprLocF r
 pattern NBinaryAnnF      ann op x y = AnnF ann (NBinary op x y)
@@ -274,7 +274,7 @@ pattern NUnaryAnn       :: SrcSpan -> NUnaryOp -> NExprLoc -> NExprLoc
 pattern NUnaryAnn       ann op x   = Ann ann (NUnary op x)
 
 pattern NAppAnn         :: SrcSpan -> NExprLoc -> NExprLoc -> NExprLoc
-pattern NAppAnn         ann x y    = Ann ann (NApp NAppOp x y)
+pattern NAppAnn         ann x y    = Ann ann (NApp x y)
 
 pattern NBinaryAnn      :: SrcSpan -> NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc
 pattern NBinaryAnn      ann op x y = Ann ann (NBinary op x y)
diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index fa8648ef5..1c0963429 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -391,7 +391,7 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
       _ <- unify (void e) cond =<< mkSymbolic (one $ TConstant $ one TBool)
       pure body'
 
-  evalApp = (fmap snd .) . lintApp (join (NApp NAppOp) mempty)
+  evalApp = (fmap snd .) . lintApp (join NApp mempty)
   evalAbs params _ = mkSymbolic (one $ TClosure $ void params)
 
   evalError = throwError
diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index 92ca57a2d..f1ccc0bdd 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -642,14 +642,13 @@ getUnaryOperator = detectPrecedence spec
       (NUnaryDef op name, _) -> one (op, OperatorInfo i NAssocNone name)
       _                      -> mempty
 
-getAppOperator :: NAppOp -> OperatorInfo
-getAppOperator = detectPrecedence spec
- where
-  spec :: Int -> (NOperatorDef, b) -> [(NAppOp, OperatorInfo)]
-  spec i =
-    \case
-      (NAppDef assoc name, _) -> one (NAppOp, OperatorInfo i assoc name)
-      _                             -> mempty
+getAppOperator :: OperatorInfo
+getAppOperator =
+  OperatorInfo
+    { precedence    = 1 -- inside the code it is 1, inside the Nix they are +1
+    , associativity = NAssocLeft
+    , operatorName  = " "
+    }
 
 getBinaryOperator :: NBinaryOp -> OperatorInfo
 getBinaryOperator = detectPrecedence spec
diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index d38c20ec6..aa3109fd2 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -74,7 +74,7 @@ leastPrecedence =
   mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"
 
 appOp :: OperatorInfo
-appOp = getAppOperator NAppOp
+appOp = getAppOperator
 
 appOpNonAssoc :: OperatorInfo
 appOpNonAssoc = appOp { associativity = NAssocNone }
@@ -255,7 +255,7 @@ exprFNixDoc = \case
           [ prettyParams args <> ":"
           , getDoc body
           ]
-  NApp NAppOp fun arg ->
+  NApp fun arg ->
     mkNixDoc appOp (precedenceWrap appOp fun <> " " <> precedenceWrap appOpNonAssoc arg)
   NBinary op r1 r2 ->
     mkNixDoc
diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index 27f0c81dd..6eb3cdac7 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -393,7 +393,7 @@ pruneTree opts =
 
     -- If the function was never called, it means its argument was in a
     -- thunk that was forced elsewhere.
-    NApp NAppOp Nothing (Just _) -> Nothing
+    NApp Nothing (Just _) -> Nothing
 
     -- These are the only short-circuiting binary operators
     NBinary NAnd (Just (Ann _ larg)) _ -> pure larg

From ee753ca7365ec2c82ddaf8c655f10f5b73d4594a Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 20:33:25 +0200
Subject: [PATCH 4/8] m fxs

---
 src/Nix/Expr/Shorthands.hs | 3 +--
 src/Nix/Lint.hs            | 2 +-
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs
index 84b9e4c39..ba50d8640 100644
--- a/src/Nix/Expr/Shorthands.hs
+++ b/src/Nix/Expr/Shorthands.hs
@@ -330,7 +330,7 @@ recAttrsE pairs = mkRecSet $ uncurry ($=) <$> pairs
 
 -- * Nix binary operators
 
-($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++)
+(@@), ($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++)
   :: NExpr -> NExpr -> NExpr
 --  2021-07-10: NOTE: Probably the presedence of some operators is still needs to be tweaked.
 
@@ -348,7 +348,6 @@ infix 9 @.
 infix 9 @.<|>
 
 -- | Function application (@' '@ in @f x@)
-(@@) :: NExpr -> NExpr -> NExpr
 (@@) = mkApp
 infixl 8 @@
 
diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index 1c0963429..61343e7a7 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -431,7 +431,7 @@ lintBinaryOp op lsym rarg =
         NUpdate -> one $ TSet mempty
 
         NConcat -> one $ TList y
-#if __GLASGOW_HASKELL__ < 900
+#if __GLASGOW_HASKELL__ < 810
         _ -> fail "Should not be possible"  -- symerr or this fun signature should be changed to work in type scope
 #endif
 

From 5b69b37fe56fed05ef939b62b8dd846c4bff1512 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 22:47:30 +0200
Subject: [PATCH 5/8] Builtins: m refactor

---
 src/Nix/Builtins.hs | 34 +++++++++++++++-------------------
 1 file changed, 15 insertions(+), 19 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 39e6366a3..207913935 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -1717,40 +1717,37 @@ addErrorContextNix _ = pure
 execNix
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 execNix xs =
-  do
-    xs' <- traverse (coerceStringlikeToNixString DontCopyToStore) =<< fromValue @[NValue t f m] xs
-    -- 2018-11-19: NOTE: Still need to do something with the context here
-    -- See prim_exec in nix/src/libexpr/primops.cc
-    -- Requires the implementation of EvalState::realiseContext
-    exec $ ignoreContext <$> xs'
+  -- 2018-11-19: NOTE: Still need to do something with the context here
+  -- See prim_exec in nix/src/libexpr/primops.cc
+  -- Requires the implementation of EvalState::realiseContext
+  (exec . fmap ignoreContext) =<< traverse (coerceStringlikeToNixString DontCopyToStore) =<< fromValue @[NValue t f m] xs
 
 fetchurlNix
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 fetchurlNix =
   (\case
-    NVSet _ s -> go (M.lookup "sha256" s) =<< demand =<< attrsetGet "url" s
-    v@NVStr{} -> go Nothing v
+    NVSet _ s -> fetch (M.lookup "sha256" s) =<< demand =<< attrsetGet "url" s
+    v@NVStr{} -> fetch Nothing v
     v -> throwError $ ErrorCall $ "builtins.fetchurl: Expected URI or set, got " <> show v
   ) <=< demand
 
  where
-  go :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
-  go _msha =
+  --  2022-01-21: NOTE: Needs to check the hash match.
+  fetch :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
+  fetch _msha =
     \case
       NVStr ns ->
         either -- msha
           throwError
           toValue
-          =<< getURL =<< noContextAttrs ns
+          =<< getURL
+            =<< maybe
+              (throwError $ ErrorCall "builtins.fetchurl: unsupported arguments to url")
+              pure
+              (getStringNoContext ns)
 
       v -> throwError $ ErrorCall $ "builtins.fetchurl: Expected URI or string, got " <> show v
 
-  noContextAttrs ns =
-    maybe
-      (throwError $ ErrorCall "builtins.fetchurl: unsupported arguments to url")
-      pure
-      (getStringNoContext ns)
-
 partitionNix
   :: forall e t f m
    . MonadNix e t f m
@@ -1759,10 +1756,9 @@ partitionNix
   -> m (NValue t f m)
 partitionNix f nvlst =
   do
-    l <- fromValue @[NValue t f m] nvlst
     let
       match t = (, t) <$> (fromValue =<< callFunc f t)
-    selection <- traverse match l
+    selection <- traverse match =<< fromValue @[NValue t f m] nvlst
 
     let
       (right, wrong) = partition fst selection

From d23219d7073dd68a9a52f28be822c436f94dab49 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 22:48:36 +0200
Subject: [PATCH 6/8] Effects: refactor

---
 src/Nix/Effects.hs | 52 ++++++++++++++++++++++++----------------------
 src/Nix/Lint.hs    | 10 +++------
 2 files changed, 30 insertions(+), 32 deletions(-)

diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs
index b85fc896b..4a3fb3b45 100644
--- a/src/Nix/Effects.hs
+++ b/src/Nix/Effects.hs
@@ -290,24 +290,27 @@ class
 -- ** Instances
 
 instance MonadHttp IO where
-  getURL url = do
-    let urlstr = toString url
-    traceM $ "fetching HTTP URL: " <> urlstr
-    req     <- parseRequest urlstr
-    manager <-
-      if secure req
-        then newTlsManager
-        else newManager defaultManagerSettings
-    -- print req
-    response <- httpLbs (req { method = "GET" }) manager
-    let status = statusCode $ responseStatus response
-    pure $ Left $ ErrorCall $ if status /= 200
-      then
-        "fail, got " <> show status <> " when fetching url:" <> urlstr
-      else
-        -- do
-        -- let bstr = responseBody response
-        "success in downloading but hnix-store is not yet ready; url = " <> urlstr
+  getURL url =
+    do
+      let urlstr = toString url
+      traceM $ "fetching HTTP URL: " <> urlstr
+      req     <- parseRequest urlstr
+      manager <-
+        bool
+          (newManager defaultManagerSettings)
+          newTlsManager
+          (secure req)
+      -- print req
+      response <- httpLbs (req { method = "GET" }) manager
+      let status = statusCode $ responseStatus response
+      pure $ Left $ ErrorCall $
+        bool
+          ("fail, got " <> show status <> " when fetching url = ")
+          -- do
+          -- let bstr = responseBody response
+          "success in downloading but hnix-store is not yet ready; url = "
+          (status == 200)
+          <> urlstr
 
 deriving
   instance
@@ -418,13 +421,12 @@ instance MonadStore IO where
 -- ** Functions
 
 parseStoreResult :: Monad m => Text -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a)
-parseStoreResult name res =
-  pure $ either
-    (\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> msg <> "\n" <> show logs)
-    pure -- result
-    (fst res)
- where
-  logs = snd res
+parseStoreResult name (res, logs) =
+  pure $
+    either
+      (\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> msg <> "\n" <> show logs)
+      pure
+      res
 
 addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m StorePath
 addTextToStore a b c d =
diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index 61343e7a7..54c8f7b81 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -465,13 +465,9 @@ lintApp context fun arg =
       (args, ys) <- fmap unzip $ forM xs $ \case
         TClosure _params ->
           (\case
-            NAny -> do
-              error "NYI"
-
-            NMany [TSet (Just _)] -> do
-              error "NYI"
-
-            NMany _ -> throwError $ ErrorCall "NYI: lintApp NMany not set"
+            NAny                  -> error "NYI"
+            NMany [TSet (Just _)] -> error "NYI"
+            NMany _               -> throwError $ ErrorCall "NYI: lintApp NMany not set"
           ) =<< unpackSymbolic =<< arg
         TBuiltin _ _f -> throwError $ ErrorCall "NYI: lintApp builtin"
         TSet _m       -> throwError $ ErrorCall "NYI: lintApp Set"

From 87081c418301e5a71b33d8f4214833138772c95c Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 22:54:05 +0200
Subject: [PATCH 7/8] Expr.Shorthands: m fx

---
 src/Nix/Expr/Shorthands.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs
index ba50d8640..4959c67d1 100644
--- a/src/Nix/Expr/Shorthands.hs
+++ b/src/Nix/Expr/Shorthands.hs
@@ -68,7 +68,12 @@ mkSynHole = Fix . mkSynHoleF
 mkSelector :: Text -> NAttrPath NExpr
 mkSelector = one . StaticKey . coerce
 
+-- | Put a binary operator.
+--  @since
+mkApp :: NExpr -> NExpr -> NExpr
+mkApp a = Fix . NApp a
 -- | Put an unary operator.
+
 --  @since 0.15.0
 mkOp :: NUnaryOp -> NExpr -> NExpr
 mkOp op = Fix . NUnary op
@@ -84,11 +89,6 @@ mkNot = mkOp NNot
 mkNeg :: NExpr -> NExpr
 mkNeg = mkOp NNeg
 
--- | Put a binary operator.
---  @since 0.16.0
-mkApp :: NExpr -> NExpr -> NExpr
-mkApp a = Fix . NApp a
-
 -- | Put a binary operator.
 --  @since 0.15.0
 mkOp2 :: NBinaryOp -> NExpr -> NExpr -> NExpr

From 80b93dbdd2e58fcf58362e3d7e96f5273884f5e9 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 21 Jan 2022 23:30:20 +0200
Subject: [PATCH 8/8] upd ChangeLog

---
 ChangeLog.md | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/ChangeLog.md b/ChangeLog.md
index d6a068ddb..6acf7737e 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,6 +1,13 @@
 
 # ChangeLog
 
+## [(diff)](https://github.com/haskell-nix/hnix/compare/0.16.0...0.17.0#files_bucket) 0.17.0
+
+* Breaking:
+  * `Nix.Expr.Types`
+    * [(link)](https://github.com/haskell-nix/hnix/pull/1042/files) The central HNix type `NExprF` changed, the `NApp` was moved out of `NBinary` & now a `NExprF` constructor of its own, the type signatures were changed accordingly.
+    * [(link)](https://github.com/haskell-nix/hnix/pull/1038/files) project was using `megaparsec` `{,Source}Pos` and to use it shipped a lot of orphan instances. To improve the situation & performance (reports [#1026](https://github.com/haskell-nix/hnix/issues/1026), [#746](https://github.com/haskell-nix/hnix/issues/746)) project uses `N{,Source}Pos` types, related type signatures were changed accordingly.
+
 ## [(diff)](https://github.com/haskell-nix/hnix/compare/0.15.0...0.16.0#files_bucket) 0.16.0
 
 On update problems, please reach out to us. For support refere to: https://github.com/haskell-nix/hnix/issues/984