From 6d614e898a6d86e14f732dea3abdf2d2ae06218e Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 15:34:59 +0200
Subject: [PATCH 01/45] Pretty: mkNixDoc: unflip

---
 src/Nix/Pretty.hs | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index f8e1c2358..e757c3bb6 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -62,14 +62,14 @@ data NixDoc ann = NixDoc
                     -- we can add brackets appropriately
   }
 
-mkNixDoc :: Doc ann -> OperatorInfo -> NixDoc ann
-mkNixDoc d o = NixDoc { withoutParens = d, rootOp = o, wasPath = False }
+mkNixDoc :: OperatorInfo -> Doc ann -> NixDoc ann
+mkNixDoc o d = NixDoc { withoutParens = d, rootOp = o, wasPath = False }
 
 -- | A simple expression is never wrapped in parentheses. The expression
 --   behaves as if its root operator had a precedence higher than all
 --   other operators (including function application).
 simpleExpr :: Doc ann -> NixDoc ann
-simpleExpr d = mkNixDoc d (OperatorInfo minBound NAssocNone "simple expr")
+simpleExpr = mkNixDoc (OperatorInfo minBound NAssocNone "simple expr")
 
 pathExpr :: Doc ann -> NixDoc ann
 pathExpr d = (simpleExpr d) { wasPath = True }
@@ -81,7 +81,7 @@ pathExpr d = (simpleExpr d) { wasPath = True }
 --   binding).
 leastPrecedence :: Doc ann -> NixDoc ann
 leastPrecedence =
-  flip mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"
+  mkNixDoc (OperatorInfo maxBound NAssocNone "least precedence")
 
 appOp :: OperatorInfo
 appOp = getBinaryOperator NApp
@@ -243,8 +243,8 @@ exprFNixDoc = \case
       $ vsep
       $ [prettyParams args <> colon, withoutParens body]
   NBinary NApp fun arg ->
-    mkNixDoc (wrapParens appOp fun <> space <> wrapParens appOpNonAssoc arg) appOp
-  NBinary op r1 r2 -> flip mkNixDoc opInfo $ hsep
+    mkNixDoc appOp (wrapParens appOp fun <> space <> wrapParens appOpNonAssoc arg) 
+  NBinary op r1 r2 -> mkNixDoc opInfo $ hsep
     [ wrapParens (f NAssocLeft) r1
     , pretty $ unpack $ operatorName opInfo
     , wrapParens (f NAssocRight) r2
@@ -253,21 +253,22 @@ exprFNixDoc = \case
     opInfo = getBinaryOperator op
     f x | associativity opInfo /= x = opInfo { associativity = NAssocNone }
         | otherwise                 = opInfo
-  NUnary op r1 -> mkNixDoc
-    (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1)
-    opInfo
+  NUnary op r1 ->
+    mkNixDoc
+      opInfo
+      (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1)
     where opInfo = getUnaryOperator op
   NSelect r' attr o ->
-    (if isJust o then leastPrecedence else flip mkNixDoc selectOp)
+    (if isJust o then leastPrecedence else mkNixDoc selectOp)
       $  wrapPath selectOp r
       <> dot
       <> prettySelector attr
       <> ordoc
    where
-    r     = flip mkNixDoc selectOp $ wrapParens appOpNonAssoc r'
+    r     = mkNixDoc selectOp (wrapParens appOpNonAssoc r')
     ordoc = maybe mempty (((space <> "or ") <>) . wrapParens appOpNonAssoc) o
   NHasAttr r attr ->
-    mkNixDoc (wrapParens hasAttrOp r <> " ? " <> prettySelector attr) hasAttrOp
+    mkNixDoc hasAttrOp (wrapParens hasAttrOp r <> " ? " <> prettySelector attr)
   NEnvPath     p -> simpleExpr $ pretty ("<" <> p <> ">")
   NLiteralPath p ->
     pathExpr $

From 886d83ba42afcf6e97d95b7bd4be74b0b2447eb7 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 15:44:32 +0200
Subject: [PATCH 02/45] Expr.Types.Annotated: fx inline directive

---
 src/Nix/Expr/Types/Annotated.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Nix/Expr/Types/Annotated.hs b/src/Nix/Expr/Types/Annotated.hs
index 7ebaa8ec2..307820565 100644
--- a/src/Nix/Expr/Types/Annotated.hs
+++ b/src/Nix/Expr/Types/Annotated.hs
@@ -138,7 +138,7 @@ stripAnn = annotated . getCompose
 nUnary :: Ann SrcSpan NUnaryOp -> NExprLoc -> NExprLoc
 nUnary (Ann s1 u) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NUnary u e1)
 nUnary _          _              = error "nUnary: unexpected"
-{-# inline nUnary#-}
+{-# inline nUnary #-}
 
 nBinary :: Ann SrcSpan NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc
 nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =

From 5583b0a8767cc7aab804abd23a9e32d6368822dc Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 15:46:02 +0200
Subject: [PATCH 03/45] rm unused RankNTypes; Utils: embed RankNtypes
 `transport`

---
 src/Nix/Exec.hs       |  4 ++--
 src/Nix/Expr/Types.hs | 48 ++++++++++++++++++++++++++-----------------
 src/Nix/Normal.hs     |  1 -
 src/Nix/Pretty.hs     |  1 -
 src/Nix/Reduce.hs     | 11 ++++++----
 src/Nix/Type/Infer.hs |  1 -
 src/Nix/Utils.hs      |  4 ----
 7 files changed, 38 insertions(+), 32 deletions(-)

diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index c7a68ca32..e932181a0 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -423,7 +423,7 @@ execBinaryOpForced scope span op lval rval = case op of
         <$> coerceToString callFunc CopyToStore CoerceStringy rs
     (NVPath ls, NVStr rs) -> case getStringNoContext rs of
       Just rs2 -> nvPathP prov <$> makeAbsolutePath @t @f (ls `mappend` Text.unpack rs2)
-      Nothing -> throwError $ ErrorCall $
+      Nothing -> throwError $ ErrorCall
         -- data/nix/src/libexpr/eval.cc:1412
         "A string that refers to a store path cannot be appended to a path."
     (NVPath ls, NVPath rs) -> nvPathP prov <$> makeAbsolutePath @t @f (ls <> rs)
@@ -441,7 +441,7 @@ execBinaryOpForced scope span op lval rval = case op of
   NAnd  -> alreadyHandled
   NOr   -> alreadyHandled
   NImpl -> alreadyHandled
-  NApp  -> throwError $ ErrorCall $ "NApp should be handled by evalApp"
+  NApp  -> throwError $ ErrorCall "NApp should be handled by evalApp"
 
  where
   prov :: Provenance m (NValue t f m)
diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs
index aaf416208..7aec636c2 100644
--- a/src/Nix/Expr/Types.hs
+++ b/src/Nix/Expr/Types.hs
@@ -630,31 +630,41 @@ ekey
   => 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 (pure 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)
-        pure (v, rest)
+ekey keys pos f e@(Fix x) | (NSet NNonRecursive xs, ann) <- fromNExpr x =
+  case go xs of
+    ((v, []      ) : _) -> fromMaybe e <$> f (pure v)
+    ((v, r : rest) : _) -> ekey (r :| rest) pos f v
+
+    _                   ->
+      maybe
+        e
+        (\ v ->
+          let entry = NamedVar (NE.map StaticKey keys) v pos in
+          Fix (toNExpr (NSet NNonRecursive (entry : xs), ann)))
+      <$>
+        f Nothing
+  where
+    go xs =
+      do
+        let keys' = NE.toList keys
+        (ks, rest) <- zip (inits keys') (tails keys')
+        list
+          empty
+          (\ (j : js) ->
+            do
+              NamedVar ns v _p <- xs
+              guard $ (j : js) == (NE.toList ns ^.. traverse . _StaticKey)
+              pure (v, rest)
+          )
+          ks
 
 ekey _ _ f e = fromMaybe e <$> f Nothing
 
 stripPositionInfo :: NExpr -> NExpr
 stripPositionInfo = transport phi
  where
+  transport f (Fix x) = Fix $ fmap (transport f) (f x)
+
   phi (NSet recur binds) = NSet recur $ fmap go binds
   phi (NLet binds body) = NLet (fmap go binds) body
   phi x                 = x
diff --git a/src/Nix/Normal.hs b/src/Nix/Normal.hs
index e3123f9c9..a092fad54 100644
--- a/src/Nix/Normal.hs
+++ b/src/Nix/Normal.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index e757c3bb6..abd69d9da 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index fa9d9b1e4..cecf096c0 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -10,7 +10,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -26,7 +25,10 @@
 --   original. It should be seen as an opportunistic simplifier, but which
 --   gives up easily if faced with any potential for ambiguity in the result.
 
-module Nix.Reduce (reduceExpr, reducingEvalExpr) where
+module Nix.Reduce
+  ( reduceExpr
+  , reducingEvalExpr
+  ) where
 
 import           Control.Applicative
 import           Control.Arrow                  ( second )
@@ -39,6 +41,7 @@ import           Control.Monad.Fix
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Control.Monad.State.Strict
+import           Data.Bifunctor                 ( first )
 import           Data.Fix                       ( Fix(..), foldFix, foldFixM )
 import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
@@ -109,10 +112,10 @@ staticImport pann path = do
                           (Fix (NLiteralPath_ pann path))
                           pos
           x' = Fix (NLet_ span [cur] x)
-        modify (\(a, b) -> (M.insert path x' a, b))
+        modify (first (M.insert path x'))
         local (const (pure path, emptyScopes @m @NExprLoc)) $ do
           x'' <- foldFix reduce x'
-          modify (\(a, b) -> (M.insert path x'' a, b))
+          modify (first (M.insert path x''))
           pure x''
 
 -- gatherNames :: NExprLoc -> HashSet VarName
diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index c1355ab61..254800a1c 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -14,7 +14,6 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE InstanceSigs #-}
 
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs
index c5029f720..a01a7e99c 100644
--- a/src/Nix/Utils.hs
+++ b/src/Nix/Utils.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
@@ -89,9 +88,6 @@ cataP f x = f x . fmap (cataP f) . unFix $ x
 cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a
 cataPM f x = f x <=< traverse (cataPM f) . unFix $ x
 
-transport :: Functor g => (forall x . f x -> g x) -> Fix f -> Fix g
-transport f (Fix x) = Fix $ fmap (transport f) (f x)
-
 lifted
   :: (MonadTransControl u, Monad (u m), Monad m)
   => ((a -> m (StT u b)) -> m (StT u b))

From 82754ad34dde3f54fd20693453ab87944cc8ae65 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 16:12:35 +0200
Subject: [PATCH 04/45] Value: unflip nvSet{,'}

---
 src/Nix.hs                    |  2 +-
 src/Nix/Builtins.hs           | 16 ++++++++--------
 src/Nix/Convert.hs            | 26 ++++++++++++++------------
 src/Nix/Effects/Derivation.hs |  6 +++---
 src/Nix/Exec.hs               |  2 +-
 src/Nix/Value.hs              | 12 ++++++------
 6 files changed, 33 insertions(+), 31 deletions(-)

diff --git a/src/Nix.hs b/src/Nix.hs
index dadaf3470..1e6885846 100644
--- a/src/Nix.hs
+++ b/src/Nix.hs
@@ -129,7 +129,7 @@ evaluateExpression mpath evaluator handler expr = do
 
   eval' = normalForm <=< nixEvalExpr mpath
 
-  argmap args = nvSet (M.fromList args) mempty
+  argmap args = nvSet mempty (M.fromList args)
 
 processResult
   :: forall e t f m a
diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 20ad6d3d5..7274afe3e 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -124,7 +124,7 @@ builtins :: (MonadNix e t f m, Scoped (NValue t f m) m)
          => m (Scopes m (NValue t f m))
 builtins =
   do
-    ref <- defer $ (`nvSet` M.empty) <$> buildMap
+    ref <- defer $ (nvSet M.empty) <$> buildMap
     lst <- ([("builtins", ref)] <>) <$> topLevelBuiltins
     pushScope (M.fromList lst) currentScopes
  where
@@ -394,7 +394,7 @@ nixPath :: MonadNix e t f m => m (NValue t f m)
 nixPath = fmap nvList $ flip foldNixPath mempty $
   \p mn ty rest ->
     pure $
-      flip nvSet
+      nvSet
         mempty
         (M.fromList
           [case ty of
@@ -1195,7 +1195,7 @@ intersectAttrs set1 set2 =
     (s1, p1) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set1
     (s2, p2) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set2
 
-    pure $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1)
+    pure $ nvSet (p2 `M.intersection` p1) (s2 `M.intersection` s1)
 
 functionArgs
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
@@ -1433,7 +1433,7 @@ listToAttrs lst =
   do
     l <- fromValue @[NValue t f m] lst
     fmap
-      ((`nvSet` M.empty) . M.fromList . reverse)
+      ((nvSet M.empty) . M.fromList . reverse)
       (forM l $
         (\ nvattrset ->
           do
@@ -1596,7 +1596,7 @@ fromJSON nvjson =
 
  where
   jsonToNValue = \case
-    A.Object m -> (`nvSet` M.empty) <$> traverse jsonToNValue m
+    A.Object m -> (nvSet M.empty) <$> traverse jsonToNValue m
     A.Array  l -> nvList <$> traverse jsonToNValue (V.toList l)
     A.String s -> pure $ nvStr $ makeNixStringWithoutContext s
     A.Number n ->
@@ -1643,12 +1643,12 @@ tryEval
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 tryEval e = catch (onSuccess <$> demand e) (pure . onError)
  where
-  onSuccess v = flip nvSet M.empty $ M.fromList
+  onSuccess v = nvSet M.empty $ M.fromList
     [ ("success", nvConstant (NBool True))
     , ("value", v)]
 
   onError :: SomeException -> NValue t f m
-  onError _ = flip nvSet M.empty $ M.fromList
+  onError _ = nvSet M.empty $ M.fromList
     [ ("success", nvConstant (NBool False))
     , ("value"  , nvConstant (NBool False))
     ]
@@ -1755,7 +1755,7 @@ getContext =
     (NVStr ns) -> do
       let context = getNixLikeContext $ toNixLikeContext $ NixString.getContext ns
       valued :: M.HashMap Text (NValue t f m) <- sequenceA $ M.map toValue context
-      pure $ nvSet valued M.empty
+      pure $ nvSet M.empty valued
     x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x) <=< demand
 
 appendContext
diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs
index 2b55ce0be..23048a09c 100644
--- a/src/Nix/Convert.hs
+++ b/src/Nix/Convert.hs
@@ -391,7 +391,7 @@ instance ( Convertible e t f m
     l' <- toValue (unPos l)
     c' <- toValue (unPos c)
     let pos = M.fromList [("file" :: Text, f'), ("line", l'), ("column", c')]
-    pure $ nvSet' pos mempty
+    pure $ nvSet' mempty pos
 
 -- | With 'ToValue', we can always act recursively
 instance Convertible e t f m
@@ -404,33 +404,35 @@ instance (Convertible e t f m, ToValue a m (NValue t f m))
 
 instance Convertible e t f m
   => ToValue (AttrSet (NValue t f m)) m (NValue' t f m (NValue t f m)) where
-  toValue s = pure $ nvSet' s mempty
+  toValue s = pure $ nvSet' mempty s
 
 instance (Convertible e t f m, ToValue a m (NValue t f m))
   => ToValue (AttrSet a) m (Deeper (NValue' t f m (NValue t f m))) where
-  toValue s = (Deeper .) . nvSet' <$> traverse toValue s <*> pure mempty
+  toValue s = (\ v s -> Deeper $ nvSet' s v) <$> (traverse (toValue) s) <*> pure mempty
 
 instance Convertible e t f m
   => ToValue (AttrSet (NValue t f m), AttrSet SourcePos) m
             (NValue' t f m (NValue t f m)) where
-  toValue (s, p) = pure $ nvSet' s p
+  toValue (s, p) = pure $ nvSet' p s
 
 instance (Convertible e t f m, ToValue a m (NValue t f m))
   => ToValue (AttrSet a, AttrSet SourcePos) m
             (Deeper (NValue' t f m (NValue t f m))) where
-  toValue (s, p) = (Deeper .) . nvSet' <$> traverse toValue s <*> pure p
+  toValue (s, p) = (\ v s -> Deeper $ nvSet' s v) <$> (traverse (toValue) s) <*> pure p
 
 instance Convertible e t f m
   => ToValue NixLikeContextValue m (NValue' t f m (NValue t f m)) where
   toValue nlcv = do
     path <-
-      if nlcvPath nlcv
-        then pure <$> toValue True
-        else pure Nothing
+      bool
+        (pure Nothing)
+        (pure <$> toValue True)
+        (nlcvPath nlcv)
     allOutputs <-
-      if nlcvAllOutputs nlcv
-        then pure <$> toValue True
-        else pure Nothing
+      bool
+        (pure Nothing)
+        (pure <$> toValue True)
+        (nlcvAllOutputs nlcv)
     outputs <- do
       let
         outputs = makeNixStringWithoutContext <$> nlcvOutputs nlcv
@@ -440,7 +442,7 @@ instance Convertible e t f m
         (pure Nothing)
         (fmap pure . toValue)
         ts
-    pure $ flip nvSet' M.empty $ M.fromList $ catMaybes
+    pure $ nvSet' M.empty $ M.fromList $ catMaybes
       [ ("path",) <$> path
       , ("allOutputs",) <$> allOutputs
       , ("outputs",) <$> outputs
diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index 9878d099a..027ed7be1 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -261,14 +261,14 @@ defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
 
     -- Memoize here, as it may be our last chance in case of readonly stores.
     drvHash <- Store.encodeInBase Store.Base16 <$> hashDerivationModulo drv'
-    modify (\(a, b) -> (a, MS.insert drvPath drvHash b))
+    modify (second (MS.insert drvPath drvHash))
 
     let outputsWithContext = Map.mapWithKey (\out path -> makeNixStringWithSingletonContext path (StringContext drvPath (DerivationOutput out))) (outputs drv')
         drvPathWithContext = makeNixStringWithSingletonContext drvPath (StringContext drvPath AllOutputs)
         attrSet = M.map nvStr $ M.fromList $ ("drvPath", drvPathWithContext): Map.toList outputsWithContext
     -- TODO: Add location information for all the entries.
     --              here --v
-    pure $ nvSet attrSet M.empty
+    pure $ nvSet M.empty attrSet
 
   where
 
@@ -328,7 +328,7 @@ buildDerivationWithContext drvAttrs = do
 
       env <- if useJson
         then do
-          jsonString :: NixString <- lift $ nvalueToJSONNixString $ flip nvSet M.empty $
+          jsonString :: NixString <- lift $ nvalueToJSONNixString $ nvSet M.empty $
             deleteKeys [ "args", "__ignoreNulls", "__structuredAttrs" ] attrs
           rawString :: Text <- extractNixString jsonString
           pure $ Map.singleton "__json" rawString
diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index e932181a0..819542a1b 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -101,7 +101,7 @@ nvSetP
   -> AttrSet (NValue t f m)
   -> AttrSet SourcePos
   -> NValue t f m
-nvSetP p s x = addProvenance p (nvSet s x)
+nvSetP p s x = addProvenance p (nvSet x s)
 
 nvClosureP
   :: MonadCited t f m
diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs
index 8c5711c85..02cc61901 100644
--- a/src/Nix/Value.hs
+++ b/src/Nix/Value.hs
@@ -381,10 +381,10 @@ nvList' = NValue . pure . NVListF
 
 -- | Haskell key-value to the Nix key-value,
 nvSet' :: Applicative f
-  => HashMap Text r
-  -> HashMap Text SourcePos
+  => HashMap Text SourcePos
+  -> HashMap Text r
   -> NValue' t f m r
-nvSet' s x = NValue $ pure $ NVSetF s x
+nvSet' x s = NValue $ pure $ NVSetF s x
 
 
 -- | Haskell closure to the Nix closure,
@@ -549,10 +549,10 @@ nvList = Free . nvList'
 
 
 nvSet :: Applicative f
-  => HashMap Text (NValue t f m)
-  -> HashMap Text SourcePos
+  => HashMap Text SourcePos
+  -> HashMap Text (NValue t f m)
   -> NValue t f m
-nvSet s x = Free $ nvSet' s x
+nvSet x s = Free $ nvSet' x s
 
 
 nvClosure :: (Applicative f, Functor m)

From 78651d4bbc05bd0cc2288ff972f9986599bc8617 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 16:44:19 +0200
Subject: [PATCH 05/45] Exec: refactor

---
 src/Nix/Exec.hs | 74 +++++++++++++++++++++++++++----------------------
 1 file changed, 41 insertions(+), 33 deletions(-)

diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index 819542a1b..8c1e9e181 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -207,6 +207,7 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
     pure $ nvConstantP (Provenance scope (NConstant_ span c)) c
 
   evalString = assembleString >=> \case
+    Nothing -> nverr $ ErrorCall "Failed to assemble string"
     Just ns -> do
       scope <- currentScopes
       span  <- currentPos
@@ -216,7 +217,6 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
           (NStr_ span (DoubleQuoted [Plain (stringIgnoreContext ns)]))
         )
         ns
-    Nothing -> nverr $ ErrorCall "Failed to assemble string"
 
   evalLiteralPath p = do
     scope <- currentScopes
@@ -248,30 +248,28 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
   evalIf c t f = do
     scope <- currentScopes
     span  <- currentPos
-    fromValue c >>= \b -> if b
-      then
-        (\t -> addProvenance
-            (Provenance scope (NIf_ span (pure c) (pure t) Nothing))
-            t
-          )
-          <$> t
-      else
-        (\f -> addProvenance
-            (Provenance scope (NIf_ span (pure c) Nothing (pure f)))
-            f
-          )
-          <$> f
-
-  evalAssert c body = fromValue c >>= \b -> do
-    span <- currentPos
-    if b
-      then do
-        scope <- currentScopes
-        (\b ->
-            addProvenance (Provenance scope (NAssert_ span (pure c) (pure b))) b
-          )
-          <$> body
-      else nverr $ Assertion span c
+    b <- fromValue c
+
+    let
+      fun x y = addProvenance (Provenance scope (NIf_ span (pure c) x y))
+
+    bool
+      ( (\ f' -> fun Nothing     (pure f') f') <$> f )
+      ( (\ t' -> fun (pure t') Nothing     t') <$> t )
+      b
+
+  evalAssert c body =
+    do
+      span <- currentPos
+      b <- fromValue c
+      if b
+        then do
+          scope <- currentScopes
+          (\b ->
+              addProvenance (Provenance scope (NAssert_ span (pure c) (pure b))) b
+            )
+            <$> body
+        else nverr $ Assertion span c
 
   evalApp f x = do
     scope <- currentScopes
@@ -282,9 +280,11 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
   evalAbs p k = do
     scope <- currentScopes
     span  <- currentPos
-    pure $ nvClosureP (Provenance scope (NAbs_ span (Nothing <$ p) Nothing))
-                      (void p)
-                      (\arg -> snd <$> k (pure arg) (\_ b -> ((), ) <$> b))
+    pure $
+      nvClosureP
+        (Provenance scope (NAbs_ span (Nothing <$ p) Nothing))
+        (void p)
+        (\arg -> snd <$> k (pure arg) (\_ b -> ((), ) <$> b))
 
   evalError = throwError
 
@@ -367,13 +367,21 @@ execBinaryOp scope span op lval rarg =
 
  where
 
-  helperEq flag = rarg >>= \rval -> valueEqM lval rval >>= boolOp rval . flag
+  helperEq flag =
+    do
+      rval <- rarg
+      eq <- valueEqM lval rval
+      boolOp rval $ flag eq
 
   helperLogic flp flag =
-    fromValue lval >>=
-      flp bool
-        (bypass flag)
-        (rarg >>= \rval -> fromValue rval >>= boolOp rval)
+    flp bool
+      (bypass flag)
+      (do
+          rval <- rarg
+          x <- fromValue rval
+          boolOp rval x
+      )
+      =<< fromValue lval
 
   boolOp rval = toBoolOp (pure rval)
 

From d869d20ba815c160b45d6d493c46c5b5360302b8 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 17:02:16 +0200
Subject: [PATCH 06/45] Exec: refactor

---
 src/Nix/Exec.hs | 159 +++++++++++++++++++++++-------------------------
 1 file changed, 75 insertions(+), 84 deletions(-)

diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index 8c1e9e181..635e90a2e 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -159,11 +159,7 @@ wrapExprLoc span x = Fix (Fix (NSym_ span "<?>") <$ x)
 -- Currently instance is stuck in orphanage between the requirements to be MonadEval, aka Eval stage, and emposed requirement to be MonadNix (Execution stage). MonadNix constraint tries to put the cart before horse and seems superflous, since Eval in Nix also needs and can throw exceptions. It is between `nverr` and `evalError`.
 instance MonadNix e t f m => MonadEval (NValue t f m) m where
   freeVariable var =
-    nverr @e @t @f
-      $  ErrorCall
-      $  "Undefined variable '"
-      <> Text.unpack var
-      <> "'"
+    nverr @e @t @f $ ErrorCall $ "Undefined variable '" <> Text.unpack var <> "'"
 
   synHole name = do
     span  <- currentPos
@@ -174,32 +170,26 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
       }
 
   attrMissing ks Nothing =
-    evalError @(NValue t f m)
-      $  ErrorCall
-      $  "Inheriting unknown attribute: "
-      <> intercalate "." (fmap Text.unpack (NE.toList ks))
+    evalError @(NValue t f m) $ ErrorCall $ "Inheriting unknown attribute: " <> intercalate "." (fmap Text.unpack (NE.toList ks))
 
   attrMissing ks (Just s) =
     evalError @(NValue t f m)
-      $  ErrorCall
-      $  "Could not look up attribute "
-      <> intercalate "." (fmap Text.unpack (NE.toList ks))
-      <> " in "
-      <> show (prettyNValue s)
+      $ ErrorCall $ "Could not look up attribute " <> intercalate "." (fmap Text.unpack (NE.toList ks)) <> " in " <> show (prettyNValue s)
 
   evalCurPos = do
     scope                  <- currentScopes
     span@(SrcSpan delta _) <- currentPos
     addProvenance @_ @_ @(NValue t f m)
-        (Provenance scope (NSym_ span "__curPos"))
+      (Provenance scope (NSym_ span "__curPos"))
       <$> toValue delta
 
   evaledSym name val = do
     scope <- currentScopes
     span  <- currentPos
-    pure $ addProvenance @_ @_ @(NValue t f m)
-      (Provenance scope (NSym_ span name))
-      val
+    pure $
+      addProvenance @_ @_ @(NValue t f m)
+        (Provenance scope (NSym_ span name))
+        val
 
   evalConstant c = do
     scope <- currentScopes
@@ -262,14 +252,16 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where
     do
       span <- currentPos
       b <- fromValue c
-      if b
-        then do
+      bool
+        (nverr $ Assertion span c)
+        (do
           scope <- currentScopes
           (\b ->
               addProvenance (Provenance scope (NAssert_ span (pure c) (pure b))) b
             )
             <$> body
-        else nverr $ Assertion span c
+        )
+        b
 
   evalApp f x = do
     scope <- currentScopes
@@ -324,16 +316,9 @@ execUnaryOp scope span op arg = do
       (NNeg, NFloat f) -> unaryOp $ NFloat (-f)
       (NNot, NBool b ) -> unaryOp $ NBool (not b)
       _ ->
-        throwError
-          $  ErrorCall
-          $  "unsupported argument type for unary operator "
-          <> show op
+        throwError $  ErrorCall $ "unsupported argument type for unary operator " <> show op
     x ->
-      throwError
-        $  ErrorCall
-        $  "argument to unary operator"
-        <> " must evaluate to an atomic type: "
-        <> show x
+      throwError $ ErrorCall $ "argument to unary operator must evaluate to an atomic type: " <> show x
  where
   unaryOp = pure . nvConstantP (Provenance scope (NUnary_ span op (pure arg)))
 
@@ -346,7 +331,7 @@ execBinaryOp
   -> NValue t f m
   -> m (NValue t f m)
   -> m (NValue t f m)
---  2021-02-25: NOTE: These are do blocks. Currently in the middle of the big rewrite, can not check their refactor. Please help.
+
 execBinaryOp scope span op lval rarg =
   case op of
     NEq   -> helperEq id
@@ -405,44 +390,49 @@ execBinaryOpForced
   -> m (NValue t f m)
 
 execBinaryOpForced scope span op lval rval = case op of
-  NLt  -> compare (<)
-  NLte -> compare (<=)
-  NGt  -> compare (>)
-  NGte -> compare (>=)
+  NLt    -> compare (<)
+  NLte   -> compare (<=)
+  NGt    -> compare (>)
+  NGte   -> compare (>=)
   NMinus -> numBinOp (-)
   NMult  -> numBinOp (*)
   NDiv   -> numBinOp' div (/)
-  NConcat -> case (lval, rval) of
-    (NVList ls, NVList rs) -> pure $ nvListP prov $ ls <> rs
-    _ -> unsupportedTypes
+  NConcat ->
+    case (lval, rval) of
+      (NVList ls, NVList rs) -> pure $ nvListP prov $ ls <> rs
+      _ -> unsupportedTypes
 
-  NUpdate -> case (lval, rval) of
-    (NVSet ls lp, NVSet rs rp) -> pure $ nvSetP prov (rs `M.union` ls) (rp `M.union` lp)
-    (NVSet ls lp, NVConstant NNull) -> pure $ nvSetP prov ls lp
-    (NVConstant NNull, NVSet rs rp) -> pure $ nvSetP prov rs rp
-    _ -> unsupportedTypes
+  NUpdate ->
+    case (lval, rval) of
+      (NVSet ls lp, NVSet rs rp) -> pure $ nvSetP prov (rs `M.union` ls) (rp `M.union` lp)
+      (NVSet ls lp, NVConstant NNull) -> pure $ nvSetP prov ls lp
+      (NVConstant NNull, NVSet rs rp) -> pure $ nvSetP prov rs rp
+      _ -> unsupportedTypes
 
-  NPlus -> case (lval, rval) of
-    (NVConstant _, NVConstant _) -> numBinOp (+)
-
-    (NVStr ls, NVStr rs) -> pure $ nvStrP prov (ls `mappend` rs)
-    (NVStr ls, rs@NVPath{}) ->
-      (\rs2 -> nvStrP prov (ls `mappend` rs2))
-        <$> coerceToString callFunc CopyToStore CoerceStringy rs
-    (NVPath ls, NVStr rs) -> case getStringNoContext rs of
-      Just rs2 -> nvPathP prov <$> makeAbsolutePath @t @f (ls `mappend` Text.unpack rs2)
-      Nothing -> throwError $ ErrorCall
-        -- data/nix/src/libexpr/eval.cc:1412
-        "A string that refers to a store path cannot be appended to a path."
-    (NVPath ls, NVPath rs) -> nvPathP prov <$> makeAbsolutePath @t @f (ls <> rs)
-
-    (ls@NVSet{}, NVStr rs) ->
-      (\ls2 -> nvStrP prov (ls2 `mappend` rs))
-        <$> coerceToString callFunc DontCopyToStore CoerceStringy ls
-    (NVStr ls, rs@NVSet{}) ->
-      (\rs2 -> nvStrP prov (ls `mappend` rs2))
-        <$> coerceToString callFunc DontCopyToStore CoerceStringy rs
-    _ -> unsupportedTypes
+  NPlus ->
+    case (lval, rval) of
+      (NVConstant _, NVConstant _) -> numBinOp (+)
+
+      (NVStr ls, NVStr rs) -> pure $ nvStrP prov (ls `mappend` rs)
+      (NVStr ls, rs@NVPath{}) ->
+        (\rs2 -> nvStrP prov (ls `mappend` rs2))
+          <$> coerceToString callFunc CopyToStore CoerceStringy rs
+      (NVPath ls, NVStr rs) ->
+        maybe
+          (throwError $ ErrorCall "A string that refers to a store path cannot be appended to a path.") -- data/nix/src/libexpr/eval.cc:1412
+          (\ rs2 ->
+             nvPathP prov <$> makeAbsolutePath @t @f (ls `mappend` Text.unpack rs2)
+          )
+          (getStringNoContext rs)
+      (NVPath ls, NVPath rs) -> nvPathP prov <$> makeAbsolutePath @t @f (ls <> rs)
+
+      (ls@NVSet{}, NVStr rs) ->
+        (\ls2 -> nvStrP prov (ls2 `mappend` rs))
+          <$> coerceToString callFunc DontCopyToStore CoerceStringy ls
+      (NVStr ls, rs@NVSet{}) ->
+        (\rs2 -> nvStrP prov (ls `mappend` rs2))
+          <$> coerceToString callFunc DontCopyToStore CoerceStringy rs
+      _ -> unsupportedTypes
 
   NEq   -> alreadyHandled
   NNEq  -> alreadyHandled
@@ -482,25 +472,19 @@ execBinaryOpForced scope span op lval rval = case op of
       _ -> unsupportedTypes
     _ -> unsupportedTypes
 
-  unsupportedTypes = throwError $ ErrorCall $
-    "Unsupported argument types for binary operator "
-      <> show op
-      <> ": "
-      <> show lval
-      <> ", "
-      <> show rval
+  unsupportedTypes = throwError $ ErrorCall $ "Unsupported argument types for binary operator " <> show op <> ": " <> show lval <> ", " <> show rval
+
+  alreadyHandled = throwError $ ErrorCall $ "This cannot happen: operator " <> show op <> " should have been handled in execBinaryOp."
 
-  alreadyHandled = throwError $ ErrorCall $
-    "This cannot happen: operator "
-      <> show op
-      <> " should have been handled in execBinaryOp."
 
 -- This function is here, rather than in 'Nix.String', because of the need to
 -- use 'throwError'.
 fromStringNoContext :: Framed e m => NixString -> m Text
-fromStringNoContext ns = case getStringNoContext ns of
-  Just str -> pure str
-  Nothing  -> throwError $ ErrorCall $ "expected string with no context, but got " <> show ns
+fromStringNoContext ns =
+  maybe
+    (throwError $ ErrorCall $ "expected string with no context, but got " <> show ns)
+    pure
+    (getStringNoContext ns)
 
 addTracing
   :: (MonadNix e t f m, Has e Options, MonadReader Int n, Alternative n)
@@ -530,12 +514,19 @@ addTracing k v = do
 evalExprLoc :: forall e t f m . MonadNix e t f m => NExprLoc -> m (NValue t f m)
 evalExprLoc expr = do
   opts :: Options <- asks (view hasLens)
-  if tracing opts
-    then join . (`runReaderT` (0 :: Int)) $ adi
-      (addTracing phi)
-      (raise (addStackFrames @(NValue t f m) . addSourcePositions))
-      expr
-    else adi phi (addStackFrames @(NValue t f m) . addSourcePositions) expr
+
+  bool
+    (adi
+      phi
+      (addStackFrames @(NValue t f m) . addSourcePositions)
+      )
+    (join . (`runReaderT` (0 :: Int)) .
+      adi
+        (addTracing phi)
+        (raise (addStackFrames @(NValue t f m) . addSourcePositions))
+        )
+    (tracing opts)
+    expr
  where
   phi = Eval.eval . annotated . getCompose
   raise k f x = ReaderT $ \e -> k (\t -> runReaderT (f t) e) x

From 2a47a8e64d9ea1c987c2cf6e3e8f16b75ff2e943 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 17:57:48 +0200
Subject: [PATCH 07/45] (mappend -> <>)

---
 src/Nix/Exec.hs         | 10 +++++-----
 src/Nix/Expr/Strings.hs |  2 +-
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index 635e90a2e..d895aa65d 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -413,24 +413,24 @@ execBinaryOpForced scope span op lval rval = case op of
     case (lval, rval) of
       (NVConstant _, NVConstant _) -> numBinOp (+)
 
-      (NVStr ls, NVStr rs) -> pure $ nvStrP prov (ls `mappend` rs)
+      (NVStr ls, NVStr rs) -> pure $ nvStrP prov (ls <> rs)
       (NVStr ls, rs@NVPath{}) ->
-        (\rs2 -> nvStrP prov (ls `mappend` rs2))
+        (\rs2 -> nvStrP prov (ls <> rs2))
           <$> coerceToString callFunc CopyToStore CoerceStringy rs
       (NVPath ls, NVStr rs) ->
         maybe
           (throwError $ ErrorCall "A string that refers to a store path cannot be appended to a path.") -- data/nix/src/libexpr/eval.cc:1412
           (\ rs2 ->
-             nvPathP prov <$> makeAbsolutePath @t @f (ls `mappend` Text.unpack rs2)
+             nvPathP prov <$> makeAbsolutePath @t @f (ls <> Text.unpack rs2)
           )
           (getStringNoContext rs)
       (NVPath ls, NVPath rs) -> nvPathP prov <$> makeAbsolutePath @t @f (ls <> rs)
 
       (ls@NVSet{}, NVStr rs) ->
-        (\ls2 -> nvStrP prov (ls2 `mappend` rs))
+        (\ls2 -> nvStrP prov (ls2 <> rs))
           <$> coerceToString callFunc DontCopyToStore CoerceStringy ls
       (NVStr ls, rs@NVSet{}) ->
-        (\rs2 -> nvStrP prov (ls `mappend` rs2))
+        (\rs2 -> nvStrP prov (ls <> rs2))
           <$> coerceToString callFunc DontCopyToStore CoerceStringy rs
       _ -> unsupportedTypes
 
diff --git a/src/Nix/Expr/Strings.hs b/src/Nix/Expr/Strings.hs
index 3476afae7..687936665 100644
--- a/src/Nix/Expr/Strings.hs
+++ b/src/Nix/Expr/Strings.hs
@@ -13,7 +13,7 @@ import qualified Data.Text                     as T
 import           Data.Tuple                     ( swap )
 import           Nix.Expr
 
--- | Merge adjacent 'Plain' values with 'mappend'.
+-- | Merge adjacent @Plain@ values with @<>@.
 mergePlain :: [Antiquoted Text r] -> [Antiquoted Text r]
 mergePlain [] = mempty
 mergePlain (Plain a : EscapedNewline : Plain b : xs) =

From b7acde766b0ff14900bace738dc03964e5b9754f Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 18:01:11 +0200
Subject: [PATCH 08/45] Exec: m refactor

---
 src/Nix/Exec.hs | 47 ++++++++++++++++++++++++-----------------------
 1 file changed, 24 insertions(+), 23 deletions(-)

diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index d895aa65d..15e2a80dc 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -288,19 +288,19 @@ callFunc
   -> NValue t f m
   -> m (NValue t f m)
 callFunc fun arg =
-  (\fun' -> do
-  frames :: Frames <- asks (view hasLens)
-  when (length frames > 2000) $ throwError $ ErrorCall "Function call stack exhausted"
-  case fun' of
-    NVClosure _params f -> do
-      f arg
-    NVBuiltin name f -> do
-      span <- currentPos
-      withFrame Info (Calling @m @(NValue t f m) name span) (f arg)
-    s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do
-      ((`callFunc` arg) <=< (`callFunc` s)) =<< demand f
-    x -> throwError $ ErrorCall $ "Attempt to call non-function: " <> show x
-  ) =<< demand fun
+  do
+    fun' <- demand fun
+    frames :: Frames <- asks (view hasLens)
+    when (length frames > 2000) $ throwError $ ErrorCall "Function call stack exhausted"
+    case fun' of
+      NVClosure _params f -> do
+        f arg
+      NVBuiltin name f -> do
+        span <- currentPos
+        withFrame Info (Calling @m @(NValue t f m) name span) (f arg)
+      s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do
+        ((`callFunc` arg) <=< (`callFunc` s)) =<< demand f
+      x -> throwError $ ErrorCall $ "Attempt to call non-function: " <> show x
 
 execUnaryOp
   :: (Framed e m, MonadCited t f m, Show t)
@@ -336,12 +336,9 @@ execBinaryOp scope span op lval rarg =
   case op of
     NEq   -> helperEq id
     NNEq  -> helperEq not
-    NOr   ->
-      helperLogic flip True
-    NAnd  ->
-      helperLogic id False
-    NImpl ->
-      helperLogic id True
+    NOr   -> helperLogic flip True
+    NAnd  -> helperLogic id   False
+    NImpl -> helperLogic id   True
     _     ->
       do
         rval <- rarg
@@ -497,14 +494,18 @@ addTracing k v = do
     v'@(Compose (Ann span x)) <- sequence v
     pure $ do
       opts :: Options <- asks (view hasLens)
-      let rendered = if verbose opts >= Chatty
+      let
+        rendered =
+          if verbose opts >= Chatty
+            then
+              pretty $
 #ifdef MIN_VERSION_pretty_show
-                     then pretty $ PS.ppShow (void x)
+                PS.ppShow (void x)
 #else
-            then pretty $ show (void x)
+                show (void x)
 #endif
             else prettyNix (Fix (Fix (NSym "?") <$ x))
-          msg x = pretty ("eval: " <> replicate depth ' ') <> x
+        msg x = pretty ("eval: " <> replicate depth ' ') <> x
       loc <- renderLocation span (msg rendered <> " ...\n")
       putStr $ show loc
       res <- k v'

From a0eba14cfaae6d8af2c34ef68b0d56e0a1a9e084 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 20:20:55 +0200
Subject: [PATCH 09/45] Effects: TOC the file structure

---
 src/Nix/Effects.hs | 281 +++++++++++++++++++++++++++------------------
 1 file changed, 172 insertions(+), 109 deletions(-)

diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs
index 86828c842..6dde88cda 100644
--- a/src/Nix/Effects.hs
+++ b/src/Nix/Effects.hs
@@ -53,15 +53,21 @@ import qualified System.Nix.StorePath          as Store
 -- | A path into the nix store
 newtype StorePath = StorePath { unStorePath :: FilePath }
 
-class (MonadFile m,
-       MonadStore m,
-       MonadPutStr m,
-       MonadHttp m,
-       MonadEnv m,
-       MonadPaths m,
-       MonadInstantiate m,
-       MonadExec m,
-       MonadIntrospect m) => MonadEffects t f m where
+-- * @class MonadEffects t f m@
+
+class
+  ( MonadFile m
+  , MonadStore m
+  , MonadPutStr m
+  , MonadHttp m
+  , MonadEnv m
+  , MonadPaths m
+  , MonadInstantiate m
+  , MonadExec m
+  , MonadIntrospect m
+  )
+  => MonadEffects t f m where
+
   -- | Determine the absolute path of relative path in the current context
   makeAbsolutePath :: FilePath -> m FilePath
   findEnvPath :: String -> m FilePath
@@ -77,15 +83,25 @@ class (MonadFile m,
 
   traceEffect :: String -> m ()
 
+
+-- ** Instances
+
 instance (MonadFix1T t m, MonadStore m) => MonadStore (Fix1T t m) where
   addToStore a b c d = lift $ addToStore a b c d
   addTextToStore' a b c d = lift $ addTextToStore' a b c d
 
-class Monad m => MonadIntrospect m where
+-- * @class MonadIntrospect m@
+
+class
+  Monad m
+  => MonadIntrospect m where
   recursiveSize :: a -> m Word
   default recursiveSize :: (MonadTrans t, MonadIntrospect m', m ~ t m') => a -> m Word
   recursiveSize = lift . recursiveSize
 
+
+-- ** Instances
+
 instance MonadIntrospect IO where
   recursiveSize =
 #ifdef MIN_VERSION_ghc_datasize
@@ -98,12 +114,21 @@ recursiveSize
     \_ -> pure 0
 #endif
 
-class Monad m => MonadExec m where
+
+-- * @class MonadExec m@
+
+class
+  Monad m
+  => MonadExec m where
+
     exec' :: [String] -> m (Either ErrorCall NExprLoc)
     default exec' :: (MonadTrans t, MonadExec m', m ~ t m')
                   => [String] -> m (Either ErrorCall NExprLoc)
     exec' = lift . exec'
 
+
+-- ** Instances
+
 instance MonadExec IO where
   exec' = \case
     []            -> pure $ Left $ ErrorCall "exec: missing program"
@@ -112,70 +137,67 @@ instance MonadExec IO where
       let t    = T.strip (T.pack out)
       let emsg = "program[" <> prog <> "] args=" <> show args
       case exitCode of
-        ExitSuccess -> if T.null t
-          then pure $ Left $ ErrorCall $ "exec has no output :" <> emsg
-          else case parseNixTextLoc t of
-            Failure err ->
-              pure
-                $  Left
-                $  ErrorCall
-                $  "Error parsing output of exec: "
-                <> show err
-                <> " "
-                <> emsg
-            Success v -> pure $ Right v
-        err ->
-          pure
-            $  Left
-            $  ErrorCall
-            $  "exec  failed: "
-            <> show err
-            <> " "
-            <> emsg
-
-class Monad m => MonadInstantiate m where
+        ExitSuccess ->
+          if T.null t
+            then pure $ Left $ ErrorCall $ "exec has no output :" <> emsg
+            else
+              case parseNixTextLoc t of
+                Failure err -> pure $ Left $ ErrorCall $ "Error parsing output of exec: " <> show err <> " " <> emsg
+                Success v -> pure $ Right v
+        err -> pure $ Left $ ErrorCall $ "exec  failed: " <> show err <> " " <> emsg
+
+
+-- * @class MonadInstantiate m@
+
+class
+  Monad m
+  => MonadInstantiate m where
+
     instantiateExpr :: String -> m (Either ErrorCall NExprLoc)
     default instantiateExpr :: (MonadTrans t, MonadInstantiate m', m ~ t m') => String -> m (Either ErrorCall NExprLoc)
     instantiateExpr = lift . instantiateExpr
 
+
+-- ** Instances
+
 instance MonadInstantiate IO where
-  instantiateExpr expr = do
-    traceM $ "Executing: " <> show
-      ["nix-instantiate", "--eval", "--expr ", expr]
-    (exitCode, out, err) <- readProcessWithExitCode "nix-instantiate"
-                                                    ["--eval", "--expr", expr]
-                                                    ""
-    case exitCode of
-      ExitSuccess -> case parseNixTextLoc (T.pack out) of
-        Failure e ->
-          pure
-            $  Left
-            $  ErrorCall
-            $  "Error parsing output of nix-instantiate: "
-            <> show e
-        Success v -> pure $ Right v
-      status ->
-        pure
-          $  Left
-          $  ErrorCall
-          $  "nix-instantiate failed: "
-          <> show status
-          <> ": "
-          <> err
 
-pathExists :: MonadFile m => FilePath -> m Bool
-pathExists = doesPathExist
+  instantiateExpr expr =
+    do
+      traceM $ "Executing: " <> show
+        ["nix-instantiate", "--eval", "--expr ", expr]
+      (exitCode, out, err) <-
+        readProcessWithExitCode
+          "nix-instantiate"
+          ["--eval", "--expr", expr]
+          ""
+      case exitCode of
+        ExitSuccess ->
+          case parseNixTextLoc (T.pack out) of
+            Failure e -> pure $ Left $ ErrorCall $ "Error parsing output of nix-instantiate: " <> show e
+            Success v -> pure $ Right v
+        status -> pure $ Left $ ErrorCall $ "nix-instantiate failed: " <> show status <> ": " <> err
+
+-- * @class MonadEnv m@
 
-class Monad m => MonadEnv m where
-    getEnvVar :: String -> m (Maybe String)
-    default getEnvVar :: (MonadTrans t, MonadEnv m', m ~ t m') => String -> m (Maybe String)
-    getEnvVar = lift . getEnvVar
-    getCurrentSystemOS :: m Text
-    default getCurrentSystemOS :: (MonadTrans t, MonadEnv m', m ~ t m') => m Text
-    getCurrentSystemOS = lift getCurrentSystemOS
-    getCurrentSystemArch :: m Text
-    default getCurrentSystemArch :: (MonadTrans t, MonadEnv m', m ~ t m') => m Text
-    getCurrentSystemArch = lift getCurrentSystemArch
+class
+  Monad m
+  => MonadEnv m where
+
+  getEnvVar :: String -> m (Maybe String)
+  default getEnvVar :: (MonadTrans t, MonadEnv m', m ~ t m') => String -> m (Maybe String)
+  getEnvVar = lift . getEnvVar
+
+  getCurrentSystemOS :: m Text
+  default getCurrentSystemOS :: (MonadTrans t, MonadEnv m', m ~ t m') => m Text
+  getCurrentSystemOS = lift getCurrentSystemOS
+
+  getCurrentSystemArch :: m Text
+  default getCurrentSystemArch :: (MonadTrans t, MonadEnv m', m ~ t m') => m Text
+  getCurrentSystemArch = lift getCurrentSystemArch
+
+
+-- ** Instances
 
 instance MonadEnv IO where
   getEnvVar            = lookupEnv
@@ -187,64 +209,87 @@ instance MonadEnv IO where
     "i386" -> "i686"
     arch   -> arch
 
-class Monad m => MonadPaths m where
-    getDataDir :: m FilePath
-    default getDataDir :: (MonadTrans t, MonadPaths m', m ~ t m') => m FilePath
-    getDataDir = lift getDataDir
+
+-- * @class MonadPaths m@
+
+class
+  Monad m
+  => MonadPaths m where
+  getDataDir :: m FilePath
+  default getDataDir :: (MonadTrans t, MonadPaths m', m ~ t m') => m FilePath
+  getDataDir = lift getDataDir
+
+
+-- ** Instances
 
 instance MonadPaths IO where
-    getDataDir = Paths_hnix.getDataDir
+  getDataDir = Paths_hnix.getDataDir
+
+
+-- * @class MonadHttp m@
 
-class Monad m => MonadHttp m where
-    getURL :: Text -> m (Either ErrorCall StorePath)
-    default getURL :: (MonadTrans t, MonadHttp m', m ~ t m') => Text -> m (Either ErrorCall StorePath)
-    getURL = lift . getURL
+class
+  Monad m
+  => MonadHttp m where
+
+  getURL :: Text -> m (Either ErrorCall StorePath)
+  default getURL :: (MonadTrans t, MonadHttp m', m ~ t m') => Text -> m (Either ErrorCall StorePath)
+  getURL = lift . getURL
+
+
+-- ** Instances
 
 instance MonadHttp IO where
   getURL url = do
     let urlstr = T.unpack url
     traceM $ "fetching HTTP URL: " <> urlstr
     req     <- parseRequest urlstr
-    manager <- if secure req
-      then newTlsManager
-      else newManager defaultManagerSettings
+    manager <-
+      if secure req
+        then newTlsManager
+        else newManager defaultManagerSettings
     -- print req
     response <- httpLbs (req { method = "GET" }) manager
     let status = statusCode (responseStatus response)
     if status /= 200
       then
-        pure
-        $  Left
-        $  ErrorCall
-        $  "fail, got "
-        <> show status
-        <> " when fetching url:"
-        <> urlstr
-      else -- do
+        pure $ Left $ ErrorCall $ "fail, got " <> show status <> " when fetching url:" <> urlstr
+      else
+        -- do
         -- let bstr = responseBody response
-        pure
-        $  Left
-        $  ErrorCall
-        $  "success in downloading but hnix-store is not yet ready; url = "
-        <> urlstr
+        pure $ Left $ ErrorCall $ "success in downloading but hnix-store is not yet ready; url = " <> urlstr
+
 
+-- * @class MonadPutStr m@
+
+class
+  Monad m
+  => MonadPutStr m where
 
-class Monad m => MonadPutStr m where
   --TODO: Should this be used *only* when the Nix to be evaluated invokes a
   --`trace` operation?
   putStr :: String -> m ()
   default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m ()
   putStr = lift . putStr
 
+
+-- ** Instances
+
+instance MonadPutStr IO where
+  putStr = Prelude.putStr
+
+
+-- ** Functions
+
 putStrLn :: MonadPutStr m => String -> m ()
 putStrLn = putStr . (<> "\n")
 
 print :: (MonadPutStr m, Show a) => a -> m ()
 print = putStrLn . show
 
-instance MonadPutStr IO where
-  putStr = Prelude.putStr
+-- * Store effects
 
+-- ** Data type synonyms
 
 type RecursiveFlag = Bool
 type RepairFlag = Bool
@@ -252,7 +297,11 @@ type StorePathName = Text
 type FilePathFilter m = FilePath -> m Bool
 type StorePathSet = HS.HashSet StorePath
 
-class Monad m => MonadStore m where
+-- ** @class MonadStore m@
+
+class
+  Monad m
+  => MonadStore m where
 
   -- | Copy the contents of a local path to the store.  The resulting store
   -- path is returned.  Note: This does not support yet support the expected
@@ -267,21 +316,21 @@ class Monad m => MonadStore m where
   default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
   addTextToStore' a b c d = lift $ addTextToStore' a b c d
 
-parseStoreResult :: Monad m => String -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a)
-parseStoreResult name res = case res of
-  (Left msg, logs) -> pure $ Left $ ErrorCall $ "Failed to execute '" <> name <> "': " <> msg <> "\n" <> show logs
-  (Right result, _) -> pure $ Right result
+
+-- ** Instances
 
 instance MonadStore IO where
 
-  addToStore name path recursive repair = case Store.makeStorePathName name of
-    Left err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> err
-    Right pathName -> do
-      -- TODO: redesign the filter parameter
-      res <- Store.Remote.runStore $ Store.Remote.addToStore @'Store.SHA256 pathName path recursive (const False) repair
-      parseStoreResult "addToStore" res >>= \case
-        Left err -> pure $ Left err
-        Right storePath -> pure $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath storePath
+  addToStore name path recursive repair =
+    case Store.makeStorePathName name of
+      Left err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> err
+      Right pathName ->
+        do
+          -- TODO: redesign the filter parameter
+          res <- Store.Remote.runStore $ Store.Remote.addToStore @'Store.SHA256 pathName path recursive (const False) repair
+          parseStoreResult "addToStore" res >>= \case
+            Left err -> pure $ Left err
+            Right storePath -> pure $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath storePath
 
   addTextToStore' name text references repair = do
     res <- Store.Remote.runStore $ Store.Remote.addTextToStore name text references repair
@@ -289,6 +338,15 @@ instance MonadStore IO where
       Left err -> pure $ Left err
       Right path -> pure $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath path
 
+
+-- ** Functions
+
+parseStoreResult :: Monad m => String -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a)
+parseStoreResult name res =
+  case res of
+    (Left msg, logs) -> pure $ Left $ ErrorCall $ "Failed to execute '" <> name <> "': " <> msg <> "\n" <> show logs
+    (Right result, _) -> pure $ Right result
+
 addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m StorePath
 addTextToStore a b c d = either throwError pure =<< addTextToStore' a b c d
 
@@ -315,3 +373,8 @@ deriving instance MonadPaths (t (Fix1T t m) m) => MonadPaths (Fix1T t m)
 deriving instance MonadInstantiate (t (Fix1T t m) m) => MonadInstantiate (Fix1T t m)
 deriving instance MonadExec (t (Fix1T t m) m) => MonadExec (Fix1T t m)
 deriving instance MonadIntrospect (t (Fix1T t m) m) => MonadIntrospect (Fix1T t m)
+
+
+-- Please, get rid of pathExists in favour of @doesPathExist@
+pathExists :: MonadFile m => FilePath -> m Bool
+pathExists = doesPathExist

From 5cf0c7bee7241e426294ceeeb79c2594c372955c Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 20:35:01 +0200
Subject: [PATCH 10/45] Effects: put derived instances into structure

---
 src/Nix/Effects.hs | 110 +++++++++++++++++++++++++++++++++++----------
 1 file changed, 87 insertions(+), 23 deletions(-)

diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs
index 6dde88cda..a1e9b1cf3 100644
--- a/src/Nix/Effects.hs
+++ b/src/Nix/Effects.hs
@@ -53,6 +53,9 @@ import qualified System.Nix.StorePath          as Store
 -- | A path into the nix store
 newtype StorePath = StorePath { unStorePath :: FilePath }
 
+
+-- All of the following type classes defer to the underlying 'm'.
+
 -- * @class MonadEffects t f m@
 
 class
@@ -86,7 +89,12 @@ class
 
 -- ** Instances
 
-instance (MonadFix1T t m, MonadStore m) => MonadStore (Fix1T t m) where
+instance
+  ( MonadFix1T t m
+  , MonadStore m
+  )
+  => MonadStore (Fix1T t m)
+ where
   addToStore a b c d = lift $ addToStore a b c d
   addTextToStore' a b c d = lift $ addTextToStore' a b c d
 
@@ -94,7 +102,8 @@ instance (MonadFix1T t m, MonadStore m) => MonadStore (Fix1T t m) where
 
 class
   Monad m
-  => MonadIntrospect m where
+  => MonadIntrospect m
+ where
   recursiveSize :: a -> m Word
   default recursiveSize :: (MonadTrans t, MonadIntrospect m', m ~ t m') => a -> m Word
   recursiveSize = lift . recursiveSize
@@ -106,14 +115,24 @@ instance MonadIntrospect IO where
   recursiveSize =
 #ifdef MIN_VERSION_ghc_datasize
 #if MIN_VERSION_ghc_datasize(0,2,0)
-recursiveSize
+    recursiveSize
 #else
-\_ -> pure 0
+      \_ -> pure 0
 #endif
 #else
-    \_ -> pure 0
+      \_ -> pure 0
 #endif
 
+deriving
+  instance
+    MonadIntrospect (t (Fix1 t))
+    => MonadIntrospect (Fix1 t)
+
+deriving
+  instance
+    MonadIntrospect (t (Fix1T t m) m)
+    => MonadIntrospect (Fix1T t m)
+
 
 -- * @class MonadExec m@
 
@@ -146,6 +165,16 @@ instance MonadExec IO where
                 Success v -> pure $ Right v
         err -> pure $ Left $ ErrorCall $ "exec  failed: " <> show err <> " " <> emsg
 
+deriving
+  instance
+    MonadExec (t (Fix1 t))
+    => MonadExec (Fix1 t)
+
+deriving
+  instance
+    MonadExec (t (Fix1T t m) m)
+    => MonadExec (Fix1T t m)
+
 
 -- * @class MonadInstantiate m@
 
@@ -178,6 +207,17 @@ instance MonadInstantiate IO where
             Success v -> pure $ Right v
         status -> pure $ Left $ ErrorCall $ "nix-instantiate failed: " <> show status <> ": " <> err
 
+deriving
+  instance
+    MonadInstantiate (t (Fix1 t))
+    => MonadInstantiate (Fix1 t)
+
+deriving
+  instance
+    MonadInstantiate (t (Fix1T t m) m)
+    => MonadInstantiate (Fix1T t m)
+
+
 -- * @class MonadEnv m@
 
 class
@@ -209,6 +249,16 @@ instance MonadEnv IO where
     "i386" -> "i686"
     arch   -> arch
 
+deriving
+  instance
+    MonadEnv (t (Fix1 t))
+    => MonadEnv (Fix1 t)
+
+deriving
+  instance
+    MonadEnv (t (Fix1T t m) m)
+    => MonadEnv (Fix1T t m)
+
 
 -- * @class MonadPaths m@
 
@@ -225,6 +275,16 @@ class
 instance MonadPaths IO where
   getDataDir = Paths_hnix.getDataDir
 
+deriving
+  instance
+    MonadPaths (t (Fix1 t))
+    => MonadPaths (Fix1 t)
+
+deriving
+  instance
+    MonadPaths (t (Fix1T t m) m)
+    => MonadPaths (Fix1T t m)
+
 
 -- * @class MonadHttp m@
 
@@ -259,6 +319,16 @@ instance MonadHttp IO where
         -- let bstr = responseBody response
         pure $ Left $ ErrorCall $ "success in downloading but hnix-store is not yet ready; url = " <> urlstr
 
+deriving
+  instance
+    MonadHttp (t (Fix1 t))
+    => MonadHttp (Fix1 t)
+
+deriving
+  instance
+    MonadHttp (t (Fix1T t m) m)
+    => MonadHttp (Fix1T t m)
+
 
 -- * @class MonadPutStr m@
 
@@ -278,6 +348,16 @@ class
 instance MonadPutStr IO where
   putStr = Prelude.putStr
 
+deriving
+  instance
+    MonadPutStr (t (Fix1 t))
+    => MonadPutStr (Fix1 t)
+
+deriving
+  instance
+    MonadPutStr (t (Fix1T t m) m)
+    => MonadPutStr (Fix1T t m)
+
 
 -- ** Functions
 
@@ -317,7 +397,7 @@ class
   addTextToStore' a b c d = lift $ addTextToStore' a b c d
 
 
--- ** Instances
+-- *** Instances
 
 instance MonadStore IO where
 
@@ -356,23 +436,7 @@ addPath p = either throwError pure =<< addToStore (T.pack $ takeFileName p) p Tr
 toFile_ :: (Framed e m, MonadStore m) => FilePath -> String -> m StorePath
 toFile_ p contents = addTextToStore (T.pack p) (T.pack contents) HS.empty False
 
--- All of the following type classes defer to the underlying 'm'.
-
-deriving instance MonadPutStr (t (Fix1 t)) => MonadPutStr (Fix1 t)
-deriving instance MonadHttp (t (Fix1 t)) => MonadHttp (Fix1 t)
-deriving instance MonadEnv (t (Fix1 t)) => MonadEnv (Fix1 t)
-deriving instance MonadPaths (t (Fix1 t)) => MonadPaths (Fix1 t)
-deriving instance MonadInstantiate (t (Fix1 t)) => MonadInstantiate (Fix1 t)
-deriving instance MonadExec (t (Fix1 t)) => MonadExec (Fix1 t)
-deriving instance MonadIntrospect (t (Fix1 t)) => MonadIntrospect (Fix1 t)
-
-deriving instance MonadPutStr (t (Fix1T t m) m) => MonadPutStr (Fix1T t m)
-deriving instance MonadHttp (t (Fix1T t m) m) => MonadHttp (Fix1T t m)
-deriving instance MonadEnv (t (Fix1T t m) m) => MonadEnv (Fix1T t m)
-deriving instance MonadPaths (t (Fix1T t m) m) => MonadPaths (Fix1T t m)
-deriving instance MonadInstantiate (t (Fix1T t m) m) => MonadInstantiate (Fix1T t m)
-deriving instance MonadExec (t (Fix1T t m) m) => MonadExec (Fix1T t m)
-deriving instance MonadIntrospect (t (Fix1T t m) m) => MonadIntrospect (Fix1T t m)
+-- * misc
 
 
 -- Please, get rid of pathExists in favour of @doesPathExist@

From 90b828ac2650e8e3423a08b367574fd875fd27c2 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 20:46:15 +0200
Subject: [PATCH 11/45] Eval: m refactor

---
 src/Nix/Eval.hs | 44 ++++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 41d5c7f74..b9a11fdd5 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -334,27 +334,31 @@ evalBinds recursive binds = do
       (gogo pathExpr)
 
   go scope (Inherit ms names pos) =
-    fmap catMaybes $ forM names $ evalSetterKeyName >=>
-      (pure . maybe
-        Nothing
-        (\ key -> pure
-          ([key]
-          , pos
-          , maybe
-              (attrMissing (key :| []) Nothing)
-              (pure <=< demand)
-              =<< maybe
-                  (withScopes scope $ lookupVar key)
-                  (\ s ->
-                    do
-                      (attrset, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< s
-
-                      clearScopes @v $ pushScope attrset $ lookupVar key
-                  )
-                  ms
-          )
+    fmap catMaybes $
+      forM
+        names
+        (pure .
+          maybe
+            Nothing
+            (\ key -> pure
+              ([key]
+              , pos
+              , maybe
+                  (attrMissing (key :| []) Nothing)
+                  (pure <=< demand)
+                  =<< maybe
+                      (withScopes scope $ lookupVar key)
+                      (\ s ->
+                        do
+                          (attrset, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< s
+
+                          clearScopes @v $ pushScope attrset $ lookupVar key
+                      )
+                      ms
+              )
+            )
+            <=< evalSetterKeyName
         )
-      )
 
   buildResult
     :: Scopes m v

From 6cf382ede36a552f7aa157765ea98f2fd4947116 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 21:30:54 +0200
Subject: [PATCH 12/45] Eval: refactor (includes (=<<) -> (<$>))

---
 src/Nix/Eval.hs | 149 +++++++++++++++++++++++++-----------------------
 1 file changed, 78 insertions(+), 71 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index b9a11fdd5..cd75afb2b 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -268,7 +268,7 @@ evalBinds
   -> m (AttrSet v, AttrSet SourcePos)
 evalBinds recursive binds = do
   scope <- currentScopes :: m (Scopes m v)
-  buildResult scope . concat =<< traverse (go scope) (moveOverridesLast binds)
+  buildResult scope . concat =<< traverse (applyBindToAdt scope) (moveOverridesLast binds)
  where
   moveOverridesLast = uncurry (<>) . partition
     (\case
@@ -276,89 +276,96 @@ evalBinds recursive binds = do
       _ -> True
     )
 
-  go :: Scopes m v -> Binding (m v) -> m [([Text], SourcePos, m v)]
-  go _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =
+  applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([Text], SourcePos, m v)]
+  applyBindToAdt _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =
     do
       (o', p') <- fromValue =<< finalValue
       -- jww (2018-05-09): What to do with the key position here?
       pure $
         (\ (k, v) ->
-            ( [k]
-            , fromMaybe pos (M.lookup k p')
-            , pure =<< demand v
-            )
+          ( [k]
+          , fromMaybe pos (M.lookup k p')
+          , pure =<< demand v
+          )
         ) <$>
         M.toList o'
 
-  go _ (NamedVar pathExpr finalValue pos) = do
-    let
-      gogo :: NAttrPath (m v) -> m ([Text], SourcePos, m v)
-      gogo =
-        \case
-          h :| t ->
-            maybe
-              (pure
-                ( mempty
-                , nullPos
-                , toValue @(AttrSet v, AttrSet SourcePos) (mempty, mempty)
-                )
-              )
-              (\ k ->
-                list
-                  (pure
-                    ( [k]
-                    , pos
-                    , finalValue
-                    )
-                  )
-                  (\ (x : xs) ->
-                    do
-                      (restOfPath, _, v) <- gogo (x :| xs)
-                      pure
-                        ( k : restOfPath
-                        , pos
-                        , v
-                        )
-                  )
-                  t
-              )
-              =<< evalSetterKeyName h
-
-    fmap
-      (\case
-        -- When there are no path segments, e.g. `${null} = 5;`, we don't
-        -- bind anything
-        ([], _, _) -> mempty
-        result     -> [result]
-      )
-      (gogo pathExpr)
+  applyBindToAdt _ (NamedVar pathExpr finalValue pos) =
+    do
+      fmap
+        (\case
+          -- When there are no path segments, e.g. `${null} = 5;`, we don't
+          -- bind anything
+          ([], _, _) -> mempty
+          result     -> [result]
+        )
+        (processAttrSetKeys pathExpr)
 
-  go scope (Inherit ms names pos) =
-    fmap catMaybes $
-      forM
-        names
-        (pure .
+   where
+    processAttrSetKeys :: NAttrPath (m v) -> m ([Text], SourcePos, m v)
+    processAttrSetKeys =
+      \case
+        h :| t ->
           maybe
-            Nothing
-            (\ key -> pure
-              ([key]
-              , pos
-              , maybe
-                  (attrMissing (key :| []) Nothing)
-                  (pure <=< demand)
-                  =<< maybe
-                      (withScopes scope $ lookupVar key)
-                      (\ s ->
-                        do
-                          (attrset, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< s
-
-                          clearScopes @v $ pushScope attrset $ lookupVar key
-                      )
-                      ms
+            (pure
+              ( mempty
+              , nullPos
+              , toValue @(AttrSet v, AttrSet SourcePos) (mempty, mempty)
               )
             )
-            <=< evalSetterKeyName
+            (\ k ->
+              list
+                -- No more keys in the attrset - return the result
+                (pure
+                  ( [k]
+                  , pos
+                  , finalValue
+                  )
+                )
+                -- There are unprocessed keys in attrset - recurse appending the results
+                (\ (x : xs) ->
+                  do
+                    (restOfPath, _, v) <- processAttrSetKeys (x :| xs)
+                    pure
+                      ( k : restOfPath
+                      , pos
+                      , v
+                      )
+                )
+                t
+            )
+            =<< evalSetterKeyName h
+
+  applyBindToAdt scope (Inherit ms names pos) =
+    catMaybes <$>
+      traverse
+        processScope
+        names
+   where
+    processScope
+      :: NKeyName (m v)
+      -> m (Maybe ([Text], SourcePos, m v))
+    processScope nkeyname =
+      maybe
+        Nothing
+        (\ key -> pure
+          ([key]
+          , pos
+          , maybe
+              (attrMissing (key :| []) Nothing)
+              (pure <=< demand)
+              =<< maybe
+                  (withScopes scope $ lookupVar key)
+                  (\ s ->
+                    do
+                      (attrset, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< s
+
+                      clearScopes @v $ pushScope attrset $ lookupVar key
+                  )
+                  ms
+          )
         )
+        <$> evalSetterKeyName nkeyname
 
   buildResult
     :: Scopes m v

From f529db9aa139cc02e2dea4ea9b836e4ba01deeb8 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 22:42:54 +0200
Subject: [PATCH 13/45] Eval: refactor

---
 src/Nix/Eval.hs | 111 ++++++++++++++++++++++++------------------------
 1 file changed, 55 insertions(+), 56 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index cd75afb2b..2f4857f42 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -58,7 +58,13 @@ class (Show v, Monad m) => MonadEval v m where
   evalAssert      :: v -> m v -> m v
   evalApp         :: v -> m v -> m v
   evalAbs         :: Params (m v)
-                  -> (forall a. m v -> (AttrSet (m v) -> m v -> m (a, v)) -> m (a, v))
+                  -> ( forall a. m v
+                    -> ( AttrSet (m v)
+                      -> m v
+                      -> m (a, v)
+                      )
+                    -> m (a, v)
+                    )
                   -> m v
 {-
   evalSelect     :: v -> NonEmpty Text -> Maybe (m v) -> m v
@@ -90,18 +96,19 @@ type MonadNixEval v m
   )
 
 data EvalFrame m v
-    = EvaluatingExpr (Scopes m v) NExprLoc
-    | ForcingExpr (Scopes m v) NExprLoc
-    | Calling String SrcSpan
-    | SynHole (SynHoleInfo m v)
-    deriving (Show, Typeable)
+  = EvaluatingExpr (Scopes m v) NExprLoc
+  | ForcingExpr (Scopes m v) NExprLoc
+  | Calling String SrcSpan
+  | SynHole (SynHoleInfo m v)
+  deriving (Show, Typeable)
 
 instance (Typeable m, Typeable v) => Exception (EvalFrame m v)
 
 data SynHoleInfo m v = SynHoleInfo
-   { _synHoleInfo_expr :: NExprLoc
-   , _synHoleInfo_scope :: Scopes m v
-   } deriving (Show, Typeable)
+  { _synHoleInfo_expr :: NExprLoc
+  , _synHoleInfo_scope :: Scopes m v
+  }
+  deriving (Show, Typeable)
 
 instance (Typeable m, Typeable v) => Exception (SynHoleInfo m v)
 
@@ -189,6 +196,7 @@ evalWithAttrSet aset body = do
   scope <- currentScopes :: m (Scopes m v)
   s     <- defer $ withScopes scope aset
   let s' = (fmap fst . fromValue @(AttrSet v, AttrSet SourcePos)) =<< demand s
+
   pushWeakScope s' body
 
 attrSetAlter
@@ -266,15 +274,34 @@ evalBinds
   => Bool
   -> [Binding (m v)]
   -> m (AttrSet v, AttrSet SourcePos)
-evalBinds recursive binds = do
-  scope <- currentScopes :: m (Scopes m v)
-  buildResult scope . concat =<< traverse (applyBindToAdt scope) (moveOverridesLast binds)
+evalBinds recursive binds =
+  do
+    scope <- currentScopes :: m (Scopes m v)
+
+    buildResult scope . concat =<< traverse (applyBindToAdt scope) (moveOverridesLast binds)
+
  where
-  moveOverridesLast = uncurry (<>) . partition
-    (\case
-      NamedVar (StaticKey "__overrides" :| []) _ _pos -> False
-      _ -> True
-    )
+  buildResult
+    :: Scopes m v
+    -> [([Text], SourcePos, m v)]
+    -> m (AttrSet v, AttrSet SourcePos)
+  buildResult scope bindings =
+    do
+      (s, p) <- foldM insert (M.empty, M.empty) bindings
+      res <-
+        bool
+          (traverse mkThunk s)
+          (loebM (encapsulate <$> s))
+          recursive
+
+      pure (res, p)
+
+   where
+    mkThunk = defer . withScopes scope
+
+    encapsulate f attrs = mkThunk . pushScope attrs $ f
+
+    insert (m, p) (path, pos, value) = attrSetAlter path pos m p value
 
   applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([Text], SourcePos, m v)]
   applyBindToAdt _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =
@@ -307,30 +334,17 @@ evalBinds recursive binds = do
       \case
         h :| t ->
           maybe
-            (pure
-              ( mempty
-              , nullPos
-              , toValue @(AttrSet v, AttrSet SourcePos) (mempty, mempty)
-              )
-            )
+            -- Empty attrset - return a stub.
+            (pure ( mempty, nullPos, toValue @(AttrSet v, AttrSet SourcePos) (mempty, mempty)) )
             (\ k ->
               list
                 -- No more keys in the attrset - return the result
-                (pure
-                  ( [k]
-                  , pos
-                  , finalValue
-                  )
-                )
+                (pure ( [k], pos, finalValue ) )
                 -- There are unprocessed keys in attrset - recurse appending the results
                 (\ (x : xs) ->
                   do
                     (restOfPath, _, v) <- processAttrSetKeys (x :| xs)
-                    pure
-                      ( k : restOfPath
-                      , pos
-                      , v
-                      )
+                    pure ( k : restOfPath, pos, v )
                 )
                 t
             )
@@ -367,27 +381,11 @@ evalBinds recursive binds = do
         )
         <$> evalSetterKeyName nkeyname
 
-  buildResult
-    :: Scopes m v
-    -> [([Text], SourcePos, m v)]
-    -> m (AttrSet v, AttrSet SourcePos)
-  buildResult scope bindings =
-    do
-      (s, p) <- foldM insert (M.empty, M.empty) bindings
-      res <-
-        bool
-          (traverse mkThunk s)
-          (loebM (encapsulate <$> s))
-          recursive
-
-      pure (res, p)
-
-   where
-    mkThunk = defer . withScopes scope
-
-    encapsulate f attrs = mkThunk . pushScope attrs $ f
-
-    insert (m, p) (path, pos, value) = attrSetAlter path pos m p value
+  moveOverridesLast = uncurry (<>) . partition
+    (\case
+      NamedVar (StaticKey "__overrides" :| []) _ _pos -> False
+      _ -> True
+    )
 
 evalSelect
   :: forall v m
@@ -406,7 +404,9 @@ evalSelect aset attr =
   extract x path@(k :| ks) =
     do
       x' <- fromValueMay x
+
       case x' of
+        Nothing -> pure $ Left (x, path)
         Just (s :: AttrSet v, p :: AttrSet SourcePos)
           | Just t <- M.lookup k s ->
             do
@@ -415,7 +415,6 @@ evalSelect aset attr =
                 (\ (y : ys) -> (extract ?? (y :| ys)) =<< demand t)
                 ks
           | otherwise -> Left . (, path) <$> toValue (s, p)
-        Nothing -> pure $ Left (x, path)
 
 -- | Evaluate a component of an attribute path in a context where we are
 -- *retrieving* a value

From a0edfaa2b5a07e60aed82e1db0d8f4aee67433db Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 22:43:13 +0200
Subject: [PATCH 14/45] Lint: refactor

---
 src/Nix/Lint.hs | 179 ++++++++++++++++++++++++++++--------------------
 1 file changed, 104 insertions(+), 75 deletions(-)

diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index b4c6fbc79..8a53f339c 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -57,14 +57,14 @@ data TAtom
   deriving (Show, Eq, Ord)
 
 data NTypeF (m :: * -> *) r
-    = TConstant [TAtom]
-    | TStr
-    | TList r
-    | TSet (Maybe (HashMap Text r))
-    | TClosure (Params ())
-    | TPath
-    | TBuiltin String (Symbolic m -> m r)
-    deriving Functor
+  = TConstant [TAtom]
+  | TStr
+  | TList r
+  | TSet (Maybe (HashMap Text r))
+  | TClosure (Params ())
+  | TPath
+  | TBuiltin String (Symbolic m -> m r)
+  deriving Functor
 
 compareTypes :: NTypeF m r -> NTypeF m r -> Ordering
 compareTypes (TConstant _)  (TConstant _)  = EQ
@@ -88,9 +88,9 @@ compareTypes _              TPath          = GT
 compareTypes (TBuiltin _ _) (TBuiltin _ _) = EQ
 
 data NSymbolicF r
-    = NAny
-    | NMany [r]
-    deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
+  = NAny
+  | NMany [r]
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
 
 type SThunk (m :: * -> *) = NThunkF m (Symbolic m)
 
@@ -101,14 +101,21 @@ data Symbolic m = SV { getSV :: SValue m } | ST { getST :: SThunk m }
 instance Show (Symbolic m) where
   show _ = "<symbolic>"
 
-everyPossible :: MonadVar m => m (Symbolic m)
+everyPossible
+  :: MonadVar m
+  => m (Symbolic m)
 everyPossible = packSymbolic NAny
 
-mkSymbolic :: MonadVar m => [NTypeF m (Symbolic m)] -> m (Symbolic m)
+mkSymbolic
+  :: MonadVar m
+  => [NTypeF m (Symbolic m)]
+  -> m (Symbolic m)
 mkSymbolic xs = packSymbolic (NMany xs)
 
 packSymbolic
-  :: MonadVar m => NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
+  :: MonadVar m
+  => NSymbolicF (NTypeF m (Symbolic m))
+  -> m (Symbolic m)
 packSymbolic = fmap SV . newVar
 
 unpackSymbolic
@@ -333,27 +340,33 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
   -- each time a name is looked up within the weak scope, and we want to be
   -- sure the action it evaluates is to force a thunk, so its value is only
   -- computed once.
-  evalWith scope body = do
-    s <- defer scope
-    pushWeakScope ?? body $
-      (unpackSymbolic >=> \case
-        NMany [TSet (Just s')] -> pure s'
-        NMany [TSet Nothing] -> error "NYI: with unknown"
-        _ -> throwError $ ErrorCall "scope must be a set in with statement"
-      ) =<< demand s
-
-  evalIf cond t f = do
-    t' <- t
-    f' <- f
-    let e = NIf cond t' f'
-    _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
-    unify (void e) t' f'
-
-  evalAssert cond body = do
-    body' <- body
-    let e = NAssert cond body'
-    _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
-    pure body'
+  evalWith scope body =
+    do
+      s <- unpackSymbolic =<< demand =<< defer scope
+
+      pushWeakScope
+        (case s of
+          NMany [TSet (Just s')] -> pure s'
+          NMany [TSet Nothing] -> error "NYI: with unknown"
+          _ -> throwError $ ErrorCall "scope must be a set in with statement"
+        )
+        body
+
+  evalIf cond t f =
+    do
+      t' <- t
+      f' <- f
+      let e = NIf cond t' f'
+
+      _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
+      unify (void e) t' f'
+
+  evalAssert cond body =
+    do
+      body' <- body
+      let e = NAssert cond body'
+      _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
+      pure body'
 
   evalApp = (fmap snd .) . lintApp (NBinary NApp () ())
   evalAbs params _ = mkSymbolic [TClosure (void params)]
@@ -367,39 +380,47 @@ lintBinaryOp
   -> Symbolic m
   -> m (Symbolic m)
   -> m (Symbolic m)
-lintBinaryOp op lsym rarg = do
-  rsym <- rarg
-  y    <- defer everyPossible
-  case op of
-    NApp    -> symerr "lintBinaryOp:NApp: should never get here"
-    NEq     -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y]
-    NNEq    -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y]
-
-    NLt     -> check lsym rsym [TConstant [TInt, TBool, TNull]]
-    NLte    -> check lsym rsym [TConstant [TInt, TBool, TNull]]
-    NGt     -> check lsym rsym [TConstant [TInt, TBool, TNull]]
-    NGte    -> check lsym rsym [TConstant [TInt, TBool, TNull]]
-
-    NAnd    -> check lsym rsym [TConstant [TBool]]
-    NOr     -> check lsym rsym [TConstant [TBool]]
-    NImpl   -> check lsym rsym [TConstant [TBool]]
-
-    -- jww (2018-04-01): NYI: Allow Path + Str
-    NPlus   -> check lsym rsym [TConstant [TInt], TStr, TPath]
-    NMinus  -> check lsym rsym [TConstant [TInt]]
-    NMult   -> check lsym rsym [TConstant [TInt]]
-    NDiv    -> check lsym rsym [TConstant [TInt]]
-
-    NUpdate -> check lsym rsym [TSet mempty]
-
-    NConcat -> check lsym rsym [TList y]
+lintBinaryOp op lsym rarg =
+  do
+    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]
+
+          NLt     -> [TConstant [TInt, TBool, TNull]]
+          NLte    -> [TConstant [TInt, TBool, TNull]]
+          NGt     -> [TConstant [TInt, TBool, TNull]]
+          NGte    -> [TConstant [TInt, TBool, TNull]]
+
+          NAnd    -> [TConstant [TBool]]
+          NOr     -> [TConstant [TBool]]
+          NImpl   -> [TConstant [TBool]]
+
+          -- jww (2018-04-01): NYI: Allow Path + Str
+          NPlus   -> [TConstant [TInt], TStr, TPath]
+          NMinus  -> [TConstant [TInt]]
+          NMult   -> [TConstant [TInt]]
+          NDiv    -> [TConstant [TInt]]
+
+          NUpdate -> [TSet mempty]
+
+          NConcat -> [TList y]
+
+          _ -> error "Should not be possible"  -- symerr or this fun signature should be changed to work in type scope
  where
-  check lsym rsym xs = do
-    let e = NBinary op lsym rsym
-    m <- mkSymbolic xs
-    _ <- unify (void e) lsym m
-    _ <- unify (void e) rsym m
-    unify (void e) lsym rsym
+  check lsym rsym xs =
+    do
+      let e = NBinary op lsym rsym
+
+      m <- mkSymbolic xs
+      _ <- unify (void e) lsym m
+      _ <- unify (void e) rsym m
+      unify (void e) lsym rsym
 
 infixl 1 `lintApp`
 lintApp
@@ -451,21 +472,29 @@ instance MonadCatch (Lint s) where
 runLintM :: Options -> Lint s a -> ST s a
 runLintM opts action = do
   i <- newVar (1 :: Int)
-  runFreshIdT i $ flip runReaderT (newContext opts) $ runLint action
+  runFreshIdT i $ (`runReaderT` newContext opts) $ runLint action
 
-symbolicBaseEnv :: Monad m => m (Scopes m (Symbolic m))
+symbolicBaseEnv
+  :: Monad m
+  => m (Scopes m (Symbolic m))
 symbolicBaseEnv = pure emptyScopes
 
 lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))
 lint opts expr =
-  runLintM opts
-    $   symbolicBaseEnv
-    >>= (`pushScopes` adi (Eval.eval . annotated . getCompose)
-                          Eval.addSourcePositions
-                          expr
+  runLintM opts $
+    do
+      basis <- symbolicBaseEnv
+
+      pushScopes
+        basis
+        (adi
+          (Eval.eval . annotated . getCompose)
+          Eval.addSourcePositions
+          expr
         )
 
-instance Scoped (Symbolic (Lint s)) (Lint s) where
+instance
+  Scoped (Symbolic (Lint s)) (Lint s) where
   currentScopes = currentScopesReader
   clearScopes   = clearScopesReader @(Lint s) @(Symbolic (Lint s))
   pushScopes    = pushScopesReader

From 1d77b585bb2f9bc8044e9aace14ec8812012d01a Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 22:43:22 +0200
Subject: [PATCH 15/45] Lint: add ApplicativeDo extention - very fit here

---
 src/Nix/Lint.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index 8a53f339c..3b8bc1b38 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -13,6 +13,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE ApplicativeDo #-}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -Wno-missing-methods #-}

From 152138e68bdc8975c87041d05ab1845532cf73b7 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 22:49:51 +0200
Subject: [PATCH 16/45] Scope: refactor

---
 src/Nix/Scope.hs | 46 +++++++++++++++++++++++++++-------------------
 1 file changed, 27 insertions(+), 19 deletions(-)

diff --git a/src/Nix/Scope.hs b/src/Nix/Scope.hs
index d3c848a44..cd1241c97 100644
--- a/src/Nix/Scope.hs
+++ b/src/Nix/Scope.hs
@@ -18,7 +18,7 @@ import           Lens.Family2
 import           Nix.Utils
 
 newtype Scope a = Scope { getScope :: AttrSet a }
-    deriving (Functor, Foldable, Traversable, Eq)
+  deriving (Functor, Foldable, Traversable, Eq)
 
 instance Show (Scope a) where
   show (Scope m) = show (M.keys m)
@@ -33,9 +33,9 @@ scopeLookup key = foldr go Nothing
   go (Scope m) rest = M.lookup key m <|> rest
 
 data Scopes m a = Scopes
-    { lexicalScopes :: [Scope a]
-    , dynamicScopes :: [m (Scope a)]
-    }
+  { lexicalScopes :: [Scope a]
+  , dynamicScopes :: [m (Scope a)]
+  }
 
 instance Show (Scopes m a) where
   show (Scopes m a) =
@@ -77,21 +77,29 @@ pushScopesReader s = local (over hasLens (s <>))
 
 lookupVarReader
   :: forall m a e . (MonadReader e m, Has e (Scopes m a)) => Text -> m (Maybe a)
-lookupVarReader k = do
-  mres <- asks (scopeLookup k . lexicalScopes @m . view hasLens)
-  case mres of
-    Just sym -> pure $ pure sym
-    Nothing  -> do
-      ws <- asks (dynamicScopes . view hasLens)
-      foldr
-        (\x rest -> do
-          mres' <- M.lookup k . getScope <$> x
-          case mres' of
-            Just sym -> pure $ pure sym
-            Nothing  -> rest
-        )
-        (pure Nothing)
-        ws
+lookupVarReader k =
+  do
+    mres <- asks (scopeLookup k . lexicalScopes @m . view hasLens)
+
+    maybe
+      (do
+        ws <- asks (dynamicScopes . view hasLens)
+
+        foldr
+          (\x rest ->
+            do
+              mres' <- M.lookup k . getScope <$> x
+
+              maybe
+                rest
+                (pure . pure)
+                mres'
+          )
+          (pure Nothing)
+          ws
+      )
+      (pure . pure)
+      mres
 
 withScopes :: Scoped a m => Scopes m a -> m r -> m r
 withScopes scope = clearScopes . pushScopes scope

From 2c3caf4b07d478e150d0e23e664640f4a3880b5b Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 22:53:48 +0200
Subject: [PATCH 17/45] Scope: m refactor

---
 src/Nix/Scope.hs | 69 +++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 53 insertions(+), 16 deletions(-)

diff --git a/src/Nix/Scope.hs b/src/Nix/Scope.hs
index cd1241c97..0a6134496 100644
--- a/src/Nix/Scope.hs
+++ b/src/Nix/Scope.hs
@@ -29,13 +29,17 @@ newScope = Scope
 scopeLookup :: Text -> [Scope a] -> Maybe a
 scopeLookup key = foldr go Nothing
  where
-  go :: Scope a -> Maybe a -> Maybe a
+  go
+    :: Scope a
+    -> Maybe a
+    -> Maybe a
   go (Scope m) rest = M.lookup key m <|> rest
 
-data Scopes m a = Scopes
-  { lexicalScopes :: [Scope a]
-  , dynamicScopes :: [m (Scope a)]
-  }
+data Scopes m a =
+  Scopes
+    { lexicalScopes :: [Scope a]
+    , dynamicScopes :: [m (Scope a)]
+    }
 
 instance Show (Scopes m a) where
   show (Scopes m a) =
@@ -53,30 +57,59 @@ emptyScopes = Scopes mempty mempty
 
 class Scoped a m | m -> a where
   currentScopes :: m (Scopes m a)
-  clearScopes :: m r -> m r
-  pushScopes :: Scopes m a -> m r -> m r
-  lookupVar :: Text -> m (Maybe a)
+  clearScopes   :: m r -> m r
+  pushScopes    :: Scopes m a -> m r -> m r
+  lookupVar     :: Text -> m (Maybe a)
 
 currentScopesReader
-  :: forall m a e . (MonadReader e m, Has e (Scopes m a)) => m (Scopes m a)
+  :: forall m a e
+  . ( MonadReader e m
+    , Has e (Scopes m a)
+    )
+  => m (Scopes m a)
 currentScopesReader = asks (view hasLens)
 
 clearScopesReader
-  :: forall m a e r . (MonadReader e m, Has e (Scopes m a)) => m r -> m r
+  :: forall m a e r
+  . ( MonadReader e m
+    , Has e (Scopes m a)
+    )
+  => m r
+  -> m r
 clearScopesReader = local (set hasLens (emptyScopes @m @a))
 
-pushScope :: Scoped a m => AttrSet a -> m r -> m r
+pushScope
+  :: Scoped a m
+  => AttrSet a
+  -> m r
+  -> m r
 pushScope s = pushScopes (Scopes [Scope s] mempty)
 
-pushWeakScope :: (Functor m, Scoped a m) => m (AttrSet a) -> m r -> m r
+pushWeakScope
+  :: ( Functor m
+     , Scoped a m
+     )
+  => m (AttrSet a)
+  -> m r
+  -> m r
 pushWeakScope s = pushScopes (Scopes mempty [Scope <$> s])
 
 pushScopesReader
-  :: (MonadReader e m, Has e (Scopes m a)) => Scopes m a -> m r -> m r
+  :: ( MonadReader e m
+     , Has e (Scopes m a)
+     )
+  => Scopes m a
+  -> m r
+  -> m r
 pushScopesReader s = local (over hasLens (s <>))
 
 lookupVarReader
-  :: forall m a e . (MonadReader e m, Has e (Scopes m a)) => Text -> m (Maybe a)
+  :: forall m a e
+  . ( MonadReader e m
+    , Has e (Scopes m a)
+    )
+  => Text
+  -> m (Maybe a)
 lookupVarReader k =
   do
     mres <- asks (scopeLookup k . lexicalScopes @m . view hasLens)
@@ -86,7 +119,7 @@ lookupVarReader k =
         ws <- asks (dynamicScopes . view hasLens)
 
         foldr
-          (\x rest ->
+          (\ x rest ->
             do
               mres' <- M.lookup k . getScope <$> x
 
@@ -101,5 +134,9 @@ lookupVarReader k =
       (pure . pure)
       mres
 
-withScopes :: Scoped a m => Scopes m a -> m r -> m r
+withScopes
+  :: Scoped a m
+  => Scopes m a
+  -> m r
+  -> m r
 withScopes scope = clearScopes . pushScopes scope

From 0412ab8f7e137092737b5715f37095b14f7a6ca4 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 23:03:44 +0200
Subject: [PATCH 18/45] (HashMap.empty -> mempty)

`empty = Empty = mempty`, mempty is inlined
---
 src/Nix/Builtins.hs           | 14 +++++++-------
 src/Nix/Convert.hs            |  2 +-
 src/Nix/Effects/Derivation.hs |  4 ++--
 src/Nix/Eval.hs               |  6 +++---
 src/Nix/Reduce.hs             |  2 +-
 src/Nix/Type/Infer.hs         |  6 +++---
 src/Nix/Type/Type.hs          | 17 ++++++++---------
 7 files changed, 25 insertions(+), 26 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 7274afe3e..44cf5d0a2 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -124,7 +124,7 @@ builtins :: (MonadNix e t f m, Scoped (NValue t f m) m)
          => m (Scopes m (NValue t f m))
 builtins =
   do
-    ref <- defer $ (nvSet M.empty) <$> buildMap
+    ref <- defer $ (nvSet mempty) <$> buildMap
     lst <- ([("builtins", ref)] <>) <$> topLevelBuiltins
     pushScope (M.fromList lst) currentScopes
  where
@@ -1311,7 +1311,7 @@ throw_ mnv =
 
 import_
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-import_ = scopedImport (nvSet M.empty M.empty)
+import_ = scopedImport (nvSet mempty mempty)
 
 scopedImport
   :: forall e t f m
@@ -1433,7 +1433,7 @@ listToAttrs lst =
   do
     l <- fromValue @[NValue t f m] lst
     fmap
-      ((nvSet M.empty) . M.fromList . reverse)
+      ((nvSet mempty) . M.fromList . reverse)
       (forM l $
         (\ nvattrset ->
           do
@@ -1596,7 +1596,7 @@ fromJSON nvjson =
 
  where
   jsonToNValue = \case
-    A.Object m -> (nvSet M.empty) <$> traverse jsonToNValue m
+    A.Object m -> (nvSet mempty) <$> traverse jsonToNValue m
     A.Array  l -> nvList <$> traverse jsonToNValue (V.toList l)
     A.String s -> pure $ nvStr $ makeNixStringWithoutContext s
     A.Number n ->
@@ -1643,12 +1643,12 @@ tryEval
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 tryEval e = catch (onSuccess <$> demand e) (pure . onError)
  where
-  onSuccess v = nvSet M.empty $ M.fromList
+  onSuccess v = nvSet mempty $ M.fromList
     [ ("success", nvConstant (NBool True))
     , ("value", v)]
 
   onError :: SomeException -> NValue t f m
-  onError _ = nvSet M.empty $ M.fromList
+  onError _ = nvSet mempty $ M.fromList
     [ ("success", nvConstant (NBool False))
     , ("value"  , nvConstant (NBool False))
     ]
@@ -1755,7 +1755,7 @@ getContext =
     (NVStr ns) -> do
       let context = getNixLikeContext $ toNixLikeContext $ NixString.getContext ns
       valued :: M.HashMap Text (NValue t f m) <- sequenceA $ M.map toValue context
-      pure $ nvSet M.empty valued
+      pure $ nvSet mempty valued
     x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x) <=< demand
 
 appendContext
diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs
index 23048a09c..0de13c949 100644
--- a/src/Nix/Convert.hs
+++ b/src/Nix/Convert.hs
@@ -442,7 +442,7 @@ instance Convertible e t f m
         (pure Nothing)
         (fmap pure . toValue)
         ts
-    pure $ nvSet' M.empty $ M.fromList $ catMaybes
+    pure $ nvSet' mempty $ M.fromList $ catMaybes
       [ ("path",) <$> path
       , ("allOutputs",) <$> allOutputs
       , ("outputs",) <$> outputs
diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index 027ed7be1..e550f67ac 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -268,7 +268,7 @@ defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
         attrSet = M.map nvStr $ M.fromList $ ("drvPath", drvPathWithContext): Map.toList outputsWithContext
     -- TODO: Add location information for all the entries.
     --              here --v
-    pure $ nvSet M.empty attrSet
+    pure $ nvSet mempty attrSet
 
   where
 
@@ -328,7 +328,7 @@ buildDerivationWithContext drvAttrs = do
 
       env <- if useJson
         then do
-          jsonString :: NixString <- lift $ nvalueToJSONNixString $ nvSet M.empty $
+          jsonString :: NixString <- lift $ nvalueToJSONNixString $ nvSet mempty $
             deleteKeys [ "args", "__ignoreNulls", "__structuredAttrs" ] attrs
           rawString :: Text <- extractNixString jsonString
           pure $ Map.singleton "__json" rawString
diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 2f4857f42..4f2c6fe39 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -213,7 +213,7 @@ attrSetAlter (k : ks) pos m p val =
   bool
     go
     (maybe
-      (recurse M.empty M.empty)
+      (recurse mempty mempty)
       (\x ->
         do
           (st, sp) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< x
@@ -236,7 +236,7 @@ attrSetAlter (k : ks) pos m p val =
     ) <$> attrSetAlter ks pos st sp val
 
 desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r]
-desugarBinds embed binds = evalState (traverse (go <=< collect) binds) M.empty
+desugarBinds embed binds = evalState (traverse (go <=< collect) binds) mempty
  where
   collect
     :: Binding r
@@ -287,7 +287,7 @@ evalBinds recursive binds =
     -> m (AttrSet v, AttrSet SourcePos)
   buildResult scope bindings =
     do
-      (s, p) <- foldM insert (M.empty, M.empty) bindings
+      (s, p) <- foldM insert (mempty, mempty) bindings
       res <-
         bool
           (traverse mkThunk s)
diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index cecf096c0..314f8c692 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -126,7 +126,7 @@ staticImport pann path = do
 reduceExpr
   :: (MonadIO m, MonadFail m) => Maybe FilePath -> NExprLoc -> m NExprLoc
 reduceExpr mpath expr =
-  (`evalStateT` (M.empty, MS.empty))
+  (`evalStateT` (mempty, MS.empty))
     . (`runReaderT` (mpath, emptyScopes))
     . runReducer
     $ foldFix reduce expr
diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index 254800a1c..36b854de2 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -540,7 +540,7 @@ instance MonadInfer m => MonadEval (Judgment s) (InferT s m) where
       pure [(name, tv)]
 
     let (env, tys) =
-          (\f -> foldl' f (As.empty, M.empty) js) $ \(as1, t1) (k, t) ->
+          (\f -> foldl' f (As.empty, mempty) js) $ \(as1, t1) (k, t) ->
             (as1 `As.merge` As.singleton k t, M.insert k t t1)
         arg   = pure $ Judgment env mempty (TSet True tys)
         call  = k arg $ \args b -> (args, ) <$> b
@@ -573,11 +573,11 @@ instance MonadInfer m
               (InferT s m) (Judgment s) where
   fromValueMay (Judgment _ _ (TSet _ xs)) = do
     let sing _ = Judgment As.empty mempty
-    pure $ pure (M.mapWithKey sing xs, M.empty)
+    pure $ pure (M.mapWithKey sing xs, mempty)
   fromValueMay _ = pure mempty
   fromValue = fromValueMay >=>
     pure . fromMaybe
-      (M.empty, M.empty)
+      (mempty, mempty)
 
 instance MonadInfer m
   => ToValue (AttrSet (Judgment s), AttrSet SourcePos)
diff --git a/src/Nix/Type/Type.hs b/src/Nix/Type/Type.hs
index 0b2ef1a0f..0a6b4f848 100644
--- a/src/Nix/Type/Type.hs
+++ b/src/Nix/Type/Type.hs
@@ -1,9 +1,10 @@
 module Nix.Type.Type where
 
-import qualified Data.HashMap.Lazy             as M
 import           Data.Text                      ( Text )
 import           Nix.Utils                      ( AttrSet )
 
+type Name = Text
+
 -- | Hindrey-Milner type interface
 
 newtype TVar = TV String
@@ -23,7 +24,7 @@ data Scheme = Forall [TVar] Type -- forall a b. a -> b
 
 -- This models a set that unifies with any other set.
 typeSet :: Type
-typeSet = TSet True M.empty
+typeSet = TSet True mempty
 
 typeList :: Type
 typeList = TList mempty
@@ -34,11 +35,9 @@ typeFun :: [Type] -> Type
 typeFun = foldr1 (:~>)
 
 typeInt, typeFloat, typeBool, typeString, typePath, typeNull :: Type
-typeInt = TCon "integer"
-typeFloat = TCon "float"
-typeBool = TCon "boolean"
+typeInt    = TCon "integer"
+typeFloat  = TCon "float"
+typeBool   = TCon "boolean"
 typeString = TCon "string"
-typePath = TCon "path"
-typeNull = TCon "null"
-
-type Name = Text
+typePath   = TCon "path"
+typeNull   = TCon "null"

From d936e9540533ac9d1529061ba4ed2d922f52c5fa Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 23:15:13 +0200
Subject: [PATCH 19/45] {Set,Map}.empty-> mempty

`empty = {Tip,Tip} = mempty`: empty is inlined
---
 src/Nix/Effects/Derivation.hs |  8 ++++----
 src/Nix/TH.hs                 | 16 ++++++++--------
 src/Nix/Type/Env.hs           |  5 ++---
 src/Nix/Type/Infer.hs         | 12 ++++++------
 4 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index e550f67ac..bb54d773b 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -69,12 +69,12 @@ data Derivation = Derivation
 defaultDerivation :: Derivation
 defaultDerivation = Derivation
   { name        = undefined
-  , outputs     = Map.empty
-  , inputs      = (Set.empty, Map.empty)
+  , outputs     = mempty
+  , inputs      = (mempty, mempty)
   , platform    = undefined
   , builder     = undefined
   , args        = mempty
-  , env         = Map.empty
+  , env         = mempty
   , mFixed      = Nothing
   , hashMode    = Flat
   , useJson     = False
@@ -278,7 +278,7 @@ defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
       name <- makeStorePathName (Store.unStorePathName n <> if o == "out" then "" else "-" <> o)
       pure $ pathToText $ Store.makeStorePath "/nix/store" ("output:" <> Text.encodeUtf8 o) h name
 
-    toStorePaths ctx = foldl (flip addToInputs) (Set.empty, Map.empty) ctx
+    toStorePaths ctx = foldl (flip addToInputs) (mempty, mempty) ctx
     addToInputs (StringContext path kind) = case kind of
       DirectPath -> first (Set.insert path)
       DerivationOutput o -> second (Map.insertWith (<>) path [o])
diff --git a/src/Nix/TH.hs b/src/Nix/TH.hs
index 5661ecec2..b1a7c93d3 100644
--- a/src/Nix/TH.hs
+++ b/src/Nix/TH.hs
@@ -44,20 +44,20 @@ quoteExprPat s = do
 
 freeVars :: NExpr -> Set VarName
 freeVars e = case unFix e of
-  (NConstant    _       ) -> Set.empty
+  (NConstant    _       ) -> mempty
   (NStr         string  ) -> foldMap freeVars string
   (NSym         var     ) -> Set.singleton var
   (NList        list    ) -> foldMap freeVars list
   (NSet NNonRecursive bindings) -> foldMap bindFree bindings
   (NSet NRecursive bindings) -> foldMap bindFree bindings \\ foldMap bindDefs bindings
-  (NLiteralPath _       ) -> Set.empty
-  (NEnvPath     _       ) -> Set.empty
+  (NLiteralPath _       ) -> mempty
+  (NEnvPath     _       ) -> mempty
   (NUnary _ expr        ) -> freeVars expr
   (NBinary _ left right ) -> freeVars left `Set.union` freeVars right
   (NSelect expr path orExpr) ->
     freeVars expr
       `Set.union` pathFree path
-      `Set.union` maybe Set.empty freeVars orExpr
+      `Set.union` maybe mempty freeVars orExpr
   (NHasAttr expr            path) -> freeVars expr `Set.union` pathFree path
   (NAbs     (Param varname) expr) -> Set.delete varname (freeVars expr)
   (NAbs (ParamSet set _ varname) expr) ->
@@ -65,7 +65,7 @@ freeVars e = case unFix e of
     freeVars expr
       `Set.union` Set.unions (mapMaybe (fmap freeVars . snd) set)
     -- But remove the argument name if existing, and all arguments in the parameter set
-      \\          maybe Set.empty Set.singleton varname
+      \\          maybe mempty Set.singleton varname
       \\          Set.fromList (fmap fst set)
   (NLet bindings expr) ->
     freeVars expr
@@ -77,7 +77,7 @@ freeVars e = case unFix e of
   -- This also makes sense because its value can be overridden by `x: with y; x`
   (NWith   set       expr) -> freeVars set `Set.union` freeVars expr
   (NAssert assertion expr) -> freeVars assertion `Set.union` freeVars expr
-  (NSynHole _            ) -> Set.empty
+  (NSynHole _            ) -> mempty
 
  where
 
@@ -86,10 +86,10 @@ freeVars e = case unFix e of
   staticKey (DynamicKey _      ) = mempty
 
   bindDefs :: Binding r -> Set VarName
-  bindDefs (Inherit  Nothing                   _    _) = Set.empty
+  bindDefs (Inherit  Nothing                   _    _) = mempty
   bindDefs (Inherit (Just _) keys _) = Set.fromList $ mapMaybe staticKey keys
   bindDefs (NamedVar (StaticKey  varname :| _) _    _) = Set.singleton varname
-  bindDefs (NamedVar (DynamicKey _       :| _) _    _) = Set.empty
+  bindDefs (NamedVar (DynamicKey _       :| _) _    _) = mempty
 
   bindFree :: Binding NExpr -> Set VarName
   bindFree (Inherit Nothing keys _) = Set.fromList $ mapMaybe staticKey keys
diff --git a/src/Nix/Type/Env.hs b/src/Nix/Type/Env.hs
index 1c3d451d2..c7b6719ee 100644
--- a/src/Nix/Type/Env.hs
+++ b/src/Nix/Type/Env.hs
@@ -21,15 +21,14 @@ import           Nix.Type.Type
 import           Data.Foldable                  ( foldl' )
 import qualified Data.Map                      as Map
 
----------------------------------------------------------------------------------
+
 -- * Typing Environment
----------------------------------------------------------------------------------
 
 newtype Env = TypeEnv { types :: Map.Map Name [Scheme] }
   deriving (Eq, Show)
 
 empty :: Env
-empty = TypeEnv Map.empty
+empty = TypeEnv mempty
 
 extend :: Env -> (Name, [Scheme]) -> Env
 extend env (x, s) = env { types = Map.insert x s (types env) }
diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index 36b854de2..ff5e739cd 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -155,7 +155,7 @@ class FreeTypeVars a where
   ftv :: a -> Set.Set TVar
 
 instance FreeTypeVars Type where
-  ftv TCon{}      = Set.empty
+  ftv TCon{}      = mempty
   ftv (TVar a   ) = Set.singleton a
   ftv (TSet _ a ) = Set.unions (fmap ftv (M.elems a))
   ftv (TList a  ) = Set.unions (fmap ftv a)
@@ -169,10 +169,10 @@ instance FreeTypeVars Scheme where
   ftv (Forall as t) = ftv t `Set.difference` Set.fromList as
 
 instance FreeTypeVars a => FreeTypeVars [a] where
-  ftv = foldr (Set.union . ftv) Set.empty
+  ftv = foldr (Set.union . ftv) mempty
 
 instance (Ord a, FreeTypeVars a) => FreeTypeVars (Set.Set a) where
-  ftv = foldr (Set.union . ftv) Set.empty
+  ftv = foldr (Set.union . ftv) mempty
 
 
 class ActiveTypeVars a where
@@ -185,7 +185,7 @@ instance ActiveTypeVars Constraint where
   atv (ExpInstConst t s) = ftv t `Set.union` ftv s
 
 instance ActiveTypeVars a => ActiveTypeVars [a] where
-  atv = foldr (Set.union . atv) Set.empty
+  atv = foldr (Set.union . atv) mempty
 
 data TypeError
   = UnificationFail Type Type
@@ -222,7 +222,7 @@ runInfer' :: MonadInfer m => InferT s m a -> m (Either InferError a)
 runInfer' =
   runExceptT
     . (`evalStateT` initInfer)
-    . (`runReaderT` (Set.empty, emptyScopes))
+    . (`runReaderT` (mempty, emptyScopes))
     . getInfer
 
 runInfer :: (forall s . InferT s (FreshIdT Int (ST s)) a) -> Either InferError a
@@ -260,7 +260,7 @@ inferExpr env ex = case runInfer (inferType env ex) of
 
 -- | Canonicalize and return the polymorphic toplevel type.
 closeOver :: Type -> Scheme
-closeOver = normalizeScheme . generalize Set.empty
+closeOver = normalizeScheme . generalize mempty
 
 extendMSet :: Monad m => TVar -> InferT s m a -> InferT s m a
 extendMSet x = InferT . local (first (Set.insert x)) . getInfer

From 0155454b33224cec49e99a963bf0757cf8d058b3 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 23:24:16 +0200
Subject: [PATCH 20/45] Expr.Types: Alternative.empty -> mempty, it is used for
 []

---
 src/Nix/Expr/Types.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs
index 7aec636c2..0467801a2 100644
--- a/src/Nix/Expr/Types.hs
+++ b/src/Nix/Expr/Types.hs
@@ -30,7 +30,6 @@ module Nix.Expr.Types where
 import qualified Codec.Serialise                as Serialise
 import           Codec.Serialise                ( Serialise )
 #endif
-import           Control.Applicative
 import           Control.DeepSeq
 import           Control.Monad
 import           Data.Aeson
@@ -123,8 +122,9 @@ data Params r
   --
   -- > ParamSet [("x",Nothing)] False Nothing     ~  { x }
   -- > ParamSet [("x",pure y)]  True  (pure "s")  ~  s@{ x ? y, ... }
-  deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor, Show,
-            Foldable, Traversable, NFData, Hashable)
+  deriving
+    (Ord, Eq, Generic, Generic1, Typeable, Data, NFData, Hashable, Show,
+    Functor, Foldable, Traversable)
 
 instance Hashable1 Params
 
@@ -649,7 +649,7 @@ ekey keys pos f e@(Fix x) | (NSet NNonRecursive xs, ann) <- fromNExpr x =
         let keys' = NE.toList keys
         (ks, rest) <- zip (inits keys') (tails keys')
         list
-          empty
+          mempty
           (\ (j : js) ->
             do
               NamedVar ns v _p <- xs

From d5d853db3b8067cfeb6aa0170829fe3c1990ee96 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 23:44:40 +0200
Subject: [PATCH 21/45] Effects: m refactor

---
 src/Nix/Effects.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs
index a1e9b1cf3..7973eea59 100644
--- a/src/Nix/Effects.hs
+++ b/src/Nix/Effects.hs
@@ -193,19 +193,21 @@ instance MonadInstantiate IO where
 
   instantiateExpr expr =
     do
-      traceM $ "Executing: " <> show
-        ["nix-instantiate", "--eval", "--expr ", expr]
+      traceM $
+        "Executing: " <> show ["nix-instantiate", "--eval", "--expr ", expr]
+
       (exitCode, out, err) <-
         readProcessWithExitCode
           "nix-instantiate"
           ["--eval", "--expr", expr]
           ""
-      case exitCode of
+
+      pure $ case exitCode of
         ExitSuccess ->
           case parseNixTextLoc (T.pack out) of
-            Failure e -> pure $ Left $ ErrorCall $ "Error parsing output of nix-instantiate: " <> show e
-            Success v -> pure $ Right v
-        status -> pure $ Left $ ErrorCall $ "nix-instantiate failed: " <> show status <> ": " <> err
+            Failure e -> Left $ ErrorCall $ "Error parsing output of nix-instantiate: " <> show e
+            Success v -> Right v
+        status -> Left $ ErrorCall $ "nix-instantiate failed: " <> show status <> ": " <> err
 
 deriving
   instance

From 2b658fb96629e3189197362e4eeccebf82115729 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Mon, 8 Mar 2021 23:44:58 +0200
Subject: [PATCH 22/45] Parser: parseFromText: (=<< -> <$>)

---
 src/Nix/Parser.hs | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index 4447b9911..cc8791717 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -528,6 +528,7 @@ reservedNames = HashSet.fromList
 
 type Parser = ParsecT Void Text (State SourcePos)
 
+-- This is just a @Either (Doc Void) a@
 data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
 
 parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a)
@@ -540,10 +541,11 @@ parseFromFileEx p path = do
 
 parseFromText :: Parser a -> Text -> Result a
 parseFromText p txt =
-  let file = "<string>"
-  in  either (Failure . pretty . errorBundlePretty) Success
-        . flip evalState (initialPos file)
-        $ runParserT p file txt
+  let file = "<string>" in
+  either
+    (Failure . pretty . errorBundlePretty)
+    Success
+    $ (`evalState` initialPos file) $ (`runParserT` file) p txt
 
 {- Parser.Operators -}
 
@@ -560,11 +562,12 @@ data NOperatorDef
   deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
 
 annotateLocation :: Parser a -> Parser (Ann SrcSpan a)
-annotateLocation p = do
-  begin <- getSourcePos
-  res   <- p
-  end   <- get -- The state set before the last whitespace
-  pure $ Ann (SrcSpan begin end) res
+annotateLocation p =
+  do
+    begin <- getSourcePos
+    end   <- get -- The state set before the last whitespace
+
+    Ann (SrcSpan begin end) <$> p
 
 annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc
 annotateLocation1 = fmap annToAnnF . annotateLocation

From 9c4d123a1267f5fac78f9aea2185d15bbe09a39c Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 00:55:39 +0200
Subject: [PATCH 23/45] Parser: refactor

---
 src/Nix/Parser.hs | 329 ++++++++++++++++++++++++----------------------
 1 file changed, 175 insertions(+), 154 deletions(-)

diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index cc8791717..bc2f52b8e 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -110,17 +110,28 @@ selDot :: Parser ()
 selDot = try (symbol "." *> notFollowedBy nixPath) <?> "."
 
 nixSelect :: Parser NExprLoc -> Parser NExprLoc
-nixSelect term = do
-  res <- build <$> term <*> optional
-    ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixTerm))
-  continues <- optional $ lookAhead selDot
-  case continues of
-    Nothing -> pure res
-    Just _  -> nixSelect (pure res)
+nixSelect term =
+  do
+    res <-
+      build
+      <$> term
+      <*> optional
+        ( (,)
+        <$> (selDot *> nixSelector)
+        <*> optional (reserved "or" *> nixTerm)
+        )
+    continues <- optional $ lookAhead selDot
+
+    maybe
+      (pure res)
+      (const $ nixSelect (pure res))
+      continues
  where
   build
     :: NExprLoc
-    -> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc)
+    -> Maybe ( Ann SrcSpan (NAttrPath NExprLoc)
+        , Maybe NExprLoc
+        )
     -> NExprLoc
   build t Nothing       = t
   build t (Just (s, o)) = nSelectLoc t s o
@@ -133,23 +144,7 @@ nixSelector = annotateLocation $ do
 nixTerm :: Parser NExprLoc
 nixTerm = do
   c <- try $ lookAhead $ satisfy $ \x ->
-    pathChar x
-      || x
-      == '('
-      || x
-      == '{'
-      || x
-      == '['
-      || x
-      == '<'
-      || x
-      == '/'
-      || x
-      == '"'
-      || x
-      == '\''
-      || x
-      == '^'
+    pathChar x || (`elem` ("({[</\"'^" :: String)) x
   case c of
     '('  -> nixSelect nixParens
     '{'  -> nixSelect nixSet
@@ -191,7 +186,8 @@ nixFloat =
 nixBool :: Parser NExprLoc
 nixBool =
   annotateLocation1 (bool "true" True <+> bool "false" False) <?> "bool"
-  where bool str b = mkBoolF b <$ reserved str
+ where
+  bool str b = mkBoolF b <$ reserved str
 
 nixNull :: Parser NExprLoc
 nixNull = annotateLocation1 (mkNullF <$ reserved "null" <?> "null")
@@ -207,25 +203,14 @@ nixList = annotateLocation1 (brackets (NList <$> many nixTerm) <?> "list")
 
 pathChar :: Char -> Bool
 pathChar x =
-  isAlpha x
-    || isDigit x
-    || x
-    == '.'
-    || x
-    == '_'
-    || x
-    == '-'
-    || x
-    == '+'
-    || x
-    == '~'
+  isAlpha x || isDigit x || (`elem` ("._-+~" :: String)) x
 
 slash :: Parser Char
 slash =
   try
-      (  char '/'
-      <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x))
-      )
+    (  char '/'
+    <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x))
+    )
     <?> "slash"
 
 -- | A path surrounded by angle brackets, indicating that it should be
@@ -350,7 +335,9 @@ nixString' = lexeme (doubleQuoted <+> indented <?> "string")
 
 -- | Gets all of the arguments for a function.
 argExpr :: Parser (Params NExprLoc)
-argExpr = msum [atLeft, onlyname, atRight] <* symbol ":" where
+argExpr =
+  msum [atLeft, onlyname, atRight] <* symbol ":"
+ where
   -- An argument not in curly braces. There's some potential ambiguity
   -- 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
@@ -362,55 +349,65 @@ argExpr = msum [atLeft, onlyname, atRight] <* symbol ":" where
       ]
 
   -- Parameters named by an identifier on the left (`args @ {x, y}`)
-  atLeft = try $ do
-    name               <- identifier <* symbol "@"
-    (variadic, params) <- params
-    pure $ ParamSet params variadic (pure name)
+  atLeft =
+    try $
+      do
+        name               <- identifier <* symbol "@"
+        (variadic, params) <- params
+        pure $ ParamSet params variadic (pure name)
 
   -- Parameters named by an identifier on the right, or none (`{x, y} @ args`)
-  atRight = do
-    (variadic, params) <- params
-    name               <- optional $ symbol "@" *> identifier
-    pure $ ParamSet params variadic name
+  atRight =
+    do
+      (variadic, params) <- params
+      name               <- optional $ symbol "@" *> identifier
+      pure $ ParamSet params variadic name
 
   -- Return the parameters set.
-  params = do
-    (args, dotdots) <- braces getParams
-    pure (dotdots, args)
+  params =
+    do
+      (args, dotdots) <- braces getParams
+      pure (dotdots, args)
 
   -- Collects the parameters within curly braces. Returns the parameters and
   -- a boolean indicating if the parameters are variadic.
   getParams :: Parser ([(Text, Maybe NExprLoc)], Bool)
-  getParams = go mempty   where
+  getParams = go mempty
+   where
     -- Attempt to parse `...`. If this succeeds, stop and return True.
     -- Otherwise, attempt to parse an argument, optionally with a
     -- default. If this fails, then return what has been accumulated
     -- so far.
     go acc = ((acc, True) <$ symbol "...") <+> getMore acc
+
     getMore acc =
       -- Could be nothing, in which just return what we have so far.
-                  option (acc, False) $ do
-        -- Get an argument name and an optional default.
-      pair <- liftM2 (,) identifier (optional $ question *> nixToplevelForm)
-      -- Either return this, or attempt to get a comma and restart.
-      option (acc <> [pair], False) $ comma *> go (acc <> [pair])
+      option (acc, False) $
+        do
+          -- Get an argument name and an optional default.
+          pair <- liftM2 (,) identifier (optional $ question *> nixToplevelForm)
+
+          -- Either return this, or attempt to get a comma and restart.
+          option (acc <> [pair], False) $ comma *> go (acc <> [pair])
 
 nixBinders :: Parser [Binding NExprLoc]
 nixBinders = (inherit <+> namedVar) `endBy` semi where
-  inherit = do
-      -- We can't use 'reserved' here because it would consume the whitespace
-      -- after the keyword, which is not exactly the semantics of C++ Nix.
-    try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))
-    p <- getSourcePos
-    x <- whiteSpace *> optional scope
-    Inherit x <$> many keyName <*> pure p <?> "inherited binding"
-  namedVar = do
-    p <- getSourcePos
-    NamedVar
-      <$> (annotated <$> nixSelector)
-      <*> (equals *> nixToplevelForm)
-      <*> pure p
-      <?> "variable binding"
+  inherit =
+    do
+        -- We can't use 'reserved' here because it would consume the whitespace
+        -- after the keyword, which is not exactly the semantics of C++ Nix.
+      try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))
+      p <- getSourcePos
+      x <- whiteSpace *> optional scope
+      Inherit x <$> many keyName <*> pure p <?> "inherited binding"
+  namedVar =
+    do
+      p <- getSourcePos
+      NamedVar
+        <$> (annotated <$> nixSelector)
+        <*> (equals *> nixToplevelForm)
+        <*> pure p
+        <?> "variable binding"
   scope = nixParens <?> "inherit scope"
 
 keyName :: Parser (NKeyName NExprLoc)
@@ -420,7 +417,8 @@ keyName = dynamicKey <+> staticKey where
 
 nixSet :: Parser NExprLoc
 nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set")
-  where isRec = (reserved "rec" $> NSet NRecursive <?> "recursive set") <+> pure (NSet NNonRecursive)
+ where
+  isRec = (reserved "rec" $> NSet NRecursive <?> "recursive set") <+> pure (NSet NNonRecursive)
 
 parseNixFile :: MonadFile m => FilePath -> m (Result NExpr)
 parseNixFile =
@@ -439,8 +437,8 @@ parseNixTextLoc = parseFromText (whiteSpace *> nixToplevelForm <* eof)
 {- Parser.Library -}
 
 skipLineComment' :: Tokens Text -> Parser ()
-skipLineComment' prefix = string prefix
-  *> void (takeWhileP (pure "character") (\x -> x /= '\n' && x /= '\r'))
+skipLineComment' prefix =
+  string prefix *> void (takeWhileP (pure "character") (\x -> x /= '\n' && x /= '\r'))
 
 whiteSpace :: Parser ()
 whiteSpace = do
@@ -458,31 +456,8 @@ symbol = lexeme . string
 
 reservedEnd :: Char -> Bool
 reservedEnd x =
-  isSpace x
-    || x
-    == '{'
-    || x
-    == '('
-    || x
-    == '['
-    || x
-    == '}'
-    || x
-    == ')'
-    || x
-    == ']'
-    || x
-    == ';'
-    || x
-    == ':'
-    || x
-    == '.'
-    || x
-    == '"'
-    || x
-    == '\''
-    || x
-    == ','
+  isSpace x || (`elem` ("{([})];:.\"'," :: String)) x
+{-# inline reservedEnd #-}
 
 reserved :: Text -> Parser ()
 reserved n =
@@ -505,15 +480,15 @@ identifier = lexeme $ try $ do
 -- Braces and angles in hnix don't enclose a single expression so this type
 -- restriction would not be useful.
 parens, brackets :: Parser (NExprF f) -> Parser (NExprF f)
-parens = between (symbol "(") (symbol ")")
-braces = between (symbol "{") (symbol "}")
+parens   = between (symbol "(") (symbol ")")
+braces   = between (symbol "{") (symbol "}")
 -- angles    = between (symbol "<") (symbol ">")
 brackets = between (symbol "[") (symbol "]")
-semi = symbol ";"
-comma = symbol ","
+semi     = symbol ";"
+comma    = symbol ","
 -- colon     = symbol ":"
 -- dot       = symbol "."
-equals = symbol "="
+equals   = symbol "="
 question = symbol "?"
 
 integer :: Parser Integer
@@ -532,12 +507,15 @@ type Parser = ParsecT Void Text (State SourcePos)
 data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
 
 parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a)
-parseFromFileEx p path = do
-  txt <- decodeUtf8 <$> readFile path
-  pure
-    $ either (Failure . pretty . errorBundlePretty) Success
-    . flip evalState (initialPos path)
-    $ runParserT p path txt
+parseFromFileEx p path =
+  do
+    txt <- decodeUtf8 <$> readFile path
+
+    pure $
+      either
+        (Failure . pretty . errorBundlePretty)
+        Success
+        $ (`evalState` initialPos path) $ runParserT p path txt
 
 parseFromText :: Parser a -> Text -> Result a
 parseFromText p txt =
@@ -574,17 +552,26 @@ annotateLocation1 = fmap annToAnnF . annotateLocation
 
 manyUnaryOp f = foldr1 (.) <$> some f
 
-operator "-" = lexeme . try $ string "-" <* notFollowedBy (char '>')
-operator "/" = lexeme . try $ string "/" <* notFollowedBy (char '/')
-operator "<" = lexeme . try $ string "<" <* notFollowedBy (char '=')
-operator ">" = lexeme . try $ string ">" <* notFollowedBy (char '=')
-operator n   = symbol n
+operator op =
+  case op of
+    "-" -> tuneLexer "-" '>'
+    "/" -> tuneLexer "/" '/'
+    "<" -> tuneLexer "<" '='
+    ">" -> tuneLexer ">" '='
+    n   -> symbol n
+ where
+  tuneLexer opchar nonextchar =
+    lexeme . try $ string opchar <* notFollowedBy (char nonextchar)
 
 opWithLoc :: Text -> o -> (Ann SrcSpan o -> a) -> Parser a
-opWithLoc name op f = do
-  Ann ann _ <- annotateLocation $ {- dbg (unpack name) $ -}
-                                  operator name
-  pure $ f (Ann ann op)
+opWithLoc name op f =
+  do
+    Ann ann _ <-
+      annotateLocation $
+        {- dbg (unpack name) $ -}
+        operator name
+
+    pure $ f (Ann ann op)
 
 binaryN name op =
   (NBinaryDef name op NAssocNone, InfixN (opWithLoc name op nBinary))
@@ -616,37 +603,47 @@ nixOperators selector =
     {-  2 -}
     [ ( NBinaryDef " " NApp NAssocLeft
       ,
-                -- Thanks to Brent Yorgey for showing me this trick!
+        -- Thanks to Brent Yorgey for showing me this trick!
         InfixL $ nApp <$ symbol ""
       )
     ]
   , {-  3 -}
-    [prefix "-" NNeg]
+    [ prefix  "-"  NNeg ]
   , {-  4 -}
     [ ( NSpecialDef "?" NHasAttrOp NAssocLeft
       , Postfix $ symbol "?" *> (flip nHasAttr <$> selector)
       )
     ]
   , {-  5 -}
-    [binaryR "++" NConcat]
+    [ binaryR "++" NConcat ]
   , {-  6 -}
-    [binaryL "*" NMult, binaryL "/" NDiv]
+    [ binaryL "*"  NMult
+    , binaryL "/"  NDiv
+    ]
   , {-  7 -}
-    [binaryL "+" NPlus, binaryL "-" NMinus]
+    [ binaryL "+"  NPlus
+    , binaryL "-"  NMinus
+    ]
   , {-  8 -}
-    [prefix "!" NNot]
+    [ prefix  "!"  NNot ]
   , {-  9 -}
-    [binaryR "//" NUpdate]
+    [ binaryR "//" NUpdate ]
   , {- 10 -}
-    [binaryL "<" NLt, binaryL ">" NGt, binaryL "<=" NLte, binaryL ">=" NGte]
+    [ binaryL "<"  NLt
+    , binaryL ">"  NGt
+    , binaryL "<=" NLte
+    , binaryL ">=" NGte
+    ]
   , {- 11 -}
-    [binaryN "==" NEq, binaryN "!=" NNEq]
+    [ binaryN "==" NEq
+    , binaryN "!=" NNEq
+    ]
   , {- 12 -}
-    [binaryL "&&" NAnd]
+    [ binaryL "&&" NAnd ]
   , {- 13 -}
-    [binaryL "||" NOr]
+    [ binaryL "||" NOr ]
   , {- 14 -}
-    [binaryR "->" NImpl]
+    [ binaryR "->" NImpl ]
   ]
 
 data OperatorInfo = OperatorInfo
@@ -656,29 +653,53 @@ data OperatorInfo = OperatorInfo
   } deriving (Eq, Ord, Generic, Typeable, Data, Show)
 
 getUnaryOperator :: NUnaryOp -> OperatorInfo
-getUnaryOperator = (m Map.!) where
-  m = Map.fromList $ concat $ zipWith buildEntry
-                                      [1 ..]
-                                      (nixOperators (error "unused"))
-  buildEntry i = concatMap $ \case
-    (NUnaryDef name op, _) -> [(op, OperatorInfo i NAssocNone name)]
-    _                      -> mempty
+getUnaryOperator = (m Map.!)
+ where
+  m =
+    Map.fromList $
+      concat $
+        zipWith
+          buildEntry
+          [1 ..]
+          (nixOperators (error "unused"))
+
+  buildEntry i =
+    concatMap $
+      \case
+        (NUnaryDef name op, _) -> [(op, OperatorInfo i NAssocNone name)]
+        _                      -> mempty
 
 getBinaryOperator :: NBinaryOp -> OperatorInfo
-getBinaryOperator = (m Map.!) where
-  m = Map.fromList $ concat $ zipWith buildEntry
-                                      [1 ..]
-                                      (nixOperators (error "unused"))
-  buildEntry i = concatMap $ \case
-    (NBinaryDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
-    _                             -> mempty
+getBinaryOperator = (m Map.!)
+ where
+  m =
+    Map.fromList $
+      concat $
+        zipWith
+          buildEntry
+          [1 ..]
+          (nixOperators (error "unused"))
+
+  buildEntry i =
+    concatMap $
+      \case
+        (NBinaryDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
+        _                             -> mempty
 
 getSpecialOperator :: NSpecialOp -> OperatorInfo
 getSpecialOperator NSelectOp = OperatorInfo 1 NAssocLeft "."
-getSpecialOperator o         = m Map.! o where
-  m = Map.fromList $ concat $ zipWith buildEntry
-                                      [1 ..]
-                                      (nixOperators (error "unused"))
-  buildEntry i = concatMap $ \case
-    (NSpecialDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
-    _                              -> mempty
+getSpecialOperator o         = m Map.! o
+ where
+  m =
+    Map.fromList $
+      concat $
+        zipWith
+          buildEntry
+          [1 ..]
+          (nixOperators (error "unused"))
+
+  buildEntry i =
+    concatMap $
+      \case
+        (NSpecialDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
+        _                              -> mempty

From bb1ebbaa6c90a3d7920f94fc3ae73b50216a6e0d Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 01:56:30 +0200
Subject: [PATCH 24/45] Parser: refactor

---
 src/Nix/Parser.hs | 161 +++++++++++++++++++++++++++++-----------------
 1 file changed, 101 insertions(+), 60 deletions(-)

diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index bc2f52b8e..39a5243c9 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -85,6 +85,7 @@ import           Prettyprinter                  ( Doc
 import           Text.Megaparsec         hiding ( State )
 import           Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer    as L
+import           Nix.Utils                      ( bool )
 
 infixl 3 <+>
 (<+>) :: MonadPlus m => m a -> m a -> m a
@@ -93,18 +94,23 @@ infixl 3 <+>
 ---------------------------------------------------------------------------------
 
 nixExpr :: Parser NExprLoc
-nixExpr = makeExprParser nixTerm $ fmap (fmap snd) (nixOperators nixSelector)
+nixExpr =
+  makeExprParser
+    nixTerm $
+      (fmap . fmap)
+        snd
+        (nixOperators nixSelector)
 
 antiStart :: Parser Text
 antiStart = symbol "${" <?> show ("${" :: String)
 
 nixAntiquoted :: Parser a -> Parser (Antiquoted a NExprLoc)
 nixAntiquoted p =
-  Antiquoted
-    <$> (antiStart *> nixToplevelForm <* symbol "}")
-    <+> Plain
-    <$> p
-    <?> "anti-quotation"
+  Antiquoted <$>
+    (antiStart *> nixToplevelForm <* symbol "}")
+      <+> Plain <$>
+        p
+      <?> "anti-quotation"
 
 selDot :: Parser ()
 selDot = try (symbol "." *> notFollowedBy nixPath) <?> "."
@@ -133,13 +139,18 @@ nixSelect term =
         , Maybe NExprLoc
         )
     -> NExprLoc
-  build t Nothing       = t
-  build t (Just (s, o)) = nSelectLoc t s o
+  build t mexpr =
+    maybe
+      t
+      (uncurry (nSelectLoc t))
+      mexpr
 
 nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
-nixSelector = annotateLocation $ do
-  (x : xs) <- keyName `sepBy1` selDot
-  pure $ x :| xs
+nixSelector =
+  annotateLocation $
+    do
+      (x : xs) <- keyName `sepBy1` selDot
+      pure $ x :| xs
 
 nixTerm :: Parser NExprLoc
 nixTerm = do
@@ -159,12 +170,12 @@ nixTerm = do
         $  [ nixSelect nixSet | c == 'r' ]
         <> [ nixPath | pathChar c ]
         <> if isDigit c
-             then [nixFloat, nixInt]
+             then [ nixFloat, nixInt ]
              else
                [ nixUri | isAlpha c ]
                <> [ nixBool | c == 't' || c == 'f' ]
                <> [ nixNull | c == 'n' ]
-               <> [nixSelect nixSym]
+               <> [ nixSelect nixSym ]
 
 nixToplevelForm :: Parser NExprLoc
 nixToplevelForm = keywords <+> nixLambda <+> nixExpr
@@ -216,11 +227,12 @@ slash =
 -- | A path surrounded by angle brackets, indicating that it should be
 -- looked up in the NIX_PATH environment variable at evaluation.
 nixSearchPath :: Parser NExprLoc
-nixSearchPath = annotateLocation1
-  (   mkPathF True
-  <$> try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")
-  <?> "spath"
-  )
+nixSearchPath =
+  annotateLocation1
+    (mkPathF True <$>
+      try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")
+      <?> "spath"
+    )
 
 pathStr :: Parser FilePath
 pathStr = lexeme $ liftM2
@@ -235,7 +247,10 @@ nixLet :: Parser NExprLoc
 nixLet = annotateLocation1
   (reserved "let" *> (letBody <+> letBinders) <?> "let block")
  where
-  letBinders = NLet <$> nixBinders <*> (reserved "in" *> nixToplevelForm)
+  letBinders =
+    NLet
+    <$> nixBinders
+    <*> (reserved "in" *> nixToplevelForm)
   -- Let expressions `let {..., body = ...}' are just desugared
   -- into `(rec {..., body = ...}).body'.
   letBody    = (\x -> NSelect x (StaticKey "body" :| mempty) Nothing) <$> aset
@@ -243,7 +258,7 @@ nixLet = annotateLocation1
 
 nixIf :: Parser NExprLoc
 nixIf = annotateLocation1
-  (   NIf
+  (NIf
   <$> (reserved "if" *> nixExpr)
   <*> (reserved "then" *> nixToplevelForm)
   <*> (reserved "else" *> nixToplevelForm)
@@ -252,7 +267,7 @@ nixIf = annotateLocation1
 
 nixAssert :: Parser NExprLoc
 nixAssert = annotateLocation1
-  (   NAssert
+  (NAssert
   <$> (reserved "assert" *> nixToplevelForm)
   <*> (semi *> nixToplevelForm)
   <?> "assert"
@@ -260,7 +275,7 @@ nixAssert = annotateLocation1
 
 nixWith :: Parser NExprLoc
 nixWith = annotateLocation1
-  (   NWith
+  (NWith
   <$> (reserved "with" *> nixToplevelForm)
   <*> (semi *> nixToplevelForm)
   <?> "with"
@@ -275,11 +290,20 @@ nixString = nStr <$> annotateLocation nixString'
 nixUri :: Parser NExprLoc
 nixUri = lexeme $ annotateLocation1 $ try $ do
   start    <- letterChar
-  protocol <- many $ satisfy $ \x ->
-    isAlpha x || isDigit x || x `elem` ("+-." :: String)
+  protocol <- many $
+    satisfy $
+      \ x ->
+        isAlpha x
+        || isDigit x
+        || (`elem` ("+-." :: String)) x
   _       <- string ":"
-  address <- some $ satisfy $ \x ->
-    isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)
+  address <-
+    some $
+      satisfy $
+        \ x ->
+          isAlpha x
+          || isDigit x
+          || (`elem` ("%/?:@&=+$,-_.!~*'" :: String)) x
   pure $ NStr $ DoubleQuoted
     [Plain $ pack $ start : protocol ++ ':' : address]
 
@@ -289,12 +313,12 @@ nixString' = lexeme (doubleQuoted <+> indented <?> "string")
   doubleQuoted :: Parser (NString NExprLoc)
   doubleQuoted =
     DoubleQuoted
-      .   removePlainEmpty
-      .   mergePlain
-      <$> (  doubleQ
-          *> many (stringChar doubleQ (void $ char '\\') doubleEscape)
-          <* doubleQ
-          )
+    . removePlainEmpty
+    . mergePlain <$>
+      ( doubleQ
+      *> many (stringChar doubleQ (void $ char '\\') doubleEscape)
+      <* doubleQ
+      )
       <?> "double quoted string"
 
   doubleQ      = void (char '"')
@@ -302,41 +326,53 @@ nixString' = lexeme (doubleQuoted <+> indented <?> "string")
 
   indented :: Parser (NString NExprLoc)
   indented =
-    stripIndent
-      <$> (  indentedQ
-          *> many (stringChar indentedQ indentedQ indentedEscape)
-          <* indentedQ
-          )
+    stripIndent <$>
+      (indentedQ
+      *> many (stringChar indentedQ indentedQ indentedEscape)
+      <* indentedQ
+      )
       <?> "indented string"
 
   indentedQ      = void (string "''" <?> "\"''\"")
-  indentedEscape = try $ do
-    indentedQ
-    (Plain <$> ("''" <$ char '\'' <+> "$" <$ char '$')) <+> do
-      _ <- char '\\'
-      c <- escapeCode
-      pure $ if c == '\n' then EscapedNewline else Plain $ singleton c
+  indentedEscape =
+    try $
+      do
+        indentedQ
+        (Plain <$> ("''" <$ char '\'' <+> "$" <$ char '$')) <+>
+          do
+            _ <- char '\\'
+            c <- escapeCode
+
+            pure $
+              bool
+                EscapedNewline
+                (Plain $ singleton c)
+                (c /= '\n')
 
   stringChar end escStart esc =
-    Antiquoted
-      <$> (antiStart *> nixToplevelForm <* char '}')
-      <+> Plain
-      .   singleton
-      <$> char '$'
-      <+> esc
-      <+> Plain
-      .   pack
-      <$> some plainChar
+    Antiquoted <$>
+      (antiStart *> nixToplevelForm <* char '}')
+        <+> Plain . singleton <$>
+          char '$' <+> esc <+> Plain . pack <$>
+            some plainChar
    where
     plainChar =
       notFollowedBy (end <+> void (char '$') <+> escStart) *> anySingle
 
-  escapeCode = msum [ c <$ char e | (c, e) <- escapeCodes ] <+> anySingle
+  escapeCode =
+    msum
+      [ c <$ char e | (c, e) <- escapeCodes ]
+    <+> anySingle
 
 -- | Gets all of the arguments for a function.
 argExpr :: Parser (Params NExprLoc)
 argExpr =
-  msum [atLeft, onlyname, atRight] <* symbol ":"
+  msum
+    [ atLeft
+    , onlyname
+    , atRight
+    ]
+  <* symbol ":"
  where
   -- An argument not in curly braces. There's some potential ambiguity
   -- in the case of, for example `x:y`. Is it a lambda function `x: y`, or
@@ -394,12 +430,15 @@ nixBinders :: Parser [Binding NExprLoc]
 nixBinders = (inherit <+> namedVar) `endBy` semi where
   inherit =
     do
-        -- We can't use 'reserved' here because it would consume the whitespace
-        -- after the keyword, which is not exactly the semantics of C++ Nix.
+      -- We can't use 'reserved' here because it would consume the whitespace
+      -- after the keyword, which is not exactly the semantics of C++ Nix.
       try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))
       p <- getSourcePos
       x <- whiteSpace *> optional scope
-      Inherit x <$> many keyName <*> pure p <?> "inherited binding"
+      Inherit x
+        <$> many keyName
+        <*> pure p
+        <?> "inherited binding"
   namedVar =
     do
       p <- getSourcePos
@@ -411,7 +450,8 @@ nixBinders = (inherit <+> namedVar) `endBy` semi where
   scope = nixParens <?> "inherit scope"
 
 keyName :: Parser (NKeyName NExprLoc)
-keyName = dynamicKey <+> staticKey where
+keyName = dynamicKey <+> staticKey
+ where
   staticKey  = StaticKey <$> identifier
   dynamicKey = DynamicKey <$> nixAntiquoted nixString'
 
@@ -498,8 +538,9 @@ float :: Parser Double
 float = lexeme L.float
 
 reservedNames :: HashSet Text
-reservedNames = HashSet.fromList
-  ["let", "in", "if", "then", "else", "assert", "with", "rec", "inherit"]
+reservedNames =
+  HashSet.fromList
+    ["let", "in", "if", "then", "else", "assert", "with", "rec", "inherit"]
 
 type Parser = ParsecT Void Text (State SourcePos)
 

From 47b1f03fcae25a336ba5c12be2363da419b7b807 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 02:08:07 +0200
Subject: [PATCH 25/45] Parser: make imports explicit

Allows to observe specialization of functions.
---
 src/Nix/Parser.hs | 56 ++++++++++++++++++++++++++++++++---------------
 1 file changed, 38 insertions(+), 18 deletions(-)

diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index 39a5243c9..06f527834 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -48,44 +48,64 @@ where
 
 import           Prelude                 hiding ( readFile )
 
-import           Control.Applicative     hiding ( many
-                                                , some
+import           Control.DeepSeq                ( NFData )
+import           Control.Monad                  ( guard
+                                                , void
+                                                , liftM2
+                                                , msum
+                                                , MonadPlus(mplus)
+                                                )
+import           Control.Monad.Combinators.Expr ( makeExprParser
+                                                , Operator( Postfix
+                                                          , InfixN
+                                                          , InfixR
+                                                          , Prefix
+                                                          , InfixL
+                                                          )
+                                                )
+import           Control.Monad.State.Strict     ( evalState
+                                                , MonadState(get, put)
+                                                , State
                                                 )
-import           Control.DeepSeq
-import           Control.Monad
-import           Control.Monad.Combinators.Expr
-import           Control.Monad.State.Strict
 import           Data.Char                      ( isAlpha
                                                 , isDigit
                                                 , isSpace
                                                 )
 import           Data.Data                      ( Data(..) )
 import           Data.Fix                       ( Fix(..) )
-import           Data.Functor
+import           Data.Functor                   ( ($>) )
 import           Data.HashSet                   ( HashSet )
 import qualified Data.HashSet                  as HashSet
 import           Data.List.NonEmpty             ( NonEmpty(..) )
 import qualified Data.List.NonEmpty            as NE
 import qualified Data.Map                      as Map
-import           Data.Text               hiding ( foldr1
-                                                , concat
-                                                , concatMap
-                                                , zipWith
+import           Data.Text                      ( Text
+                                                , cons
+                                                , singleton
+                                                , pack
                                                 )
-import           Data.Text.Encoding
+import           Data.Text.Encoding             ( decodeUtf8 )
 import           Data.Typeable                  ( Typeable )
-import           Data.Void
-import           GHC.Generics            hiding ( Prefix )
+import           Data.Void                      ( Void )
+import           GHC.Generics                   ( Generic )
 import           Nix.Expr                hiding ( ($>) )
-import           Nix.Expr.Strings
-import           Nix.Render
+import           Nix.Expr.Strings               ( escapeCodes
+                                                , stripIndent
+                                                , mergePlain
+                                                , removePlainEmpty
+                                                )
+import           Nix.Render                     ( MonadFile(readFile) )
+import           Nix.Utils                      ( bool )
 import           Prettyprinter                  ( Doc
                                                 , pretty
                                                 )
 import           Text.Megaparsec         hiding ( State )
-import           Text.Megaparsec.Char
+import           Text.Megaparsec.Char           ( space1
+                                                , string
+                                                , letterChar
+                                                , char
+                                                )
 import qualified Text.Megaparsec.Char.Lexer    as L
-import           Nix.Utils                      ( bool )
 
 infixl 3 <+>
 (<+>) :: MonadPlus m => m a -> m a -> m a

From 9a7f07c47fb73e58f5f8bd2d387ed0fe32db9423 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 02:14:32 +0200
Subject: [PATCH 26/45] Parser: m refactor

---
 src/Nix/Parser.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index 06f527834..fc9b88e78 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -105,7 +105,7 @@ import           Text.Megaparsec.Char           ( space1
                                                 , letterChar
                                                 , char
                                                 )
-import qualified Text.Megaparsec.Char.Lexer    as L
+import qualified Text.Megaparsec.Char.Lexer    as Lexer
 
 infixl 3 <+>
 (<+>) :: MonadPlus m => m a -> m a -> m a
@@ -199,7 +199,8 @@ nixTerm = do
 
 nixToplevelForm :: Parser NExprLoc
 nixToplevelForm = keywords <+> nixLambda <+> nixExpr
-  where keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith
+ where
+  keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith
 
 nixSym :: Parser NExprLoc
 nixSym = annotateLocation1 $ mkSymF <$> identifier
@@ -503,10 +504,10 @@ skipLineComment' prefix =
 whiteSpace :: Parser ()
 whiteSpace = do
   put =<< getSourcePos
-  L.space space1 lineCmnt blockCmnt
+  Lexer.space space1 lineCmnt blockCmnt
  where
   lineCmnt  = skipLineComment' "#"
-  blockCmnt = L.skipBlockComment "/*" "*/"
+  blockCmnt = Lexer.skipBlockComment "/*" "*/"
 
 lexeme :: Parser a -> Parser a
 lexeme p = p <* whiteSpace
@@ -552,10 +553,10 @@ equals   = symbol "="
 question = symbol "?"
 
 integer :: Parser Integer
-integer = lexeme L.decimal
+integer = lexeme Lexer.decimal
 
 float :: Parser Double
-float = lexeme L.float
+float = lexeme Lexer.float
 
 reservedNames :: HashSet Text
 reservedNames =

From 2a4b7ebe9315d3223a23dc286d04ade695ae2652 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 02:14:43 +0200
Subject: [PATCH 27/45] Parser: add ApplicativeDo

---
 src/Nix/Parser.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
index fc9b88e78..e6b00fa5e 100644
--- a/src/Nix/Parser.hs
+++ b/src/Nix/Parser.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ApplicativeDo #-}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -Wno-missing-signatures #-}

From 200ca83ef1a03a3b9e15fbc25cce4ea830e2cd2c Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 02:47:53 +0200
Subject: [PATCH 28/45] Value.Equal: refactor

---
 src/Nix/Value/Equal.hs | 162 +++++++++++++++++++++++++++--------------
 1 file changed, 106 insertions(+), 56 deletions(-)

diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs
index 8a72b1190..0c0797bbe 100644
--- a/src/Nix/Value/Equal.hs
+++ b/src/Nix/Value/Equal.hs
@@ -52,45 +52,76 @@ alignEqM
   -> f a
   -> f b
   -> m Bool
-alignEqM eq fa fb = fmap (either (const False) (const True)) $ runExceptT $ do
-  pairs <- forM (Data.Align.align fa fb) $ \case
-    These a b -> pure (a, b)
-    _         -> throwE ()
-  for_ pairs $ \(a, b) -> guard =<< lift (eq a b)
+alignEqM eq fa fb = fmap (either (const False) (const True)) $ runExceptT $
+  do
+    pairs <-
+      traverse
+        (\case
+          These a b -> pure (a, b)
+          _         -> throwE ()
+        )
+        (Data.Align.align fa fb)
+    traverse_ (\ (a, b) -> guard =<< lift (eq a b)) pairs
 
 alignEq :: (Align f, Traversable f) => (a -> b -> Bool) -> f a -> f b -> Bool
 alignEq eq fa fb = runIdentity $ alignEqM (\x y -> Identity (eq x y)) fa fb
 
-isDerivationM :: Monad m => (t -> m (Maybe NixString)) -> AttrSet t -> m Bool
-isDerivationM f m = case HashMap.Lazy.lookup "type" m of
-  Nothing -> pure False
-  Just t  -> do
-    mres <- f t
-    case mres of
-        -- We should probably really make sure the context is empty here
-        -- but the C++ implementation ignores it.
-      Just s  -> pure $ stringIgnoreContext s == "derivation"
-      Nothing -> pure False
-
-isDerivation :: Monad m => (t -> Maybe NixString) -> AttrSet t -> Bool
+isDerivationM
+  :: Monad m
+  => ( t
+     -> m (Maybe NixString)
+     )
+  -> AttrSet t
+  -> m Bool
+isDerivationM f m =
+  maybe
+    (pure False)
+    (\ t ->
+      do
+        mres <- f t
+
+        maybe
+          -- We should probably really make sure the context is empty here
+          -- but the C++ implementation ignores it.
+          (pure False)
+          (pure . (==) "derivation" . stringIgnoreContext)
+          mres
+    )
+    (HashMap.Lazy.lookup "type" m)
+
+isDerivation
+  :: Monad m
+  => ( t
+     -> Maybe NixString
+     )
+  -> AttrSet t
+  -> Bool
 isDerivation f = runIdentity . isDerivationM (Identity . f)
 
 valueFEqM
   :: Monad n
-  => (AttrSet a -> AttrSet a -> n Bool)
-  -> (a -> a -> n Bool)
+  => (  AttrSet a
+     -> AttrSet a
+     -> n Bool
+     )
+  -> (  a
+     -> a
+     -> n Bool
+     )
   -> NValueF p m a
   -> NValueF p m a
   -> n Bool
-valueFEqM attrsEq eq = curry $ \case
-  (NVConstantF (NFloat x), NVConstantF (NInt y)  ) -> pure $ x == fromInteger y
-  (NVConstantF (NInt   x), NVConstantF (NFloat y)) -> pure $ fromInteger x == y
-  (NVConstantF lc        , NVConstantF rc        ) -> pure $ lc == rc
-  (NVStrF ls, NVStrF rs)     -> pure $ (\i -> i ls == i rs) stringIgnoreContext
-  (NVListF ls , NVListF rs ) -> alignEqM eq ls rs
-  (NVSetF lm _, NVSetF rm _) -> attrsEq lm rm
-  (NVPathF lp , NVPathF rp ) -> pure $ lp == rp
-  _                          -> pure False
+valueFEqM attrsEq eq =
+  curry $
+    \case
+      (NVConstantF (NFloat x), NVConstantF (NInt   y)) -> pure $ x == fromInteger y
+      (NVConstantF (NInt   x), NVConstantF (NFloat y)) -> pure $ fromInteger x == y
+      (NVConstantF lc        , NVConstantF rc        ) -> pure $ lc == rc
+      (NVStrF      ls        , NVStrF      rs        ) -> pure $ (\i -> i ls == i rs) stringIgnoreContext
+      (NVListF     ls        , NVListF     rs        ) -> alignEqM eq ls rs
+      (NVSetF      lm _      , NVSetF      rm _      ) -> attrsEq lm rm
+      (NVPathF     lp        , NVPathF     rp        ) -> pure $ lp == rp
+      _                                                -> pure False
 
 valueFEq
   :: (AttrSet a -> AttrSet a -> Bool)
@@ -98,11 +129,13 @@ valueFEq
   -> NValueF p m a
   -> NValueF p m a
   -> Bool
-valueFEq attrsEq eq x y = runIdentity $ valueFEqM
-  (\x' y' -> Identity $ attrsEq x' y')
-  (\x' y' -> Identity $ eq x' y')
-  x
-  y
+valueFEq attrsEq eq x y =
+  runIdentity $
+    valueFEqM
+      (\x' y' -> Identity $ attrsEq x' y')
+      (\x' y' -> Identity $ eq x' y')
+      x
+      y
 
 compareAttrSetsM
   :: Monad m
@@ -111,16 +144,24 @@ compareAttrSetsM
   -> AttrSet t
   -> AttrSet t
   -> m Bool
-compareAttrSetsM f eq lm rm = do
-  isDerivationM f lm >>= \case
-    True -> isDerivationM f rm >>= \case
-      True
-        | Just lp <- HashMap.Lazy.lookup "outPath" lm, Just rp <- HashMap.Lazy.lookup "outPath" rm -> eq
-          lp
-          rp
-      _ -> compareAttrs
-    _ -> compareAttrs
-  where compareAttrs = alignEqM eq lm rm
+compareAttrSetsM f eq lm rm =
+  do
+    l <- isDerivationM f lm
+    bool
+      compareAttrs
+      (do
+        r <- isDerivationM f rm
+        case r of
+          True
+            | Just lp <- HashMap.Lazy.lookup "outPath" lm, Just rp <- HashMap.Lazy.lookup "outPath" rm ->
+                eq
+                  lp
+                  rp
+          _ -> compareAttrs
+      )
+      l
+ where
+  compareAttrs = alignEqM eq lm rm
 
 compareAttrSets
   :: (t -> Maybe NixString)
@@ -144,23 +185,32 @@ valueEqM (Free (NValue (extract -> x))) (Free (NValue (extract -> y))) =
  where
   f =
     free
-      (pure . (\case
+      (pure .
+        (\case
           NVStr s -> pure s
           _       -> mempty
         ) <=< force
       )
-      (pure . \case
-        NVStr' s -> pure s
-        _        -> mempty
+      (pure .
+        \case
+          NVStr' s -> pure s
+          _        -> mempty
       )
 
 thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool
-thunkEqM lt rt = (=<< force lt) $ \lv -> (=<< force rt) $ \rv ->
-  let unsafePtrEq = case (lt, rt) of
-        (thunkId -> lid, thunkId -> rid) | lid == rid -> pure True
-        _ -> valueEqM lv rv
-  in  case (lv, rv) of
-        (NVClosure _ _, NVClosure _ _) -> unsafePtrEq
-        (NVList _     , NVList _     ) -> unsafePtrEq
-        (NVSet _ _    , NVSet _ _    ) -> unsafePtrEq
-        _                              -> valueEqM lv rv
+thunkEqM lt rt =
+  do
+    lv <- force lt
+    rv <- force rt
+
+    let
+      unsafePtrEq =
+        case (lt, rt) of
+          (thunkId -> lid, thunkId -> rid) | lid == rid -> pure True
+          _                                             -> valueEqM lv rv
+
+    case (lv, rv) of
+      (NVClosure _ _, NVClosure _ _) -> unsafePtrEq
+      (NVList _     , NVList _     ) -> unsafePtrEq
+      (NVSet _ _    , NVSet _ _    ) -> unsafePtrEq
+      _                              -> valueEqM lv rv

From 84d96259f88d26a30f4602563e51e0293c7ab94e Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 03:11:50 +0200
Subject: [PATCH 29/45] Value.Equal: refactor

---
 src/Nix/Value/Equal.hs | 67 +++++++++++++++++++++++++-----------------
 1 file changed, 40 insertions(+), 27 deletions(-)

diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs
index 0c0797bbe..f9804ac52 100644
--- a/src/Nix/Value/Equal.hs
+++ b/src/Nix/Value/Equal.hs
@@ -30,18 +30,21 @@ import           Nix.Utils
 import           Nix.Value
 
 checkComparable
-  :: (Framed e m, MonadDataErrorContext t f m)
+  :: ( Framed e m
+     , MonadDataErrorContext t f m
+     )
   => NValue t f m
   -> NValue t f m
   -> m ()
-checkComparable x y = case (x, y) of
-  (NVConstant (NFloat _), NVConstant (NInt _)) -> pure ()
-  (NVConstant (NInt _), NVConstant (NFloat _)) -> pure ()
-  (NVConstant (NInt _), NVConstant (NInt _)) -> pure ()
-  (NVConstant (NFloat _), NVConstant (NFloat _)) -> pure ()
-  (NVStr _, NVStr _) -> pure ()
-  (NVPath _, NVPath _) -> pure ()
-  _ -> throwError $ Comparison x y
+checkComparable x y =
+  case (x, y) of
+    (NVConstant (NFloat _), NVConstant (NInt   _)) -> pure ()
+    (NVConstant (NInt   _), NVConstant (NFloat _)) -> pure ()
+    (NVConstant (NInt   _), NVConstant (NInt   _)) -> pure ()
+    (NVConstant (NFloat _), NVConstant (NFloat _)) -> pure ()
+    (NVStr       _        , NVStr       _        ) -> pure ()
+    (NVPath      _        , NVPath      _        ) -> pure ()
+    _                                              -> throwError $ Comparison x y
 
 -- | Checks whether two containers are equal, using the given item equality
 --   predicate. If there are any item slots that don't match between the two
@@ -52,16 +55,22 @@ alignEqM
   -> f a
   -> f b
   -> m Bool
-alignEqM eq fa fb = fmap (either (const False) (const True)) $ runExceptT $
-  do
-    pairs <-
-      traverse
-        (\case
-          These a b -> pure (a, b)
-          _         -> throwE ()
-        )
-        (Data.Align.align fa fb)
-    traverse_ (\ (a, b) -> guard =<< lift (eq a b)) pairs
+alignEqM eq fa fb =
+  fmap
+    (either
+      (const False)
+      (const True)
+    )
+    $ runExceptT $
+      do
+        pairs <-
+          traverse
+            (\case
+              These a b -> pure (a, b)
+              _         -> throwE ()
+            )
+            (Data.Align.align fa fb)
+        traverse_ (\ (a, b) -> guard =<< lift (eq a b)) pairs
 
 alignEq :: (Align f, Traversable f) => (a -> b -> Bool) -> f a -> f b -> Bool
 alignEq eq fa fb = runIdentity $ alignEqM (\x y -> Identity (eq x y)) fa fb
@@ -114,13 +123,13 @@ valueFEqM
 valueFEqM attrsEq eq =
   curry $
     \case
-      (NVConstantF (NFloat x), NVConstantF (NInt   y)) -> pure $ x == fromInteger y
+      (NVConstantF (NFloat x), NVConstantF (NInt   y)) -> pure $             x == fromInteger y
       (NVConstantF (NInt   x), NVConstantF (NFloat y)) -> pure $ fromInteger x == y
-      (NVConstantF lc        , NVConstantF rc        ) -> pure $ lc == rc
-      (NVStrF      ls        , NVStrF      rs        ) -> pure $ (\i -> i ls == i rs) stringIgnoreContext
-      (NVListF     ls        , NVListF     rs        ) -> alignEqM eq ls rs
-      (NVSetF      lm _      , NVSetF      rm _      ) -> attrsEq lm rm
-      (NVPathF     lp        , NVPathF     rp        ) -> pure $ lp == rp
+      (NVConstantF lc        , NVConstantF rc        ) -> pure $            lc == rc
+      (NVStrF      ls        , NVStrF      rs        ) -> pure $  (\ i -> i ls == i rs) stringIgnoreContext
+      (NVListF     ls        , NVListF     rs        ) ->          alignEqM eq ls rs
+      (NVSetF      lm _      , NVSetF      rm _      ) ->          attrsEq lm rm
+      (NVPathF     lp        , NVPathF     rp        ) ->             pure $ lp == rp
       _                                                -> pure False
 
 valueFEq
@@ -179,9 +188,13 @@ valueEqM
   -> m Bool
 valueEqM (  Pure x) (  Pure y) = thunkEqM x y
 valueEqM (  Pure x) y@(Free _) = thunkEqM x =<< thunk (pure y)
-valueEqM x@(Free _) (  Pure y) = thunkEqM ?? y =<< thunk (pure x)
+valueEqM x@(Free _) (  Pure y) = (`thunkEqM` y) =<< thunk (pure x)
 valueEqM (Free (NValue (extract -> x))) (Free (NValue (extract -> y))) =
-  valueFEqM (compareAttrSetsM f valueEqM) valueEqM x y
+  valueFEqM
+    (compareAttrSetsM f valueEqM)
+    valueEqM
+    x
+    y
  where
   f =
     free

From 884e16a9adef27c877310691d2d21f2c3ce0fe84 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 03:11:57 +0200
Subject: [PATCH 30/45] Type.Infer: refactor

---
 src/Nix/Type/Infer.hs | 129 ++++++++++++++++++++++++------------------
 1 file changed, 74 insertions(+), 55 deletions(-)

diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index ff5e739cd..e10adb0a3 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -72,28 +72,28 @@ import           Nix.Utils
 import           Nix.Value.Monad
 import           Nix.Var
 
----------------------------------------------------------------------------------
+
 -- * Classes
----------------------------------------------------------------------------------
 
 -- | Inference monad
-newtype InferT s m a = InferT
+newtype InferT s m a =
+  InferT
     { getInfer ::
         ReaderT (Set.Set TVar, Scopes (InferT s m) (Judgment s))
             (StateT InferState (ExceptT InferError m)) a
     }
     deriving
-        ( Functor
-        , Applicative
-        , Alternative
-        , Monad
-        , MonadPlus
-        , MonadFix
-        , MonadReader (Set.Set TVar, Scopes (InferT s m) (Judgment s))
-        , MonadFail
-        , MonadState InferState
-        , MonadError InferError
-        )
+      ( Functor
+      , Applicative
+      , Alternative
+      , Monad
+      , MonadPlus
+      , MonadFix
+      , MonadReader (Set.Set TVar, Scopes (InferT s m) (Judgment s))
+      , MonadFail
+      , MonadState InferState
+      , MonadError InferError
+      )
 
 instance MonadTrans (InferT s) where
   lift = InferT . lift . lift . lift
@@ -109,10 +109,10 @@ initInfer :: InferState
 initInfer = InferState { count = 0 }
 
 data Constraint
-    = EqConst Type Type
-    | ExpInstConst Type Scheme
-    | ImpInstConst Type (Set.Set TVar) Type
-    deriving (Show, Eq, Ord)
+  = EqConst Type Type
+  | ExpInstConst Type Scheme
+  | ImpInstConst Type (Set.Set TVar) Type
+  deriving (Show, Eq, Ord)
 
 newtype Subst = Subst (Map TVar Type)
   deriving (Eq, Ord, Show, Semigroup, Monoid)
@@ -179,10 +179,9 @@ class ActiveTypeVars a where
   atv :: a -> Set.Set TVar
 
 instance ActiveTypeVars Constraint where
-  atv (EqConst t1 t2) = ftv t1 `Set.union` ftv t2
-  atv (ImpInstConst t1 ms t2) =
-    ftv t1 `Set.union` (ftv ms `Set.intersection` ftv t2)
-  atv (ExpInstConst t s) = ftv t `Set.union` ftv s
+  atv (EqConst      t1 t2   ) = ftv t1 `Set.union` ftv t2
+  atv (ImpInstConst t1 ms t2) = ftv t1 `Set.union` (ftv ms `Set.intersection` ftv t2)
+  atv (ExpInstConst t  s     ) = ftv t  `Set.union` ftv s
 
 instance ActiveTypeVars a => ActiveTypeVars [a] where
   atv = foldr (Set.union . atv) mempty
@@ -213,9 +212,8 @@ instance Monoid InferError where
   mempty  = TypeInferenceAborted
   mappend = (<>)
 
----------------------------------------------------------------------------------
+
 -- * Inference
----------------------------------------------------------------------------------
 
 -- | Run the inference monad
 runInfer' :: MonadInfer m => InferT s m a -> m (Either InferError a)
@@ -535,49 +533,67 @@ instance MonadInfer m => MonadEval (Judgment s) (InferT s m) where
                       (tv :~> t)
 
   evalAbs (ParamSet ps variadic _mname) k = do
-    js <- fmap concat $ forM ps $ \(name, _) -> do
-      tv <- fresh
-      pure [(name, tv)]
-
-    let (env, tys) =
-          (\f -> foldl' f (As.empty, mempty) js) $ \(as1, t1) (k, t) ->
-            (as1 `As.merge` As.singleton k t, M.insert k t t1)
-        arg   = pure $ Judgment env mempty (TSet True tys)
-        call  = k arg $ \args b -> (args, ) <$> b
-        names = fmap fst js
+    js <-
+      concat <$>
+        traverse
+          (\(name, _) ->
+            do
+              tv <- fresh
+              pure [(name, tv)]
+          )
+          ps
+
+    let
+      (env, tys) =
+        (\f -> foldl' f (As.empty, mempty) js) $ \(as1, t1) (k, t) ->
+          (as1 `As.merge` As.singleton k t, M.insert k t t1)
+      arg   = pure $ Judgment env mempty (TSet True tys)
+      call  = k arg $ \args b -> (args, ) <$> b
+      names = fmap fst js
 
     (args, Judgment as cs t) <- foldr (\(_, TVar a) -> extendMSet a) call js
 
     ty <- TSet variadic <$> traverse (inferredType <$>) args
 
-    pure $ Judgment
-      (foldl' As.remove as names)
-      (cs <> [ EqConst t' (tys M.! x) | x <- names, t' <- As.lookup x as ])
-      (ty :~> t)
+    pure $
+      Judgment
+        (foldl' As.remove as names)
+        (cs <> [ EqConst t' (tys M.! x) | x <- names, t' <- As.lookup x as ])
+        (ty :~> t)
 
   evalError = throwError . EvaluationError
 
-data Judgment s = Judgment
+data Judgment s =
+  Judgment
     { assumptions     :: As.Assumption
     , typeConstraints :: [Constraint]
     , inferredType    :: Type
     }
     deriving Show
 
-instance Monad m => FromValue NixString (InferT s m) (Judgment s) where
+instance
+  Monad m
+  => FromValue NixString (InferT s m) (Judgment s)
+ where
   fromValueMay _ = pure mempty
   fromValue _ = error "Unused"
 
-instance MonadInfer m
-  => FromValue (AttrSet (Judgment s), AttrSet SourcePos)
-              (InferT s m) (Judgment s) where
-  fromValueMay (Judgment _ _ (TSet _ xs)) = do
-    let sing _ = Judgment As.empty mempty
-    pure $ pure (M.mapWithKey sing xs, mempty)
+instance
+  MonadInfer m
+  => FromValue ( AttrSet (Judgment s)
+              , AttrSet SourcePos
+              ) (InferT s m) (Judgment s)
+ where
+  fromValueMay (Judgment _ _ (TSet _ xs)) =
+    do
+      let sing _ = Judgment As.empty mempty
+      pure $ pure (M.mapWithKey sing xs, mempty)
   fromValueMay _ = pure mempty
-  fromValue = fromValueMay >=>
-    pure . fromMaybe
+  fromValue =
+    pure .
+      fromMaybe
       (mempty, mempty)
+      <=< fromValueMay
 
 instance MonadInfer m
   => ToValue (AttrSet (Judgment s), AttrSet SourcePos)
@@ -585,7 +601,7 @@ instance MonadInfer m
   toValue (xs, _) =
     Judgment
       <$> foldrM go As.empty xs
-      <*> (concat <$> traverse ((pure . typeConstraints) <=< demand ) xs)
+      <*> (concat <$> traverse ((pure . typeConstraints) <=< demand) xs)
       <*> (TSet True <$> traverse ((pure . inferredType) <=< demand) xs)
    where
     go x rest =
@@ -636,13 +652,14 @@ normalizeScheme (Forall _ body) = Forall (fmap snd ord) (normtype body)
   normtype (TSet b a) = TSet b (M.map normtype a)
   normtype (TList a ) = TList (fmap normtype a)
   normtype (TMany ts) = TMany (fmap normtype ts)
-  normtype (TVar  a ) = case Prelude.lookup a ord of
-    Just x  -> TVar x
-    Nothing -> error "type variable not in signature"
+  normtype (TVar  a ) =
+    maybe
+      (error "type variable not in signature")
+      TVar
+      (Prelude.lookup a ord)
+
 
----------------------------------------------------------------------------------
 -- * Constraint Solver
----------------------------------------------------------------------------------
 
 newtype Solver m a = Solver (LogicT (StateT [TypeError] m) a)
     deriving (Functor, Applicative, Alternative, Monad, MonadPlus,
@@ -743,7 +760,9 @@ solve cs = solve' (nextSolvable cs)
     s' <- lift $ instantiate s
     solve (EqConst t s' : cs)
 
-instance Monad m => Scoped (Judgment s) (InferT s m) where
+instance
+  Monad m
+  => Scoped (Judgment s) (InferT s m) where
   currentScopes = currentScopesReader
   clearScopes   = clearScopesReader @(InferT s m) @(Judgment s)
   pushScopes    = pushScopesReader

From 9af8917a66290b3a3634c3706da5931b12939b03 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 03:45:52 +0200
Subject: [PATCH 31/45] Builtins: refactor

---
 src/Nix/Builtins.hs | 27 ++++++++++++++-------------
 1 file changed, 14 insertions(+), 13 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 44cf5d0a2..f310342aa 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -124,7 +124,7 @@ builtins :: (MonadNix e t f m, Scoped (NValue t f m) m)
          => m (Scopes m (NValue t f m))
 builtins =
   do
-    ref <- defer $ (nvSet mempty) <$> buildMap
+    ref <- defer $ nvSet mempty <$> buildMap
     lst <- ([("builtins", ref)] <>) <$> topLevelBuiltins
     pushScope (M.fromList lst) currentScopes
  where
@@ -883,9 +883,10 @@ catAttrs attrName xs =
     n <- fromStringNoContext =<< fromValue attrName
     l <- fromValue @[NValue t f m] xs
 
-    fmap (nvList . catMaybes) $
-      forM l $
-        fmap (M.lookup n) . fromValue <=< demand
+    nvList . catMaybes <$>
+      traverse
+        (fmap (M.lookup n) . fromValue <=< demand)
+        l
 
 baseNameOf :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 baseNameOf x = do
@@ -1010,7 +1011,7 @@ genList f nixN =
     n <- fromValue @Integer nixN
     bool
       (throwError $ ErrorCall $ "builtins.genList: Expected a non-negative number, got " <> show n)
-      (toValue =<< forM [0 .. n - 1] (defer . callFunc f <=< toValue))
+      (toValue =<< traverse (defer . callFunc f <=< toValue) [0 .. n - 1])
       (n >= 0)
 
 -- We wrap values solely to provide an Ord instance for genericClosure
@@ -1433,17 +1434,17 @@ listToAttrs lst =
   do
     l <- fromValue @[NValue t f m] lst
     fmap
-      ((nvSet mempty) . M.fromList . reverse)
-      (forM l $
+      (nvSet mempty . M.fromList . reverse)
+      (traverse
         (\ nvattrset ->
           do
-            a <- fromValue @(AttrSet (NValue t f m)) nvattrset
-            n <- fromValue =<< demand =<< attrsetGet "name" a
-            name <- fromStringNoContext n
+            a <- fromValue @(AttrSet (NValue t f m)) =<< demand nvattrset
+            name <- fromStringNoContext =<< fromValue =<< demand =<< attrsetGet "name" a
             val  <- attrsetGet "value" a
 
             pure (name, val)
-        ) <=< demand
+        )
+        l
       )
 
 -- prim_hashString from nix/src/libexpr/primops.cc
@@ -1596,7 +1597,7 @@ fromJSON nvjson =
 
  where
   jsonToNValue = \case
-    A.Object m -> (nvSet mempty) <$> traverse jsonToNValue m
+    A.Object m -> nvSet mempty <$> traverse jsonToNValue m
     A.Array  l -> nvList <$> traverse jsonToNValue (V.toList l)
     A.String s -> pure $ nvStr $ makeNixStringWithoutContext s
     A.Number n ->
@@ -1664,7 +1665,7 @@ trace_ msg action =
     traceEffect @t @f @m . Text.unpack . stringIgnoreContext =<< fromValue msg
     pure action
 
--- 2018-09-08: NOTE: Remember of error context is so far not implemented
+-- Please, can function remember error context
 addErrorContext
   :: forall e t f m
    . MonadNix e t f m

From a86140e9ecc26fd04fcda1d5a10a3616d0826103 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 03:47:27 +0200
Subject: [PATCH 32/45] Reduce: reduce: refactor

---
 src/Nix/Reduce.hs | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index 314f8c692..0957f4efe 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -218,13 +218,20 @@ reduce base@(NSelect_ _ _ attrs _)
 
 -- | Reduce a set by inlining its binds outside of the set
 --   if none of the binds inherit the super set.
-reduce e@(NSet_ ann NNonRecursive binds) = do
-  let usesInherit = flip any binds $ \case
-        Inherit{} -> True
-        _         -> False
-  if usesInherit
-    then clearScopes @NExprLoc $ Fix . NSet_ ann NNonRecursive <$> traverse sequence binds
-    else Fix <$> sequence e
+reduce e@(NSet_ ann NNonRecursive binds) =
+  do
+    let
+      usesInherit =
+        any
+          (\case
+            Inherit{} -> True
+            _         -> False
+          )
+          binds
+
+    if usesInherit
+      then clearScopes @NExprLoc $ Fix . NSet_ ann NNonRecursive <$> traverse sequence binds
+      else Fix <$> sequence e
 
 -- Encountering a 'rec set' construction eliminates any hope of inlining
 -- definitions.

From ea6e8c57ed0c22cfd37392fde5629d25b1570791 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 03:46:26 +0200
Subject: [PATCH 33/45] Reduce: reduce: reduce (=<< -> <$>)

---
 src/Nix/Reduce.hs | 59 +++++++++++++++++++++++++++++------------------
 1 file changed, 36 insertions(+), 23 deletions(-)

diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index 0957f4efe..07c5212b8 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -245,29 +245,42 @@ reduce (NWith_ ann scope body) =
 
 -- | Reduce a let binds section by pushing lambdas,
 --   constants and strings to the body scope.
-reduce (NLet_ ann binds body) = do
-  s <- fmap (M.fromList . catMaybes) $ forM binds $ \case
-    NamedVar (StaticKey name :| []) def _pos -> def >>= \case
-      d@(Fix NAbs_{}     ) -> pure $ pure (name, d)
-      d@(Fix NConstant_{}) -> pure $ pure (name, d)
-      d@(Fix NStr_{}     ) -> pure $ pure (name, d)
-      _                    -> pure Nothing
-    _ -> pure Nothing
-  body'  <- pushScope s body
-  binds' <- traverse sequence binds
-  -- let names = gatherNames body'
-  -- binds' <- traverse sequence binds <&> \b -> flip filter b $ \case
-  --     NamedVar (StaticKey name _ :| mempty) _ ->
-  --         name `S.member` names
-  --     _ -> True
-  pure $ Fix $ NLet_ ann binds' body'
-  -- where
-  --   go m [] = pure m
-  --   go m (x:xs) = case x of
-  --       NamedVar (StaticKey name _ :| mempty) def -> do
-  --           v <- pushScope m def
-  --           go (M.insert name v m) xs
-  --       _ -> go m xs
+reduce (NLet_ ann binds body) =
+  do
+    s <-
+      M.fromList . catMaybes <$>
+        traverse
+          (\case
+            NamedVar (StaticKey name :| []) def _pos ->
+              let
+                defcase =
+                  \case
+                    d@(Fix NAbs_{}     ) -> pure (name, d)
+                    d@(Fix NConstant_{}) -> pure (name, d)
+                    d@(Fix NStr_{}     ) -> pure (name, d)
+                    _                    -> Nothing
+              in
+              defcase <$> def
+
+            _ -> pure Nothing
+
+          )
+          binds
+    body'  <- pushScope s body
+    binds' <- traverse sequence binds
+    -- let names = gatherNames body'
+    -- binds' <- traverse sequence binds <&> \b -> flip filter b $ \case
+    --     NamedVar (StaticKey name _ :| mempty) _ ->
+    --         name `S.member` names
+    --     _ -> True
+    pure $ Fix $ NLet_ ann binds' body'
+    -- where
+    --   go m [] = pure m
+    --   go m (x:xs) = case x of
+    --       NamedVar (StaticKey name _ :| mempty) def -> do
+    --           v <- pushScope m def
+    --           go (M.insert name v m) xs
+    --       _ -> go m xs
 
 -- | Reduce an if to the relevant path if
 --   the condition is a boolean constant.

From fab166d50927658a574e00634cf599f94de12fa9 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 03:56:47 +0200
Subject: [PATCH 34/45] Reduce: reduce: reduce <$>

---
 src/Nix/Reduce.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index 07c5212b8..6574c49fa 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -247,8 +247,9 @@ reduce (NWith_ ann scope body) =
 --   constants and strings to the body scope.
 reduce (NLet_ ann binds body) =
   do
-    s <-
-      M.fromList . catMaybes <$>
+    binds' <- traverse sequence binds
+    body'  <-
+      (`pushScope` body) . M.fromList . catMaybes =<<
         traverse
           (\case
             NamedVar (StaticKey name :| []) def _pos ->
@@ -264,10 +265,10 @@ reduce (NLet_ ann binds body) =
 
             _ -> pure Nothing
 
+
           )
           binds
-    body'  <- pushScope s body
-    binds' <- traverse sequence binds
+
     -- let names = gatherNames body'
     -- binds' <- traverse sequence binds <&> \b -> flip filter b $ \case
     --     NamedVar (StaticKey name _ :| mempty) _ ->

From 78771ce5f795774aaec709ccdb1130cd13836af1 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 04:51:17 +0200
Subject: [PATCH 35/45] Eval: addStackFrames: nodge GHC to optimize it

From my test, ~ a quarter of savings.
---
 src/Nix/Eval.hs  | 11 ++++++++---
 src/Nix/Utils.hs |  2 +-
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 4f2c6fe39..2fbd72fe0 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -509,9 +509,14 @@ addStackFrames
   :: forall v e m a
    . (Scoped v m, Framed e m, Typeable v, Typeable m)
   => Transform NExprLocF (m a)
-addStackFrames f v = do
-  scopes <- currentScopes :: m (Scopes m v)
-  withFrame Info (EvaluatingExpr scopes v) (f v)
+addStackFrames f v =
+  do
+    scopes <- currentScopes :: m (Scopes m v)
+
+    -- sectioning gives GHC optimization
+    (`withFrameInfo` f v) $ (`EvaluatingExpr` v) scopes
+ where
+  withFrameInfo = withFrame Info
 
 framedEvalExprLoc
   :: forall e v m
diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs
index a01a7e99c..3f6cdb983 100644
--- a/src/Nix/Utils.hs
+++ b/src/Nix/Utils.hs
@@ -125,7 +125,7 @@ adiM
 adiM f g = g ((f <=< traverse (adiM f g)) . unFix)
 
 class Has a b where
-    hasLens :: Lens' a b
+  hasLens :: Lens' a b
 
 instance Has a a where
   hasLens f = f

From 6e23addbcf085de5a00f347ffcfa502101b3a6c5 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 18:05:42 +0200
Subject: [PATCH 36/45] Builtins: Eval: evalBinds: (maybe -> =<<)

---
 src/Nix/Builtins.hs |  7 ++++--
 src/Nix/Eval.hs     | 52 +++++++++++++++++++++++----------------------
 2 files changed, 32 insertions(+), 27 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index f310342aa..4b838e5b5 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -120,8 +120,11 @@ withNixContext mpath action =
         )
         mpath
 
-builtins :: (MonadNix e t f m, Scoped (NValue t f m) m)
-         => m (Scopes m (NValue t f m))
+builtins
+  :: ( MonadNix e t f m
+     , Scoped (NValue t f m) m
+     )
+  => m (Scopes m (NValue t f m))
 builtins =
   do
     ref <- defer $ nvSet mempty <$> buildMap
diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 2fbd72fe0..28c8f15ee 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -360,26 +360,27 @@ evalBinds recursive binds =
       :: NKeyName (m v)
       -> m (Maybe ([Text], SourcePos, m v))
     processScope nkeyname =
-      maybe
-        Nothing
-        (\ key -> pure
-          ([key]
-          , pos
-          , maybe
-              (attrMissing (key :| []) Nothing)
-              (pure <=< demand)
-              =<< maybe
-                  (withScopes scope $ lookupVar key)
-                  (\ s ->
-                    do
-                      (attrset, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< s
-
-                      clearScopes @v $ pushScope attrset $ lookupVar key
-                  )
-                  ms
-          )
-        )
-        <$> evalSetterKeyName nkeyname
+      (\ mkey ->
+        do
+          key <- mkey
+          pure
+            ([key]
+            , pos
+            , maybe
+                (attrMissing (key :| []) Nothing)
+                (pure <=< demand)
+                =<< maybe
+                    (withScopes scope $ lookupVar key)
+                    (\ s ->
+                      do
+                        (attrset, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< s
+
+                        clearScopes @v $ pushScope attrset $ lookupVar key
+                    )
+                    ms
+            )
+      ) <$>
+        evalSetterKeyName nkeyname
 
   moveOverridesLast = uncurry (<>) . partition
     (\case
@@ -435,10 +436,11 @@ evalSetterKeyName
   :: (MonadEval v m, FromValue NixString m v)
   => NKeyName (m v)
   -> m (Maybe Text)
-evalSetterKeyName = \case
-  StaticKey k -> pure (pure k)
-  DynamicKey k ->
-    ((pure . stringIgnoreContext) `ifJust`) <$> runAntiquoted "\n" assembleString (fromValueMay =<<) k
+evalSetterKeyName =
+  \case
+    StaticKey k -> pure (pure k)
+    DynamicKey k ->
+      ((pure . stringIgnoreContext) `ifJust`) <$> runAntiquoted "\n" assembleString (fromValueMay =<<) k
 
 assembleString
   :: forall v m
@@ -448,7 +450,7 @@ assembleString
 assembleString =
   fromParts .
     \case
-      Indented _ parts   -> parts
+      Indented   _ parts -> parts
       DoubleQuoted parts -> parts
  where
   fromParts = fmap (fmap mconcat . sequence) . traverse go

From 4e3aa9bd398163ae3726efcb569c250b1d7580f6 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 9 Mar 2021 18:06:49 +0200
Subject: [PATCH 37/45] Pretty: refactor

---
 src/Nix/Eval.hs   |   2 +
 src/Nix/Pretty.hs | 114 ++++++++++++++++++++++++++--------------------
 2 files changed, 66 insertions(+), 50 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 28c8f15ee..8c00450ad 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -516,6 +516,8 @@ addStackFrames f v =
     scopes <- currentScopes :: m (Scopes m v)
 
     -- sectioning gives GHC optimization
+    -- If opimization question would arrive again, check the @(`withFrameInfo` f v) $ EvaluatingExpr scopes v@
+    -- for possible @scopes@ implementation @v@ type arguments sharing between runs.
     (`withFrameInfo` f v) $ (`EvaluatingExpr` v) scopes
  where
   withFrameInfo = withFrame Info
diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index abd69d9da..20f6f26f4 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -214,40 +214,53 @@ exprFNixDoc = \case
   NStr      str  -> simpleExpr $ prettyString str
   NList     []   -> simpleExpr $ lbracket <> rbracket
   NList xs ->
-    simpleExpr
-      $ group
-      $ nest 2
-      $ vsep
-      $ concat
-      $ [[lbracket], fmap (wrapParens appOpNonAssoc) xs, [rbracket]]
+    simpleExpr $
+      group $
+        nest 2 $
+          vsep $
+            concat
+              [ [lbracket]
+              , wrapParens appOpNonAssoc <$>
+                  xs
+              , [rbracket]]
   NSet NNonRecursive [] -> simpleExpr $ lbrace <> rbrace
   NSet NNonRecursive xs ->
-    simpleExpr
-      $ group
-      $ nest 2
-      $ vsep
-      $ concat
-      $ [[lbrace], fmap prettyBind xs, [rbrace]]
+    simpleExpr $
+      group $
+        nest 2 $
+          vsep $
+            concat
+              [ [lbrace]
+              , prettyBind <$> xs
+              , [rbrace]
+              ]
   NSet NRecursive [] -> simpleExpr $ recPrefix <> lbrace <> rbrace
   NSet NRecursive xs ->
-    simpleExpr
-      $ group
-      $ nest 2
-      $ vsep
-      $ concat
-      $ [[recPrefix <> lbrace], fmap prettyBind xs, [rbrace]]
+    simpleExpr $
+      group $
+        nest 2 $
+          vsep $
+            concat
+              [ [recPrefix <> lbrace]
+              , prettyBind <$> xs
+              , [rbrace]
+              ]
   NAbs args body ->
-    leastPrecedence
-      $ nest 2
-      $ vsep
-      $ [prettyParams args <> colon, withoutParens body]
+    leastPrecedence $
+      nest 2 $
+        vsep
+          [ prettyParams args <> colon
+          , withoutParens body
+          ]
   NBinary NApp fun arg ->
-    mkNixDoc appOp (wrapParens appOp fun <> space <> wrapParens appOpNonAssoc arg) 
-  NBinary op r1 r2 -> mkNixDoc opInfo $ hsep
-    [ wrapParens (f NAssocLeft) r1
-    , pretty $ unpack $ operatorName opInfo
-    , wrapParens (f NAssocRight) r2
-    ]
+    mkNixDoc appOp (wrapParens appOp fun <> space <> wrapParens appOpNonAssoc arg)
+  NBinary op r1 r2 ->
+    mkNixDoc opInfo $
+      hsep
+        [ wrapParens (f NAssocLeft) r1
+        , pretty $ unpack $ operatorName opInfo
+        , wrapParens (f NAssocRight) r2
+        ]
    where
     opInfo = getBinaryOperator op
     f x | associativity opInfo /= x = opInfo { associativity = NAssocNone }
@@ -283,32 +296,33 @@ exprFNixDoc = \case
               (any (`isPrefixOf` _txt) ["/", "~/", "./", "../"])
   NSym name -> simpleExpr $ pretty (unpack name)
   NLet binds body ->
-    leastPrecedence
-      $ group
-      $ vsep
-      $ [ "let"
-        , indent 2 (vsep (fmap prettyBind binds))
-        , "in " <> withoutParens body
-        ]
+    leastPrecedence $
+      group $
+        vsep
+          [ "let"
+          , indent 2 (vsep (fmap prettyBind binds))
+          , "in " <> withoutParens body
+          ]
   NIf cond trueBody falseBody ->
-    leastPrecedence
-      $ group
-      $ nest 2
-      $ vsep
-      $ [ "if " <> withoutParens cond
-        , align ("then " <> withoutParens trueBody)
-        , align ("else " <> withoutParens falseBody)
-        ]
+    leastPrecedence $
+      group $
+        nest 2 $
+          sep
+            [ "if " <> withoutParens cond
+            , align ("then " <> withoutParens trueBody)
+            , align ("else " <> withoutParens falseBody)
+            ]
   NWith scope body ->
-    leastPrecedence
-      $ vsep
-      $ ["with " <> withoutParens scope <> semi, align $ withoutParens body]
+    leastPrecedence $
+      vsep
+        ["with " <> withoutParens scope <> semi, align $ withoutParens body]
   NAssert cond body ->
-    leastPrecedence
-      $ vsep
-      $ ["assert " <> withoutParens cond <> semi, align $ withoutParens body]
+    leastPrecedence $
+      vsep
+        ["assert " <> withoutParens cond <> semi, align $ withoutParens body]
   NSynHole name -> simpleExpr $ pretty ("^" <> unpack name)
-  where recPrefix = "rec" <> space
+ where
+  recPrefix = "rec" <> space
 
 valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr
 valueToExpr = iterNValue (\_ _ -> thk) phi

From a869b4e9a5e1cfc3abc18e9d406ebdbadeab18b8 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Wed, 10 Mar 2021 21:02:53 +0200
Subject: [PATCH 38/45] Pretty: refactor

---
 src/Nix/Pretty.hs | 68 +++++++++++++++++++++++------------------------
 1 file changed, 34 insertions(+), 34 deletions(-)

diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index 20f6f26f4..8b3da1f28 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -212,48 +212,49 @@ exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann
 exprFNixDoc = \case
   NConstant atom -> prettyAtom atom
   NStr      str  -> simpleExpr $ prettyString str
-  NList     []   -> simpleExpr $ lbracket <> rbracket
+  NList     []   -> simpleExpr "[]"
   NList xs ->
     simpleExpr $
       group $
         nest 2 $
           vsep $
             concat
-              [ [lbracket]
+              [ ["["]
               , wrapParens appOpNonAssoc <$>
                   xs
-              , [rbracket]]
-  NSet NNonRecursive [] -> simpleExpr $ lbrace <> rbrace
+              , ["]"]
+              ]
+  NSet NNonRecursive [] -> simpleExpr "{}"
   NSet NNonRecursive xs ->
     simpleExpr $
       group $
         nest 2 $
           vsep $
             concat
-              [ [lbrace]
+              [ ["{"]
               , prettyBind <$> xs
-              , [rbrace]
+              , ["}"]
               ]
-  NSet NRecursive [] -> simpleExpr $ recPrefix <> lbrace <> rbrace
+  NSet NRecursive [] -> simpleExpr "rec {}"
   NSet NRecursive xs ->
     simpleExpr $
       group $
         nest 2 $
           vsep $
             concat
-              [ [recPrefix <> lbrace]
+              [ ["rec {"]
               , prettyBind <$> xs
-              , [rbrace]
+              , ["}"]
               ]
   NAbs args body ->
     leastPrecedence $
       nest 2 $
         vsep
-          [ prettyParams args <> colon
+          [ prettyParams args <> ":"
           , withoutParens body
           ]
   NBinary NApp fun arg ->
-    mkNixDoc appOp (wrapParens appOp fun <> space <> wrapParens appOpNonAssoc arg)
+    mkNixDoc appOp (wrapParens appOp fun <> " " <> wrapParens appOpNonAssoc arg)
   NBinary op r1 r2 ->
     mkNixDoc opInfo $
       hsep
@@ -321,8 +322,6 @@ exprFNixDoc = \case
       vsep
         ["assert " <> withoutParens cond <> semi, align $ withoutParens body]
   NSynHole name -> simpleExpr $ pretty ("^" <> unpack name)
- where
-  recPrefix = "rec" <> space
 
 valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr
 valueToExpr = iterNValue (\_ _ -> thk) phi
@@ -381,16 +380,17 @@ prettyNThunk
      )
   => t
   -> m (Doc ann)
-prettyNThunk t = do
-  let ps = citations @m @(NValue t f m) @t t
-  v' <- prettyNValue <$> dethunk t
-  pure
-    $ fillSep
-        [ v'
-        , indent 2 $
-            parens $
-              mconcat $ "thunk from: " : fmap (prettyOriginExpr . _originExpr) ps
-        ]
+prettyNThunk t =
+  do
+    let ps = citations @m @(NValue t f m) @t t
+    v' <- prettyNValue <$> dethunk t
+    pure
+      $ fillSep
+          [ v'
+          , indent 2 $
+              parens $
+                mconcat $ "thunk from: " : fmap (prettyOriginExpr . _originExpr) ps
+          ]
 
 -- | This function is used only by the testing code.
 printNix :: forall t f m . MonadDataContext f m => NValue t f m -> String
@@ -403,18 +403,18 @@ printNix = iterNValue (\_ _ -> thk) phi
   phi (NVStr'      ns) = show $ stringIgnoreContext ns
   phi (NVList'     l ) = "[ " <> unwords l <> " ]"
   phi (NVSet' s _) =
-    "{ "
-      <> concat
-           [ check (unpack k) <> " = " <> v <> "; "
-           | (k, v) <- sort $ toList s
-           ]
-      <> "}"
+    "{ " <>
+      concat
+        [ check (unpack k) <> " = " <> v <> "; "
+        | (k, v) <- sort $ toList s
+        ] <> "}"
    where
-    check v = fromMaybe
-      v
-      (   fmap (surround . show) (readMaybe v :: Maybe Int)
-      <|> fmap (surround . show) (readMaybe v :: Maybe Float)
-      )
+    check v =
+      fromMaybe
+        v
+        (fmap (surround . show) (readMaybe v :: Maybe Int)
+        <|> fmap (surround . show) (readMaybe v :: Maybe Float)
+        )
       where surround s = "\"" <> s <> "\""
   phi NVClosure'{}        = "<<lambda>>"
   phi (NVPath' fp       ) = fp

From 2b326e933a315e16e017a3f5ea4062a07f188650 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 11 Mar 2021 00:39:04 +0200
Subject: [PATCH 39/45] Pretty: refactor

Foreign module functions which are text literals...

Lets stop spawning a String to serialize it into Text, which then serializes
into String that serializes then into Doc. If I would compute O to it - it would
explain the snails speed.
---
 src/Nix/Pretty.hs | 113 ++++++++++++++++++++++++----------------------
 1 file changed, 59 insertions(+), 54 deletions(-)

diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index 8b3da1f28..ff72dfb9b 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -15,7 +15,8 @@ module Nix.Pretty where
 
 import           Control.Applicative            ( (<|>) )
 import           Control.Monad.Free
-import           Data.Fix                       ( Fix(..), foldFix )
+import           Data.Fix                       ( Fix(..)
+                                                , foldFix )
 import           Data.HashMap.Lazy              ( toList )
 import qualified Data.HashMap.Lazy             as M
 import qualified Data.HashSet                  as HashSet
@@ -97,7 +98,7 @@ hasAttrOp = getSpecialOperator NHasAttrOp
 wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann
 wrapParens op sub =
   bool
-    parens
+    (\ a -> "(" <> a <> ")")
     id
     (precedence (rootOp sub)       < precedence op
     || (precedence (rootOp sub)   == precedence op
@@ -112,15 +113,17 @@ wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann
 wrapPath op sub =
   bool
     (wrapParens op sub)
-    (dquotes $ "$" <> braces (withoutParens sub))
+    ("\"${" <> withoutParens sub <> "}\"")
     (wasPath sub)
 
 prettyString :: NString (NixDoc ann) -> Doc ann
-prettyString (DoubleQuoted parts) = dquotes . hcat . fmap prettyPart $ parts
+prettyString (DoubleQuoted parts) = "\"" <> (mconcat . fmap prettyPart $ parts) <> "\""
  where
+  -- It serializes (@unpack@) Text -> String, because the helper code is done for String,
+  -- please, can someone break that code.
   prettyPart (Plain t)      = pretty . concatMap escape . unpack $ t
   prettyPart EscapedNewline = "''\\n"
-  prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
+  prettyPart (Antiquoted r) = "${" <> withoutParens r <> "}"
   escape '"' = "\\\""
   escape x   =
     maybe
@@ -128,64 +131,63 @@ prettyString (DoubleQuoted parts) = dquotes . hcat . fmap prettyPart $ parts
       (('\\' :) . (: mempty))
       (toEscapeCode x)
 prettyString (Indented _ parts) = group $ nest 2 $ vcat
-  [dsquote, content, dsquote]
+  ["''", content, "''"]
  where
-  dsquote = squote <> squote
   content = vsep . fmap prettyLine . stripLastIfEmpty . splitLines $ parts
   stripLastIfEmpty = reverse . f . reverse   where
     f ([Plain t] : xs) | Text.null (strip t) = xs
     f xs = xs
   prettyLine = hcat . fmap prettyPart
   prettyPart (Plain t) =
-    pretty . unpack . replace "${" "''${" . replace "''" "'''" $ t
+    pretty . replace "${" "''${" . replace "''" "'''" $ t
   prettyPart EscapedNewline = "\\n"
-  prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
+  prettyPart (Antiquoted r) = "${" <> withoutParens r <> "}"
 
 prettyParams :: Params (NixDoc ann) -> Doc ann
-prettyParams (Param n           ) = pretty $ unpack n
+prettyParams (Param n           ) = pretty n
 prettyParams (ParamSet s v mname) = prettyParamSet s v <>
-    (\ name -> ("@" <> pretty (unpack name)) `ifTrue` not (Text.null name)) `ifJust` mname
+    (\ name -> ("@" <> pretty name) `ifTrue` not (Text.null name)) `ifJust` mname
 
 prettyParamSet :: ParamSet (NixDoc ann) -> Bool -> Doc ann
 prettyParamSet args var =
   encloseSep
-    (lbrace <> space)
-    (align (space <> rbrace))
+    "{ "
+    (align " }")
     sep
     (fmap prettySetArg args <> prettyVariadic)
  where
   prettySetArg (n, maybeDef) =
     maybe
-      (pretty (unpack n))
-      (\x -> pretty (unpack n) <> " ? " <> withoutParens x)
+      (pretty n)
+      (\x -> pretty n <> " ? " <> withoutParens x)
       maybeDef
   prettyVariadic = [ "..." | var ]
-  sep            = align (comma <> space)
+  sep            = align ", "
 
 prettyBind :: Binding (NixDoc ann) -> Doc ann
 prettyBind (NamedVar n v _p) =
-  prettySelector n <> space <> equals <> space <> withoutParens v <> semi
+  prettySelector n <> " = " <> withoutParens v <> ";"
 prettyBind (Inherit s ns _p) =
-  "inherit " <>scope <> align (fillSep (fmap prettyKeyName ns)) <> semi
+  "inherit " <> scope <> align (fillSep (fmap prettyKeyName ns)) <> ";"
   where
-    scope = ((<> space) . parens . withoutParens) `ifJust` s
+    scope = ((<> " ") . parens . withoutParens) `ifJust` s
 
 prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann
-prettyKeyName (StaticKey "") = dquotes ""
-prettyKeyName (StaticKey key) | HashSet.member key reservedNames =
-  dquotes $ pretty $ unpack key
-prettyKeyName (StaticKey  key) = pretty . unpack $ key
-prettyKeyName (DynamicKey key) = runAntiquoted
-  (DoubleQuoted [Plain "\n"])
-  prettyString
-  (("$" <>) . braces . withoutParens)
-  key
+prettyKeyName (StaticKey "") = "\"\""
+prettyKeyName (StaticKey key) | HashSet.member key reservedNames = "\"" <> pretty key <> "\""
+prettyKeyName (StaticKey  key) = pretty key
+prettyKeyName (DynamicKey key) =
+  runAntiquoted
+      (DoubleQuoted [Plain "\n"])
+      prettyString
+      (\ x -> "${" <> withoutParens x <> "}")
+      key
 
 prettySelector :: NAttrPath (NixDoc ann) -> Doc ann
-prettySelector = hcat . punctuate dot . fmap prettyKeyName . NE.toList
+prettySelector = hcat . punctuate "." . fmap prettyKeyName . NE.toList
 
 prettyAtom :: NAtom -> NixDoc ann
-prettyAtom atom = simpleExpr $ pretty $ unpack $ atomText atom
+prettyAtom atom = simpleExpr $ pretty $ atomText atom
 
 prettyNix :: NExpr -> Doc ann
 prettyNix = withoutParens . foldFix exprFNixDoc
@@ -259,7 +261,7 @@ exprFNixDoc = \case
     mkNixDoc opInfo $
       hsep
         [ wrapParens (f NAssocLeft) r1
-        , pretty $ unpack $ operatorName opInfo
+        , pretty $ operatorName opInfo
         , wrapParens (f NAssocRight) r2
         ]
    where
@@ -269,17 +271,17 @@ exprFNixDoc = \case
   NUnary op r1 ->
     mkNixDoc
       opInfo
-      (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1)
+      (pretty (operatorName opInfo) <> wrapParens opInfo r1)
     where opInfo = getUnaryOperator op
   NSelect r' attr o ->
     (if isJust o then leastPrecedence else mkNixDoc selectOp)
       $  wrapPath selectOp r
-      <> dot
+      <> "."
       <> prettySelector attr
       <> ordoc
    where
     r     = mkNixDoc selectOp (wrapParens appOpNonAssoc r')
-    ordoc = maybe mempty (((space <> "or ") <>) . wrapParens appOpNonAssoc) o
+    ordoc = maybe mempty ((" or " <>) . wrapParens appOpNonAssoc) o
   NHasAttr r attr ->
     mkNixDoc hasAttrOp (wrapParens hasAttrOp r <> " ? " <> prettySelector attr)
   NEnvPath     p -> simpleExpr $ pretty ("<" <> p <> ">")
@@ -295,7 +297,7 @@ exprFNixDoc = \case
               ("./" <> _txt)
               _txt
               (any (`isPrefixOf` _txt) ["/", "~/", "./", "../"])
-  NSym name -> simpleExpr $ pretty (unpack name)
+  NSym name -> simpleExpr $ pretty name
   NLet binds body ->
     leastPrecedence $
       group $
@@ -316,17 +318,17 @@ exprFNixDoc = \case
   NWith scope body ->
     leastPrecedence $
       vsep
-        ["with " <> withoutParens scope <> semi, align $ withoutParens body]
+        ["with " <> withoutParens scope <> ";", align $ withoutParens body]
   NAssert cond body ->
     leastPrecedence $
       vsep
-        ["assert " <> withoutParens cond <> semi, align $ withoutParens body]
-  NSynHole name -> simpleExpr $ pretty ("^" <> unpack name)
+        ["assert " <> withoutParens cond <> ";", align $ withoutParens body]
+  NSynHole name -> simpleExpr $ pretty ("^" <> name)
 
 valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr
 valueToExpr = iterNValue (\_ _ -> thk) phi
  where
-  thk = Fix . NSym . pack $ "<expr>"
+  thk = Fix . NSym $ "<expr>"
 
   phi :: NValue' t f m NExpr -> NExpr
   phi (NVConstant' a ) = Fix $ NConstant a
@@ -336,9 +338,9 @@ valueToExpr = iterNValue (\_ _ -> thk) phi
     [ NamedVar (StaticKey k :| mempty) v (fromMaybe nullPos (M.lookup k p))
     | (k, v) <- toList s
     ]
-  phi (NVClosure' _ _   ) = Fix . NSym . pack $ "<closure>"
+  phi (NVClosure' _ _   ) = Fix . NSym $ "<closure>"
   phi (NVPath' p        ) = Fix $ NLiteralPath p
-  phi (NVBuiltin' name _) = Fix . NSym . pack $ "builtins." <> name
+  phi (NVBuiltin' name _) = Fix . NSym $ "builtins." <> pack name
   phi _                   = error "Pattern synonyms foil completeness check"
 
   mkStr ns = Fix $ NStr $ DoubleQuoted [Plain (stringIgnoreContext ns)]
@@ -356,20 +358,24 @@ prettyNValueProv
      )
   => NValue t f m
   -> Doc ann
-prettyNValueProv v = do
-  let ps = citations @m @(NValue t f m) v
-  case ps of
-    [] -> prettyNValue v
+prettyNValueProv v =
+  case citations @m @(NValue t f m) v of
+    [] -> prettyNVal
     ps ->
-      let v' = prettyNValue v in
       fillSep
-        [ v'
-        , indent 2
-        $ parens
-        $ mconcat
-        $ "from: "
-        : fmap (prettyOriginExpr . _originExpr) ps
+        [ prettyNVal
+        , indent 2 $
+          "(" <>
+            mconcat (
+              "from: "
+              :
+                fmap
+                  (prettyOriginExpr . _originExpr)
+                  ps
+            ) <> ")"
         ]
+ where
+  prettyNVal = prettyNValue v
 
 prettyNThunk
   :: forall t f m ann
@@ -388,8 +394,7 @@ prettyNThunk t =
       $ fillSep
           [ v'
           , indent 2 $
-              parens $
-                mconcat $ "thunk from: " : fmap (prettyOriginExpr . _originExpr) ps
+              "("<> mconcat ( "thunk from: " : fmap (prettyOriginExpr . _originExpr) ps) <> ")"
           ]
 
 -- | This function is used only by the testing code.

From f3e68870876f980a640792bc1673f2ce6c5072e3 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 11 Mar 2021 01:40:07 +0200
Subject: [PATCH 40/45] Pretty: refactor

---
 src/Nix/Pretty.hs | 68 +++++++++++++++--------------------------------
 1 file changed, 21 insertions(+), 47 deletions(-)

diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index ff72dfb9b..d5cb67941 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -25,9 +25,7 @@ import           Data.List                      ( isPrefixOf
                                                 )
 import           Data.List.NonEmpty             ( NonEmpty(..) )
 import qualified Data.List.NonEmpty            as NE
-import           Data.Maybe                     ( isJust
-                                                , fromMaybe
-                                                )
+import           Data.Maybe                     ( fromMaybe )
 import           Data.Text                      ( pack
                                                 , unpack
                                                 , replace
@@ -216,38 +214,16 @@ exprFNixDoc = \case
   NStr      str  -> simpleExpr $ prettyString str
   NList     []   -> simpleExpr "[]"
   NList xs ->
-    simpleExpr $
-      group $
-        nest 2 $
-          vsep $
-            concat
-              [ ["["]
-              , wrapParens appOpNonAssoc <$>
-                  xs
-              , ["]"]
-              ]
+    prettyContainer $
+      ["["] <> (wrapParens appOpNonAssoc <$> xs) <> ["]"]
   NSet NNonRecursive [] -> simpleExpr "{}"
   NSet NNonRecursive xs ->
-    simpleExpr $
-      group $
-        nest 2 $
-          vsep $
-            concat
-              [ ["{"]
-              , prettyBind <$> xs
-              , ["}"]
-              ]
+    prettyContainer $
+      ["{"] <> (prettyBind <$> xs) <> ["}"]
   NSet NRecursive [] -> simpleExpr "rec {}"
   NSet NRecursive xs ->
-    simpleExpr $
-      group $
-        nest 2 $
-          vsep $
-            concat
-              [ ["rec {"]
-              , prettyBind <$> xs
-              , ["}"]
-              ]
+    prettyContainer $
+      ["rec {"] <> (prettyBind <$> xs) <> ["}"]
   NAbs args body ->
     leastPrecedence $
       nest 2 $
@@ -258,7 +234,8 @@ exprFNixDoc = \case
   NBinary NApp fun arg ->
     mkNixDoc appOp (wrapParens appOp fun <> " " <> wrapParens appOpNonAssoc arg)
   NBinary op r1 r2 ->
-    mkNixDoc opInfo $
+    mkNixDoc
+      opInfo $
       hsep
         [ wrapParens (f NAssocLeft) r1
         , pretty $ operatorName opInfo
@@ -274,14 +251,14 @@ exprFNixDoc = \case
       (pretty (operatorName opInfo) <> wrapParens opInfo r1)
     where opInfo = getUnaryOperator op
   NSelect r' attr o ->
-    (if isJust o then leastPrecedence else mkNixDoc selectOp)
-      $  wrapPath selectOp r
-      <> "."
-      <> prettySelector attr
-      <> ordoc
+    maybe
+      (mkNixDoc selectOp)
+      (const leastPrecedence)
+      o
+      $ wrapPath selectOp r <> "." <> prettySelector attr <> ordoc
    where
     r     = mkNixDoc selectOp (wrapParens appOpNonAssoc r')
-    ordoc = maybe mempty ((" or " <>) . wrapParens appOpNonAssoc) o
+    ordoc = ((" or " <>) . wrapParens appOpNonAssoc) `ifJust` o
   NHasAttr r attr ->
     mkNixDoc hasAttrOp (wrapParens hasAttrOp r <> " ? " <> prettySelector attr)
   NEnvPath     p -> simpleExpr $ pretty ("<" <> p <> ">")
@@ -324,6 +301,10 @@ exprFNixDoc = \case
       vsep
         ["assert " <> withoutParens cond <> ";", align $ withoutParens body]
   NSynHole name -> simpleExpr $ pretty ("^" <> name)
+ where
+  prettyContainer =
+    simpleExpr . group . nest 2 . vsep
+
 
 valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr
 valueToExpr = iterNValue (\_ _ -> thk) phi
@@ -365,14 +346,7 @@ prettyNValueProv v =
       fillSep
         [ prettyNVal
         , indent 2 $
-          "(" <>
-            mconcat (
-              "from: "
-              :
-                fmap
-                  (prettyOriginExpr . _originExpr)
-                  ps
-            ) <> ")"
+          "(" <> mconcat ("from: ":(prettyOriginExpr . _originExpr <$> ps)) <> ")"
         ]
  where
   prettyNVal = prettyNValue v
@@ -394,7 +368,7 @@ prettyNThunk t =
       $ fillSep
           [ v'
           , indent 2 $
-              "("<> mconcat ( "thunk from: " : fmap (prettyOriginExpr . _originExpr) ps) <> ")"
+              "(" <> mconcat ( "thunk from: " : fmap (prettyOriginExpr . _originExpr) ps) <> ")"
           ]
 
 -- | This function is used only by the testing code.

From 1a3c8e2fba461cc6efa2f7211e09985308d1fde6 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 11 Mar 2021 01:52:33 +0200
Subject: [PATCH 41/45] Pretty: refactor

---
 src/Nix/Pretty.hs | 21 +++++++++------------
 1 file changed, 9 insertions(+), 12 deletions(-)

diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index d5cb67941..63ffc8591 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -41,7 +41,7 @@ import           Nix.Parser
 import           Nix.String
 import           Nix.Thunk
 import           Nix.Value
-import           Prettyprinter
+import           Prettyprinter           hiding ( list )
 import           Text.Read                      ( readMaybe )
 import           Nix.Utils
 
@@ -212,18 +212,12 @@ exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann
 exprFNixDoc = \case
   NConstant atom -> prettyAtom atom
   NStr      str  -> simpleExpr $ prettyString str
-  NList     []   -> simpleExpr "[]"
   NList xs ->
-    prettyContainer $
-      ["["] <> (wrapParens appOpNonAssoc <$> xs) <> ["]"]
-  NSet NNonRecursive [] -> simpleExpr "{}"
+    prettyContainer "[" (wrapParens appOpNonAssoc) "]" xs
   NSet NNonRecursive xs ->
-    prettyContainer $
-      ["{"] <> (prettyBind <$> xs) <> ["}"]
-  NSet NRecursive [] -> simpleExpr "rec {}"
+    prettyContainer "{" prettyBind "}" xs
   NSet NRecursive xs ->
-    prettyContainer $
-      ["rec {"] <> (prettyBind <$> xs) <> ["}"]
+    prettyContainer "rec {" prettyBind "}" xs
   NAbs args body ->
     leastPrecedence $
       nest 2 $
@@ -302,8 +296,11 @@ exprFNixDoc = \case
         ["assert " <> withoutParens cond <> ";", align $ withoutParens body]
   NSynHole name -> simpleExpr $ pretty ("^" <> name)
  where
-  prettyContainer =
-    simpleExpr . group . nest 2 . vsep
+  prettyContainer h f t c =
+    list
+      (simpleExpr (h <> t))
+      (const $ simpleExpr $ group $ nest 2 $ vsep $ [h] <> (f <$> c) <> [t])
+      c
 
 
 valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr

From 24683c3a059661a4d6c365196b31129bc5f2bef0 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 11 Mar 2021 01:59:16 +0200
Subject: [PATCH 42/45] Pretty: refactor

---
 src/Nix/Pretty.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
index 63ffc8591..06fe08793 100644
--- a/src/Nix/Pretty.hs
+++ b/src/Nix/Pretty.hs
@@ -287,13 +287,9 @@ exprFNixDoc = \case
             , align ("else " <> withoutParens falseBody)
             ]
   NWith scope body ->
-    leastPrecedence $
-      vsep
-        ["with " <> withoutParens scope <> ";", align $ withoutParens body]
+    prettyAddScope "with " scope body
   NAssert cond body ->
-    leastPrecedence $
-      vsep
-        ["assert " <> withoutParens cond <> ";", align $ withoutParens body]
+    prettyAddScope "assert " cond body
   NSynHole name -> simpleExpr $ pretty ("^" <> name)
  where
   prettyContainer h f t c =
@@ -302,6 +298,11 @@ exprFNixDoc = \case
       (const $ simpleExpr $ group $ nest 2 $ vsep $ [h] <> (f <$> c) <> [t])
       c
 
+  prettyAddScope h c b =
+    leastPrecedence $
+      vsep
+        [h <> withoutParens c <> ";", align $ withoutParens b]
+
 
 valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr
 valueToExpr = iterNValue (\_ _ -> thk) phi

From 5e88b8a00d3194127ffcae71165d39fbaeb18b02 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 11 Mar 2021 02:11:38 +0200
Subject: [PATCH 43/45] Exec: unflip nvSetP

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

diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index 15e2a80dc..fad478dfe 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -98,10 +98,10 @@ nvListP p l = addProvenance p (nvList l)
 nvSetP
   :: MonadCited t f m
   => Provenance m (NValue t f m)
-  -> AttrSet (NValue t f m)
   -> AttrSet SourcePos
+  -> AttrSet (NValue t f m)
   -> NValue t f m
-nvSetP p s x = addProvenance p (nvSet x s)
+nvSetP p x s = addProvenance p (nvSet x s)
 
 nvClosureP
   :: MonadCited t f m
@@ -401,9 +401,9 @@ execBinaryOpForced scope span op lval rval = case op of
 
   NUpdate ->
     case (lval, rval) of
-      (NVSet ls lp, NVSet rs rp) -> pure $ nvSetP prov (rs `M.union` ls) (rp `M.union` lp)
-      (NVSet ls lp, NVConstant NNull) -> pure $ nvSetP prov ls lp
-      (NVConstant NNull, NVSet rs rp) -> pure $ nvSetP prov rs rp
+      (NVSet ls lp, NVSet rs rp) -> pure $ nvSetP prov (rp `M.union` lp) (rs `M.union` ls)
+      (NVSet ls lp, NVConstant NNull) -> pure $ nvSetP prov lp ls
+      (NVConstant NNull, NVSet rs rp) -> pure $ nvSetP prov rp rs
       _ -> unsupportedTypes
 
   NPlus ->

From b015ae2921a753a8a467b4444e3c8d9041340e00 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 11 Mar 2021 02:15:14 +0200
Subject: [PATCH 44/45] ChangeLog: note on `nvSet{,',P}`

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

diff --git a/ChangeLog.md b/ChangeLog.md
index f32f08b52..6f5fddbc7 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -137,6 +137,7 @@
         MonadPaths       (Fix1 t)    :: Nix.Standard -> Nix.Effects
         MonadPutStr      (Fix1 t)    :: Nix.Standard -> Nix.Effects
         ```
+  * [(link)](https://github.com/haskell-nix/hnix/pull/878/files) `nvSet{,',P}`: got unflipped, now accept source position argument before the value.
   
 
 * Additional:

From a802a107377d0f97ae3e52208a076e82df1a9f5a Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 11 Mar 2021 02:17:11 +0200
Subject: [PATCH 45/45] ChangeLog: note about `mkNixDoc`

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

diff --git a/ChangeLog.md b/ChangeLog.md
index 6f5fddbc7..bee3685c4 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -139,6 +139,7 @@
         ```
   * [(link)](https://github.com/haskell-nix/hnix/pull/878/files) `nvSet{,',P}`: got unflipped, now accept source position argument before the value.
   
+  * [(link)](https://github.com/haskell-nix/hnix/pull/878/files) `mkNixDoc`: got unflipped.
 
 * Additional:
   * [(link)](https://github.com/haskell-nix/hnix/commit/7e6cd97bf3288cb584241611fdb25bf85d7e0ba7) `cabal.project`: freed from the `cryptohash-sha512` override, Hackage trustees made a revision.