From b66cbbd10892aec3ea49eb2cfd2e5fb0dca5df50 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 25 Feb 2021 18:33:05 +0200
Subject: [PATCH 01/26] Utils: m refact `alterF`

---
 src/Nix/Normal.hs |  2 +-
 src/Nix/Utils.hs  | 10 +++++++---
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/src/Nix/Normal.hs b/src/Nix/Normal.hs
index 85cbb064f..7f77df55c 100644
--- a/src/Nix/Normal.hs
+++ b/src/Nix/Normal.hs
@@ -132,4 +132,4 @@ dethunk
   :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
   => t
   -> m (NValue t f m)
-dethunk t = queryM removeEffects (pure opaque) t
+dethunk = queryM removeEffects (pure opaque)
diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs
index 45d7f3c48..99a8bc716 100644
--- a/src/Nix/Utils.hs
+++ b/src/Nix/Utils.hs
@@ -169,6 +169,10 @@ alterF
   -> k
   -> HashMap k v
   -> f (HashMap k v)
-alterF f k m = f (M.lookup k m) <&> \case
-  Nothing -> M.delete k m
-  Just v  -> M.insert k v m
+alterF f k m =
+  fmap
+    (maybe
+      (M.delete k m)
+      (\ v -> M.insert k v m)
+    )
+    $ f $ M.lookup k m

From de6366ccce0d5dd83022bb6b2ef5561baf971b57 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 25 Feb 2021 18:33:39 +0200
Subject: [PATCH 02/26] Util: add `free` - Free monad analog of `either`

---
 src/Nix/Utils.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs
index 99a8bc716..2b51f01f2 100644
--- a/src/Nix/Utils.hs
+++ b/src/Nix/Utils.hs
@@ -176,3 +176,11 @@ alterF f k m =
       (\ v -> M.insert k v m)
     )
     $ f $ M.lookup k m
+
+
+-- | Lambda analog of @maybe@ or @either@ for Free monad.
+free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b
+free fP fF m =
+  case m of
+    Pure a -> fP a
+    Free fa -> fF fa

From bceb1d2504994ee901cea1a303ced704880d6f50 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 25 Feb 2021 18:56:16 +0200
Subject: [PATCH 03/26] Value.Equal: valueEqm: m refactor

Hardly a better refactor currently. But after the proper the further work on
`force` going to give beautiful code:
```haskell
f =
  pure $
    case
      free
        force
        id
    of
      NVStr' s -> pure s
      _        -> mempty
```
---
 src/Nix/Value/Equal.hs | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs
index f7e4bb430..c0c29a7bc 100644
--- a/src/Nix/Value/Equal.hs
+++ b/src/Nix/Value/Equal.hs
@@ -142,12 +142,19 @@ 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
  where
-  f (Pure t) = (`force` t) $ \case
-    NVStr s -> pure $ pure s
-    _       -> pure mempty
-  f (Free v) = case v of
-    NVStr' s -> pure $ pure s
-    _        -> pure mempty
+  f m =
+    free
+      (force
+        (pure . \case
+          NVStr s -> pure s
+          _       -> mempty
+        )
+      )
+      (pure . \case
+        NVStr' s -> pure s
+        _        -> mempty
+      )
+      m
 
 thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool
 thunkEqM lt rt = (`force` lt) $ \lv -> (`force` rt) $ \rv ->

From dc09461592000c71af48a02daa80ef24eba3396f Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 25 Feb 2021 19:12:33 +0200
Subject: [PATCH 04/26] Utils: freeToFix: m refactor

---
 src/Nix/Utils.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs
index 2b51f01f2..0e33696d1 100644
--- a/src/Nix/Utils.hs
+++ b/src/Nix/Utils.hs
@@ -100,8 +100,10 @@ lifted f k = liftWith (\run -> f (run . k)) >>= restoreT . pure
 freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f
 freeToFix f = go
  where
-  go (Pure a) = f a
-  go (Free v) = Fix (fmap go v)
+  go =
+    free
+      f
+      (Fix . fmap go)
 
 fixToFree :: Functor f => Fix f -> Free f a
 fixToFree = Free . go where go (Fix f) = fmap (Free . go) f

From 4444137a4dccb10361145616d1bc64eb9532b30e Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 25 Feb 2021 19:42:09 +0200
Subject: [PATCH 05/26] Main: m refact: use `{either, maybe, bool}`

---
 main/Main.hs | 112 +++++++++++++++++++++++++++++----------------------
 1 file changed, 63 insertions(+), 49 deletions(-)

diff --git a/main/Main.hs b/main/Main.hs
index c7c29bb87..9b6bd9433 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -16,6 +16,7 @@ import           Control.Monad
 import           Control.Monad.Catch
 import           Control.Monad.Free
 import           Control.Monad.IO.Class
+import           Data.Bool                      ( bool )
 import qualified Data.HashMap.Lazy             as M
 import qualified Data.Map                      as Map
 import           Data.List                      ( sortOn )
@@ -48,23 +49,24 @@ main :: IO ()
 main = do
   time <- getCurrentTime
   opts <- execParser (nixOptionsInfo time)
-  runWithBasicEffectsIO opts $ case readFrom opts of
-    Just path -> do
-      let file = addExtension (dropExtension path) "nixc"
-      process opts (pure file) =<< liftIO (readCache path)
-    Nothing -> case expression opts of
-      Just s  -> handleResult opts mempty (parseNixTextLoc s)
-      Nothing -> case fromFile opts of
-        Just "-" -> mapM_ (processFile opts) . lines =<< liftIO getContents
-        Just path ->
-          mapM_ (processFile opts) . lines =<< liftIO (readFile path)
-        Nothing -> case filePaths opts of
-          [] -> withNixContext mempty Repl.main
-          ["-"] ->
-            handleResult opts mempty
-              .   parseNixTextLoc
-              =<< liftIO Text.getContents
-          paths -> mapM_ (processFile opts) paths
+  runWithBasicEffectsIO opts $
+    case readFrom opts of
+      Nothing -> case expression opts of
+        Nothing -> case fromFile opts of
+          Nothing -> case filePaths opts of
+            [] -> withNixContext mempty Repl.main
+            ["-"] ->
+              handleResult opts mempty
+                .   parseNixTextLoc
+                =<< liftIO Text.getContents
+            paths -> mapM_ (processFile opts) paths
+          Just "-" -> mapM_ (processFile opts) . lines =<< liftIO getContents
+          Just path ->
+            mapM_ (processFile opts) . lines =<< liftIO (readFile path)
+        Just s  -> handleResult opts mempty (parseNixTextLoc s)
+      Just path -> do
+        let file = addExtension (dropExtension path) "nixc"
+        process opts (pure file) =<< liftIO (readCache path)
  where
   processFile opts path = do
     eres <- parseNixFileLoc path
@@ -72,9 +74,10 @@ main = do
 
   handleResult opts mpath = \case
     Failure err ->
-      (if ignoreErrors opts
-          then liftIO . hPutStrLn stderr
-          else errorWithoutStackTrace
+      (bool
+        errorWithoutStackTrace
+        (liftIO . hPutStrLn stderr)
+        (ignoreErrors opts)
         )
         $  "Parse failed: "
         <> show err
@@ -82,10 +85,12 @@ main = do
     Success expr -> do
       when (check opts) $ do
         expr' <- liftIO (reduceExpr mpath expr)
-        case HM.inferTop Env.empty [("it", stripAnnotation expr')] of
-          Left  err -> errorWithoutStackTrace $ "Type error: " <> PS.ppShow err
-          Right ty  -> liftIO $ putStrLn $ "Type of expression: " <> PS.ppShow
-            (fromJust (Map.lookup "it" (Env.types ty)))
+        either
+          (\ err -> errorWithoutStackTrace $ "Type error: " <> PS.ppShow err)
+          (\ ty  -> liftIO $ putStrLn $ "Type of expression: " <> PS.ppShow
+            (fromJust $ Map.lookup "it" $ Env.types ty)
+          )
+          (HM.inferTop Env.empty [("it", stripAnnotation expr')])
 
           -- liftIO $ putStrLn $ runST $
           --     runLintM opts . renderSymbolic =<< lint opts expr
@@ -99,11 +104,14 @@ main = do
                   frames
 
       when (repl opts) $
-        if evaluate opts
-          then do
-            val <- Nix.nixEvalExprLoc mpath expr
-            withNixContext mempty (Repl.main' $ pure val)
-          else withNixContext mempty Repl.main
+        withNixContext mempty $
+          bool
+            Repl.main
+            (do
+              val <- Nix.nixEvalExprLoc mpath expr
+              Repl.main' $ pure val
+            )
+            (evaluate opts)
 
   process opts mpath expr
     | evaluate opts
@@ -161,30 +169,35 @@ main = do
       findAttrs
         :: AttrSet (StdValue (StandardT (StdIdT IO)))
         -> StandardT (StdIdT IO) ()
-      findAttrs = go ""
+      findAttrs = go mempty
        where
         go prefix s = do
-          xs <- forM (sortOn fst (M.toList s)) $ \(k, nv) -> case nv of
-            Free v -> pure (k, pure (Free v))
-            Pure (StdThunk (extract -> Thunk _ _ ref)) -> do
-              let path         = prefix <> Text.unpack k
-                  (_, descend) = filterEntry path k
-              val <- readVar @(StandardT (StdIdT IO)) ref
-              case val of
-                Computed _ -> pure (k, Nothing)
-                _ | descend   -> (k, ) <$> forceEntry path nv
-                  | otherwise -> pure (k, Nothing)
-
+          xs <- forM (sortOn fst (M.toList s)) $ \(k, nv) ->
+            free
+              (\ (StdThunk (extract -> Thunk _ _ ref)) -> do
+                let path         = prefix <> Text.unpack k
+                    (_, descend) = filterEntry path k
+                val <- readVar @(StandardT (StdIdT IO)) ref
+                case val of
+                  Computed _    -> pure (k, Nothing)
+                  _ | descend   -> fmap (k,        ) $ forceEntry path nv
+                    | otherwise -> pure (k, Nothing)
+              )
+              (\ v -> pure (k, pure (Free v)))
+              nv
           forM_ xs $ \(k, mv) -> do
             let path              = prefix <> Text.unpack k
                 (report, descend) = filterEntry path k
             when report $ do
               liftIO $ putStrLn path
-              when descend $ case mv of
-                Nothing -> pure ()
-                Just v  -> case v of
-                  NVSet s' _ -> go (path <> ".") s'
-                  _          -> pure ()
+              when descend $
+                maybe
+                  (pure ())
+                  (\case
+                    NVSet s' _ -> go (path <> ".") s'
+                    _          -> pure ()
+                  )
+                  mv
          where
           filterEntry path k = case (path, k) of
             ("stdenv", "stdenv"          ) -> (True, True)
@@ -230,6 +243,7 @@ main = do
     liftIO $ do
       putStrLn $ "Wrote winnowed expression tree to " <> path
       writeFile path $ show $ prettyNix (stripAnnotation expr')
-    case eres of
-      Left  err -> throwM err
-      Right v   -> pure v
+    either
+      throwM
+      pure
+      eres

From f278e349ea667fc42409800858aaf8d731223e6d Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:26:28 +0200
Subject: [PATCH 06/26] Nix.Eval: m refactor

---
 src/Nix/Eval.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index e790ce226..3f4777b91 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -115,9 +115,10 @@ eval (NSym "__curPos") = evalCurPos
 
 eval (NSym var       ) = do
   mres <- lookupVar var
-  case mres of
-    Just x  -> demand x $ evaledSym var
-    Nothing -> freeVariable var
+  maybe
+    (freeVariable var)
+    (demand (evaledSym var))
+    mres
 
 eval (NConstant    x      ) = evalConstant x
 eval (NStr         str    ) = evalString str
@@ -188,9 +189,7 @@ attrSetAlter
   -> AttrSet SourcePos
   -> m v
   -> m (AttrSet (m v), AttrSet SourcePos)
-attrSetAlter [] _ _ _ _ =
-  evalError @v $ ErrorCall "invalid selector with no components"
-
+attrSetAlter [] _ _ _ _ = evalError @v $ ErrorCall "invalid selector with no components"
 attrSetAlter (k : ks) pos m p val = case M.lookup k m of
   Nothing | null ks   -> go
           | otherwise -> recurse M.empty M.empty

From 80360ab9852f8c9108e84280409c5322189c8c52 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 13:13:00 +0200
Subject: [PATCH 07/26] Type.Infer: m refactor

---
 src/Nix/Type/Infer.hs | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index b6bc3caf0..f1fab7df6 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -583,10 +583,12 @@ infer :: MonadInfer m => NExpr -> InferT s m (Judgment s)
 infer = foldFix Eval.eval
 
 inferTop :: Env -> [(Text, NExpr)] -> Either InferError Env
-inferTop env []                = Right env
-inferTop env ((name, ex) : xs) = case inferExpr env ex of
-  Left  err -> Left err
-  Right ty  -> inferTop (extend env (name, ty)) xs
+inferTop env []                = pure env
+inferTop env ((name, ex) : xs) =
+  either
+    Left
+    (\ ty -> inferTop (extend env (name, ty)) xs)
+    (inferExpr env ex)
 
 normalizeScheme :: Scheme -> Scheme
 normalizeScheme (Forall _ body) = Forall (fmap snd ord) (normtype body)
@@ -628,7 +630,7 @@ runSolver :: Monad m => Solver m a -> m (Either [TypeError] [a])
 runSolver (Solver s) = do
   res <- runStateT (observeAllT s) mempty
   pure $ case res of
-    (x : xs, _ ) -> Right (x : xs)
+    (x : xs, _ ) -> pure (x : xs)
     (_     , es) -> Left (nub es)
 
 -- | The empty substitution

From 37cad5715f631fdb950ce8bffbebbca354a586fc Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:42:58 +0200
Subject: [PATCH 08/26] Type.Infer: m refactor

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

diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index f1fab7df6..39e613cff 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -50,7 +50,7 @@ import           Data.List                      ( delete
                                                 )
 import           Data.Map                       ( Map )
 import qualified Data.Map                      as Map
-import           Data.Maybe                     ( fromJust )
+import           Data.Maybe                     ( fromJust, fromMaybe )
 import qualified Data.Set                      as Set
 import           Data.Text                      ( Text )
 import           Nix.Atoms
@@ -554,9 +554,9 @@ instance MonadInfer m
     let sing _ = Judgment As.empty mempty
     pure $ pure (M.mapWithKey sing xs, M.empty)
   fromValueMay _ = pure mempty
-  fromValue = fromValueMay >=> \case
-    Just v  -> pure v
-    Nothing -> pure (M.empty, M.empty)
+  fromValue = fromValueMay >=>
+    pure . fromMaybe
+      (M.empty, M.empty)
 
 instance MonadInfer m
   => ToValue (AttrSet (Judgment s), AttrSet SourcePos)

From 43f8e37f919f80e265e7f1e2582d7ba09718bad0 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:32:43 +0200
Subject: [PATCH 09/26] Effects.Basic: m refactor

---
 src/Nix/Effects/Basic.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs
index d8fc2369c..399ec2d80 100644
--- a/src/Nix/Effects/Basic.hs
+++ b/src/Nix/Effects/Basic.hs
@@ -222,7 +222,11 @@ findPathM = findPathBy existingPath
   existingPath path = do
     apath  <- makeAbsolutePath @t @f path
     exists <- doesPathExist apath
-    pure $ if exists then pure apath else mempty
+    pure $
+      bool
+        mempty
+        (pure apath)
+        exists
 
 defaultImportPath
   :: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc, b) m)

From 7bcbead511daa1b2b4a6e3259ce1c2e052457711 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:34:31 +0200
Subject: [PATCH 10/26] Effects.Derivation: m refactor

---
 src/Nix/Effects/Derivation.hs | 30 ++++++++++++++++++------------
 1 file changed, 18 insertions(+), 12 deletions(-)

diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index 4398140fe..4733e4d35 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -7,7 +7,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
- 
+
 
 module Nix.Effects.Derivation ( defaultDerivationStrict ) where
 
@@ -18,6 +18,7 @@ import           Control.Monad                  ( (>=>), forM, when )
 import           Control.Monad.Writer           ( join, lift )
 import           Control.Monad.State            ( MonadState, gets, modify )
 
+import           Data.Bool                      ( bool )
 import           Data.Char                      ( isAscii, isAlphaNum )
 import qualified Data.HashMap.Lazy             as M
 import qualified Data.HashMap.Strict           as MS
@@ -304,13 +305,15 @@ buildDerivationWithContext drvAttrs = do
       hashMode    <- getAttrOr "outputHashMode"    Flat    $ extractNoCtx >=> parseHashMode
       outputs     <- getAttrOr "outputs"           ["out"] $ mapM (fromValue' >=> extractNoCtx)
 
-      mFixedOutput <- case mHash of
-        Nothing -> pure Nothing
-        Just hash -> do
-          when (outputs /= ["out"]) $ lift $ throwError $ ErrorCall $ "Multiple outputs are not supported for fixed-output derivations"
-          hashType <- getAttr "outputHashAlgo" $ extractNoCtx
-          digest <- lift $ either (throwError . ErrorCall) pure $ Store.mkNamedDigest hashType hash
-          pure $ pure digest
+      mFixedOutput <-
+        maybe
+          (pure Nothing)
+          (\ hash -> do
+            when (outputs /= ["out"]) $ lift $ throwError $ ErrorCall $ "Multiple outputs are not supported for fixed-output derivations"
+            hashType <- getAttr "outputHashAlgo" extractNoCtx
+            digest <- lift $ either (throwError . ErrorCall) pure $ Store.mkNamedDigest hashType hash
+            pure $ pure digest)
+          mHash
 
       -- filter out null values if needed.
       attrs <- if not ignoreNulls
@@ -332,10 +335,11 @@ buildDerivationWithContext drvAttrs = do
 
       pure $ defaultDerivation { platform, builder, args, env,  hashMode, useJson
         , name = drvName
-        , outputs = Map.fromList $ fmap (\o -> (o, "")) outputs
+        , outputs = Map.fromList $ fmap (, mempty) outputs
         , mFixed = mFixedOutput
         }
   where
+
     -- common functions, lifted to WithStringContextT
 
     demand' :: NValue t f m -> (NValue t f m -> WithStringContextT m a) -> WithStringContextT m a
@@ -373,9 +377,11 @@ buildDerivationWithContext drvAttrs = do
       pure name
 
     extractNoCtx :: MonadNix e t f m => NixString -> WithStringContextT m Text
-    extractNoCtx ns = case getStringNoContext ns of
-      Nothing -> lift $ throwError $ ErrorCall $ "The string " <> show ns <> " is not allowed to have a context."
-      Just v -> pure v
+    extractNoCtx ns =
+      maybe
+        (lift $ throwError $ ErrorCall $ "The string " <> show ns <> " is not allowed to have a context.")
+        pure
+        (getStringNoContext ns)
 
     assertNonNull :: MonadNix e t f m => Text -> WithStringContextT m Text
     assertNonNull t = do

From 3b36911e3baeb4b627f47d981dbc7f6cadf1e2b0 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 13:39:36 +0200
Subject: [PATCH 11/26] Exec: refactor

---
 src/Nix/Exec.hs | 55 +++++++++++++++++++++++++++++++------------------
 1 file changed, 35 insertions(+), 20 deletions(-)

diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index 3329c1c9e..1570b6193 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -31,6 +31,7 @@ import           Control.Monad
 import           Control.Monad.Catch     hiding ( catchJust )
 import           Control.Monad.Fix
 import           Control.Monad.Reader
+import           Data.Bool                      ( bool )
 import           Data.Fix
 import qualified Data.HashMap.Lazy             as M
 import           Data.List
@@ -344,32 +345,46 @@ 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   -> rarg >>= \rval -> valueEqM lval rval >>= boolOp rval
-  NNEq  -> rarg >>= \rval -> valueEqM lval rval >>= boolOp rval . not
-  NOr   -> fromValue lval >>= \l -> if l
-             then bypass True
-             else rarg >>= \rval -> fromValue rval >>= boolOp rval
-  NAnd  -> fromValue lval >>= \l -> if l
-             then rarg >>= \rval -> fromValue rval >>= boolOp rval
-             else bypass False
-  NImpl -> fromValue lval >>= \l -> if l
-             then rarg >>= \rval -> fromValue rval >>= boolOp rval
-             else bypass True
-  _     -> rarg >>= \rval ->
-             demand rval $ \rval' ->
-               demand lval $ \lval' ->
-                 execBinaryOpForced scope span op lval' rval'
+  NEq   -> helperEq id
+  NNEq  -> helperEq not
+  NOr   ->
+    helperLogic flip True
+  NAnd  ->
+    helperLogic id False
+  NImpl ->
+    helperLogic id True
+  _     -> rarg >>=
+    (\rval ->
+      demand
+      (\rval' ->
+        demand
+          (\lval' -> execBinaryOpForced scope span op lval' rval')
+          lval
+      )
+      rval)
 
  where
-  toBoolOp :: Maybe (NValue t f m) -> Bool -> m (NValue t f m)
-  toBoolOp r b = pure $ nvConstantP
-    (Provenance scope (NBinary_ span op (pure lval) r))
-    (NBool b)
+
+  helperEq flag = rarg >>= \rval -> valueEqM lval rval >>= boolOp rval . flag
+
+  helperLogic flp flag =
+    fromValue lval >>=
+      flp bool
+        (bypass flag)
+        (rarg >>= \rval -> fromValue rval >>= boolOp rval)
+
   boolOp rval = toBoolOp (pure rval)
+
   bypass      = toBoolOp Nothing
 
+  toBoolOp :: Maybe (NValue t f m) -> Bool -> m (NValue t f m)
+  toBoolOp r b =
+    pure $
+      nvConstantP
+        (Provenance scope (NBinary_ span op (pure lval) r))
+        (NBool b)
 
 execBinaryOpForced
   :: forall e t f m

From d23e0b2164b3d7b89897ce157beaddaf8785beac Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:35:50 +0200
Subject: [PATCH 12/26] Nix.Lint: m refactor

---
 src/Nix/Lint.hs | 25 ++++++++++++++-----------
 1 file changed, 14 insertions(+), 11 deletions(-)

diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index 13e5015d5..716d222ae 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -26,6 +26,7 @@ import           Control.Monad.Reader           ( MonadReader )
 import           Control.Monad.Ref
 import           Control.Monad.ST
 import           Control.Monad.Trans.Reader
+import           Data.Bool                      ( bool )
 import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
 import           Data.List
@@ -132,11 +133,11 @@ renderSymbolic :: MonadLint e m => Symbolic m -> m String
 renderSymbolic = unpackSymbolic >=> \case
   NAny     -> pure "<any>"
   NMany xs -> fmap (intercalate ", ") $ forM xs $ \case
-    TConstant ys -> fmap (intercalate ", ") $ forM ys $ \case
-      TInt   -> pure "int"
-      TFloat -> pure "float"
-      TBool  -> pure "bool"
-      TNull  -> pure "null"
+    TConstant ys -> fmap (intercalate ", ") $ forM ys $ pure . \case
+      TInt   -> "int"
+      TFloat -> "float"
+      TBool  -> "bool"
+      TNull  -> "null"
     TStr    -> pure "string"
     TList r -> do
       x <- demand r renderSymbolic
@@ -238,17 +239,19 @@ unify context (SV x) (SV y) = do
       pure $ SV x
     (NMany xs, NMany ys) -> do
       m <- merge context xs ys
-      if null m
-        then do
+      bool
+        (do
+          writeVar x (NMany m)
+          writeVar y (NMany m)
+          packSymbolic (NMany m))
+        (do
               -- x' <- renderSymbolic (Symbolic x)
               -- y' <- renderSymbolic (Symbolic y)
           throwError $ ErrorCall "Cannot unify "
                   -- <> show x' <> " with " <> show y'
                   --  <> " in context: " <> show context
-        else do
-          writeVar x (NMany m)
-          writeVar y (NMany m)
-          packSymbolic (NMany m)
+        )
+        (null m)
 unify _ _ _ = error "The unexpected hath transpired!"
 
 -- These aren't worth defining yet, because once we move to Hindley-Milner,

From 540e1141d1bd964e6e9930d22887c1b65bd3cd0c Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:36:47 +0200
Subject: [PATCH 13/26] Main: m refactor

---
 main/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/main/Main.hs b/main/Main.hs
index 9b6bd9433..5db17f53b 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -180,7 +180,7 @@ main = do
                 val <- readVar @(StandardT (StdIdT IO)) ref
                 case val of
                   Computed _    -> pure (k, Nothing)
-                  _ | descend   -> fmap (k,        ) $ forceEntry path nv
+                  _ | descend   -> (k,        ) <$> forceEntry path nv
                     | otherwise -> pure (k, Nothing)
               )
               (\ v -> pure (k, pure (Free v)))

From 7250ab098c1515a2179b58ce10be897f4bc16ff1 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 14:11:24 +0200
Subject: [PATCH 14/26] Main: refactor

---
 main/Main.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/main/Main.hs b/main/Main.hs
index 5db17f53b..84e025ff7 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -74,13 +74,11 @@ main = do
 
   handleResult opts mpath = \case
     Failure err ->
-      (bool
+      bool
         errorWithoutStackTrace
         (liftIO . hPutStrLn stderr)
         (ignoreErrors opts)
-        )
-        $  "Parse failed: "
-        <> show err
+        $ "Parse failed: " <> show err
 
     Success expr -> do
       when (check opts) $ do

From 188f9c56b0e47793b008c5bc0bb35db562e29887 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 14:19:54 +0200
Subject: [PATCH 15/26] {Eval,Effects.Derivation}: refactor

---
 src/Nix/Effects/Derivation.hs | 18 ++++++++++++------
 src/Nix/Eval.hs               |  7 ++++---
 2 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index 4733e4d35..0acc96cc6 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -316,12 +316,18 @@ buildDerivationWithContext drvAttrs = do
           mHash
 
       -- filter out null values if needed.
-      attrs <- if not ignoreNulls
-        then pure drvAttrs
-        else M.mapMaybe id <$> forM drvAttrs (demand' ?? (\case
-            NVConstant NNull -> pure Nothing
-            value -> pure $ pure value
-          ))
+      attrs <-
+        bool
+          (pure drvAttrs)
+          (M.mapMaybe id <$> forM drvAttrs
+            (demand'
+              (pure . \case
+                NVConstant NNull -> Nothing
+                value -> pure value
+              )
+            )
+          )
+          ignoreNulls
 
       env <- if useJson
         then do
diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 3f4777b91..96f78090c 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -355,9 +355,10 @@ evalSetterKeyName
 evalSetterKeyName = \case
   StaticKey k -> pure (pure k)
   DynamicKey k ->
-    runAntiquoted "\n" assembleString (>>= fromValueMay) k <&> \case
-      Just ns -> Just (stringIgnoreContext ns)
-      _       -> mempty
+    runAntiquoted "\n" assembleString (>>= fromValueMay) k <&>
+      maybe
+        mempty
+        (pure . stringIgnoreContext)
 
 assembleString
   :: forall v m

From 0e4c28e63a211a90f27e53806ca2dc01844af4f9 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 14:41:39 +0200
Subject: [PATCH 16/26] Effects.Basic: refactor

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

diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs
index 399ec2d80..a131b2f84 100644
--- a/src/Nix/Effects/Basic.hs
+++ b/src/Nix/Effects/Basic.hs
@@ -103,11 +103,17 @@ findEnvPathM name = do
   nixFilePath path = do
     absPath <- makeAbsolutePath @t @f path
     isDir   <- doesDirectoryExist absPath
-    absFile <- if isDir
-      then makeAbsolutePath @t @f $ absPath </> "default.nix"
-      else pure absPath
+    absFile <-
+      bool
+        (pure absPath)
+        (makeAbsolutePath @t @f $ absPath </> "default.nix")
+        isDir
     exists <- doesFileExist absFile
-    pure $ if exists then pure absFile else mempty
+    pure $
+      bool
+        mempty
+        (pure absFile)
+        exists
 
 findPathBy
   :: forall e t f m
@@ -118,15 +124,10 @@ findPathBy
   -> m FilePath
 findPathBy finder ls name = do
   mpath <- foldM go mempty ls
-  case mpath of
-    Nothing ->
-      throwError
-        $  ErrorCall
-        $  "file '"
-        <> name
-        <> "' was not found in the Nix search path"
-        <> " (add it's using $NIX_PATH or -I)"
-    Just path -> pure path
+  maybe
+    (throwError $ ErrorCall $ "file '" <> name <> "' was not found in the Nix search path (add it's using $NIX_PATH or -I)")
+    pure
+    mpath
  where
   go :: Maybe FilePath -> NValue t f m -> m (Maybe FilePath)
   go p@(Just _) _ = pure p
@@ -147,16 +148,15 @@ findPathBy finder ls name = do
     finder $ p <///> joinPath ns
   tryPath p _ = finder $ p <///> name
 
-  resolvePath s = case M.lookup "path" s of
-    Just t  -> pure t
-    Nothing -> case M.lookup "uri" s of
-      Just ut -> defer $ fetchTarball ut
-      Nothing ->
-        throwError
-          $  ErrorCall
-          $  "__nixPath must be a list of attr sets"
-          <> " with 'path' elements, but received: "
-          <> show s
+  resolvePath s =
+    maybe
+      (maybe
+        (throwError $ ErrorCall $ "__nixPath must be a list of attr sets with 'path' elements, but received: " <> show s)
+        (defer . fetchTarball)
+        (M.lookup "uri" s)
+      )
+      pure
+      (M.lookup "path" s)
 
 fetchTarball
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)

From c1f08738c49200da9f824bd4dfde7cb96c15f65c Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:38:47 +0200
Subject: [PATCH 17/26] Nix.Builtins: m refactor

---
 src/Nix/Builtins.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 3a1b19704..620bacea0 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -1449,19 +1449,21 @@ fetchurl v = demand v $ \case
  where
   go :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
   go _msha = \case
-    NVStr ns -> noContextAttrs ns >>= getURL >>= \case -- msha
-      Left  e -> throwError e
-      Right p -> toValue p
+    NVStr ns -> noContextAttrs ns >>= getURL >>=
+      either -- msha
+        throwError
+        toValue
     v ->
       throwError
         $  ErrorCall
         $  "builtins.fetchurl: Expected URI or string, got "
         <> show v
 
-  noContextAttrs ns = case getStringNoContext ns of
-    Nothing ->
-      throwError $ ErrorCall $ "builtins.fetchurl: unsupported arguments to url"
-    Just t -> pure t
+  noContextAttrs ns =
+    maybe
+      (throwError $ ErrorCall $ "builtins.fetchurl: unsupported arguments to url")
+      pure
+      (getStringNoContext ns)
 
 partition_
   :: forall e t f m

From 3f15ab24cfdbd15bad4480448435286066b36595 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 14:49:02 +0200
Subject: [PATCH 18/26] Builtins: refactor

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

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 620bacea0..a362693e2 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -369,10 +369,11 @@ hasAttr x y = fromValue x >>= fromStringNoContext >>= \key ->
     >>= \(aset, _) -> toValue $ M.member key aset
 
 attrsetGet :: MonadNix e t f m => Text -> AttrSet (NValue t f m) -> m (NValue t f m)
-attrsetGet k s = case M.lookup k s of
-  Just v -> pure v
-  Nothing ->
-    throwError $ ErrorCall $ "Attribute '" <> Text.unpack k <> "' required"
+attrsetGet k s =
+  maybe
+    (throwError $ ErrorCall $ "Attribute '" <> Text.unpack k <> "' required")
+    pure
+    (M.lookup k s)
 
 hasContext :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 hasContext = toValue . stringHasContext <=< fromValue
@@ -453,7 +454,10 @@ anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 anyM _ []       = pure False
 anyM p (x : xs) = do
   q <- p x
-  if q then pure True else anyM p xs
+  bool
+    (anyM p xs)
+    (pure True)
+    q
 
 any_
   :: MonadNix e t f m
@@ -466,7 +470,10 @@ allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 allM _ []       = pure True
 allM p (x : xs) = do
   q <- p x
-  if q then allM p xs else pure False
+  bool
+    (pure False)
+    (allM p xs)
+    q
 
 all_
   :: MonadNix e t f m
@@ -637,7 +644,7 @@ split_ pat str = fromValue pat >>= fromStringNoContext >>= \p ->
     let re       = makeRegex (encodeUtf8 p) :: Regex
         haystack = encodeUtf8 s
     pure $ nvList $ splitMatches 0
-                                   (fmap elems $ matchAllText re haystack)
+                                   (elems <$> matchAllText re haystack)
                                    haystack
 
 splitMatches

From 95d9513dad101c2d6d701b0d595c054fdbb1ba78 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:40:04 +0200
Subject: [PATCH 19/26] Nix.Builtins: m refactor

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

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index a362693e2..ad7d64562 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -789,7 +789,7 @@ builtinsBuiltin
   :: forall e t f m
    . MonadNix e t f m
   => m (NValue t f m)
-builtinsBuiltin = (throwError $ ErrorCall "HNix does not provide builtins.builtins at the moment. Using builtins directly should be preferred")
+builtinsBuiltin = throwError $ ErrorCall "HNix does not provide builtins.builtins at the moment. Using builtins directly should be preferred"
 
 dirOf :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 dirOf x = demand x $ \case
@@ -804,8 +804,7 @@ unsafeDiscardStringContext
   :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 unsafeDiscardStringContext mnv = do
   ns <- fromValue mnv
-  toValue $ makeNixStringWithoutContext $ stringIgnoreContext
-    ns
+  toValue $ makeNixStringWithoutContext $ stringIgnoreContext ns
 
 seq_
   :: MonadNix e t f m
@@ -1163,7 +1162,7 @@ scopedImport asetArg pathArg = fromValue @(AttrSet (NValue t f m)) asetArg >>= \
 getEnv_ :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 getEnv_ = fromValue >=> fromStringNoContext >=> \s -> do
   mres <- getEnvVar (Text.unpack s)
-  toValue $ makeNixStringWithoutContext $ maybe "" Text.pack mres
+  toValue $ makeNixStringWithoutContext $ maybe mempty Text.pack mres
 
 sort_
   :: MonadNix e t f m
@@ -1297,12 +1296,7 @@ absolutePathFromValue :: MonadNix e t f m => NValue t f m -> m FilePath
 absolutePathFromValue = \case
   NVStr ns -> do
     let path = Text.unpack $ stringIgnoreContext ns
-    unless (isAbsolute path)
-      $  throwError
-      $  ErrorCall
-      $  "string "
-      <> show path
-      <> " doesn't represent an absolute path"
+    unless (isAbsolute path) $ throwError $ ErrorCall $ "string " <> show path <> " doesn't represent an absolute path"
     pure path
   NVPath path -> pure path
   v           -> throwError $ ErrorCall $ "expected a path, got " <> show v

From 032ed914de8ee296c684a0d9a015c5ad75e183ba Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 14:54:35 +0200
Subject: [PATCH 20/26] Builtins: m refactor

---
 src/Nix/Builtins.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index ad7d64562..8ce738993 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -1173,13 +1173,16 @@ sort_ comp = fromValue >=> sortByM (cmp comp) >=> toValue
  where
   cmp f a b = do
     isLessThan <- f `callFunc` a >>= (`callFunc` b)
-    fromValue isLessThan >>= \case
-      True  -> pure LT
-      False -> do
-        isGreaterThan <- f `callFunc` b >>= (`callFunc` a)
-        fromValue isGreaterThan <&> \case
-          True  -> GT
-          False -> EQ
+    fromValue isLessThan >>=
+      bool
+        (do
+          isGreaterThan <- f `callFunc` b >>= (`callFunc` a)
+          fromValue isGreaterThan <&>
+            bool
+              EQ
+              GT
+        )
+        (pure LT)
 
 lessThan
   :: MonadNix e t f m

From dab2633105b794be035e13dc9e4152b8891fc7bd Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 15:10:24 +0200
Subject: [PATCH 21/26] Builtins: m refactor

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

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 8ce738993..38e9b133b 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -840,15 +840,10 @@ elemAt_
   -> NValue t f m
   -> m (NValue t f m)
 elemAt_ xs n = fromValue n >>= \n' -> fromValue xs >>= \xs' ->
-  case elemAt xs' n' of
-    Just a -> pure a
-    Nothing ->
-      throwError
-        $  ErrorCall
-        $  "builtins.elem: Index "
-        <> show n'
-        <> " too large for list of length "
-        <> show (length xs')
+  maybe
+    (throwError $ ErrorCall $ "builtins.elem: Index " <> show n' <> " too large for list of length " <> show (length xs'))
+    pure
+    (elemAt xs' n')
 
 genList
   :: forall e t f m

From 4b9608ba31c42038312aa7c9fc1148f8902be937 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 15:10:46 +0200
Subject: [PATCH 22/26] Builtins: m refactor

---
 src/Nix/Builtins.hs | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 38e9b133b..d48e2c55b 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -851,13 +851,11 @@ genList
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-genList f = fromValue @Integer >=> \n -> if n >= 0
-  then toValue =<< forM [0 .. n - 1] (\i -> defer $ (f `callFunc`) =<< toValue i)
-  else
-    throwError
-    $  ErrorCall
-    $  "builtins.genList: Expected a non-negative number, got "
-    <> show n
+genList f = fromValue @Integer >=> \n ->
+  bool
+    (throwError $ ErrorCall $ "builtins.genList: Expected a non-negative number, got " <> show n)
+    (toValue =<< forM [0 .. n - 1] (\i -> defer $ (f `callFunc`) =<< toValue i))
+    (n >= 0)
 
 -- We wrap values solely to provide an Ord instance for genericClosure
 newtype WValue t f m = WValue (NValue t f m)

From 63bc517b3beedfcb4ed5ad3527120f25654c5136 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 16:28:04 +0200
Subject: [PATCH 23/26] Builtins: m refactor

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

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index d48e2c55b..1dd1eca04 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -888,19 +888,9 @@ genericClosure
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 genericClosure = fromValue @(AttrSet (NValue t f m)) >=> \s ->
   case (M.lookup "startSet" s, M.lookup "operator" s) of
-    (Nothing, Nothing) ->
-      throwError
-        $  ErrorCall
-        $  "builtins.genericClosure: "
-        <> "Attributes 'startSet' and 'operator' required"
-    (Nothing, Just _) ->
-      throwError
-        $ ErrorCall
-        $ "builtins.genericClosure: Attribute 'startSet' required"
-    (Just _, Nothing) ->
-      throwError
-        $ ErrorCall
-        $ "builtins.genericClosure: Attribute 'operator' required"
+    (Nothing    , Nothing        ) -> throwError $ ErrorCall $ "builtins.genericClosure: Attributes 'startSet' and 'operator' required"
+    (Nothing    , Just _         ) -> throwError $ ErrorCall $ "builtins.genericClosure: Attribute 'startSet' required"
+    (Just _     , Nothing        ) -> throwError $ ErrorCall $ "builtins.genericClosure: Attribute 'operator' required"
     (Just startSet, Just operator) ->
       demand startSet $ fromValue @[NValue t f m] >=> \ss ->
         demand operator $ \op -> toValue @[NValue t f m] =<< snd <$> go op ss S.empty

From cc264959de6ea7422d209817ae1c1efed98f899e Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 16:48:57 +0200
Subject: [PATCH 24/26] Builtins: m refactor

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

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 1dd1eca04..2d6bb40e4 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -337,23 +337,26 @@ foldNixPath f z = do
     _ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " <> show x
 
 nixPath :: MonadNix e t f m => m (NValue t f m)
-nixPath = fmap nvList $ flip foldNixPath mempty $ \p mn ty rest ->
-  pure
-    $ flip nvSet mempty ( M.fromList
-        [ case ty of
-          PathEntryPath -> ("path", nvPath p)
-          PathEntryURI ->
-            ( "uri"
-            , nvStr $ makeNixStringWithoutContext $ Text.pack p
+nixPath = fmap nvList $ flip foldNixPath mempty $
+  \p mn ty rest ->
+    pure $
+      flip nvSet
+        mempty
+        (M.fromList
+          [ case ty of
+            PathEntryPath -> ("path", nvPath p)
+            PathEntryURI ->
+              ( "uri"
+              , nvStr $ makeNixStringWithoutContext $ Text.pack p
+              )
+
+          , ( "prefix"
+            , nvStr
+              $ makeNixStringWithoutContext $ Text.pack $ fromMaybe "" mn
             )
-
-        , ( "prefix"
-          , nvStr
-            $ makeNixStringWithoutContext $ Text.pack $ fromMaybe "" mn
-          )
-        ]
-      )
-    : rest
+          ]
+        )
+      : rest
 
 toString :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 toString = coerceToString callFunc DontCopyToStore CoerceAny >=> toValue

From bf3e44787a56fd8c6db7df8a9c4ee82fd93389f3 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 17:26:50 +0200
Subject: [PATCH 25/26] treewide: unflip the `class MonadValue` `demand` & all
 its implementation

Argument order change has functional argument - so it is not possible to
elegantly switch into new code, and requires to go though transition.

So doing the work while doing needed refactoring at the same time.

This style of code currenly may seem more noizy, but really it is more
straight-forward, it mentions only operations & transformatios, types can be
looked in the HLS.

With the future work https://github.com/haskell-nix/hnix/issues/850
this style of the code would radically start to simplify itself, so please bear
with me.
---
 main/Main.hs                  |   2 +-
 main/Repl.hs                  |  11 +-
 src/Nix.hs                    |  61 ++--
 src/Nix/Builtins.hs           | 520 ++++++++++++++++++++--------------
 src/Nix/Convert.hs            |  24 +-
 src/Nix/Effects/Basic.hs      | 107 ++++---
 src/Nix/Effects/Derivation.hs |   4 +-
 src/Nix/Eval.hs               |  54 ++--
 src/Nix/Exec.hs               |  29 +-
 src/Nix/Json.hs               |  14 +-
 src/Nix/Lint.hs               |  48 ++--
 src/Nix/Standard.hs           |  12 +-
 src/Nix/String/Coerce.hs      |  51 ++--
 src/Nix/Type/Infer.hs         |  18 +-
 src/Nix/Value/Monad.hs        |   2 +-
 15 files changed, 552 insertions(+), 405 deletions(-)

diff --git a/main/Main.hs b/main/Main.hs
index 84e025ff7..5385bec7b 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -215,7 +215,7 @@ main = do
             _                              -> (True, True)
 
           forceEntry k v =
-            catch (pure <$> demand v pure) $ \(NixException frames) -> do
+            catch (pure <$> demand pure v) $ \(NixException frames) -> do
               liftIO
                 .   putStrLn
                 .   ("Exception forcing " <>)
diff --git a/main/Repl.hs b/main/Repl.hs
index 7143f82e1..da4a4be49 100644
--- a/main/Repl.hs
+++ b/main/Repl.hs
@@ -27,7 +27,7 @@ import           Nix                     hiding ( exec
                                                 )
 import           Nix.Scope
 import           Nix.Utils
-import           Nix.Value.Monad                (demand)
+import           Nix.Value.Monad                ( demand )
 
 import qualified Data.List
 import qualified Data.Maybe
@@ -395,11 +395,10 @@ completeFunc reversedPrev word
               -- Stop on last subField (we care about the keys at this level)
               [_] -> pure $ keys m
               f:fs ->
-                case Data.HashMap.Lazy.lookup f m of
-                  Nothing -> pure mempty
-                  Just e ->
-                    demand e
-                      (\e' -> (fmap . fmap) (("." <> f) <>) $ algebraicComplete fs e')
+                maybe
+                  (pure mempty)
+                  (demand (\e' -> (fmap . fmap) (("." <> f) <>) $ algebraicComplete fs e'))
+                  (Data.HashMap.Lazy.lookup f m)
 
       in case val of
         NVSet xs _ -> withMap xs
diff --git a/src/Nix.hs b/src/Nix.hs
index f443a3342..5117d9c41 100644
--- a/src/Nix.hs
+++ b/src/Nix.hs
@@ -110,10 +110,14 @@ evaluateExpression mpath evaluator handler expr = do
   args <- traverse (traverse eval') $ fmap (second parseArg) (arg opts) <> fmap
     (second mkStr)
     (argstr opts)
-  evaluator mpath expr >>= \f -> demand f $ \f' ->
-    processResult handler =<< case f' of
-      NVClosure _ g -> g (argmap args)
-      _             -> pure f
+  evaluator mpath expr >>= \f ->
+    demand
+      (\f' ->
+        processResult handler =<< case f' of
+          NVClosure _ g -> g (argmap args)
+          _             -> pure f
+      )
+      f
  where
   parseArg s = case parseNixText s of
     Success x   -> x
@@ -137,29 +141,26 @@ processResult h val = do
  where
   go :: [Text.Text] -> NValue t f m -> m a
   go [] v = h v
-  go ((Text.decimal -> Right (n,"")) : ks) v = demand v $ \case
-    NVList xs -> case ks of
-      [] -> h (xs !! n)
-      _  -> go ks (xs !! n)
-    _ ->
-      errorWithoutStackTrace
-        $  "Expected a list for selector '"
-        <> show n
-        <> "', but got: "
-        <> show v
-  go (k : ks) v = demand v $ \case
-    NVSet xs _ -> case M.lookup k xs of
-      Nothing ->
-        errorWithoutStackTrace
-          $  "Set does not contain key '"
-          <> Text.unpack k
-          <> "'"
-      Just v' -> case ks of
-        [] -> h v'
-        _  -> go ks v'
-    _ ->
-      errorWithoutStackTrace
-        $  "Expected a set for selector '"
-        <> Text.unpack k
-        <> "', but got: "
-        <> show v
+  go ((Text.decimal -> Right (n,"")) : ks) v =
+    demand
+      (\case
+        NVList xs ->
+          case ks of
+            [] -> h (xs !! n)
+            _  -> go ks (xs !! n)
+        _ -> errorWithoutStackTrace $ "Expected a list for selector '" <> show n <> "', but got: " <> show v
+      )
+      v
+  go (k : ks) v =
+    demand
+      (\case
+        NVSet xs _ ->
+          maybe
+            (errorWithoutStackTrace $ "Set does not contain key '" <> Text.unpack k <> "'")
+            (case ks of
+              [] -> h
+              _  -> go ks)
+          (M.lookup k xs)
+        _ -> errorWithoutStackTrace $ "Expected a set for selector '" <> Text.unpack k <> "', but got: " <> show v
+      )
+      v
diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 2d6bb40e4..f82bcdc7e 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -316,9 +316,11 @@ foldNixPath
   -> m r
 foldNixPath f z = do
   mres <- lookupVar "__includes"
-  dirs <- case mres of
-    Nothing -> pure mempty
-    Just v  -> demand v $ fromValue . Deeper
+  dirs <-
+    maybe
+      (pure mempty)
+      (demand (fromValue . Deeper))
+      mres
   mPath <- getEnvVar "NIX_PATH"
   mDataDir <- getEnvVar "NIX_DATA_DIR"
   dataDir <- maybe getDataDir pure mDataDir
@@ -397,16 +399,21 @@ unsafeGetAttrPos
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-unsafeGetAttrPos x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
-  (NVStr ns, NVSet _ apos) ->
-    case M.lookup (stringIgnoreContext ns) apos of
-      Nothing    -> pure $ nvConstant NNull
-      Just delta -> toValue delta
-  (x, y) ->
-    throwError
-      $  ErrorCall
-      $  "Invalid types for builtins.unsafeGetAttrPos: "
-      <> show (x, y)
+unsafeGetAttrPos x y =
+  demand
+    (\x' ->
+       demand
+        (\y' -> case (x', y') of
+          (NVStr ns, NVSet _ apos) ->
+            maybe
+              (pure $ nvConstant NNull)
+              toValue
+              (M.lookup (stringIgnoreContext ns) apos)
+          (x, y) -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPos: " <> show (x, y)
+        )
+        y
+    )
+    x
 
 -- This function is a bit special in that it doesn't care about the contents
 -- of the list.
@@ -419,39 +426,63 @@ add_
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-add_ x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
-  (NVConstant (NInt   x), NVConstant (NInt y)  ) -> toValue (x + y :: Integer)
-  (NVConstant (NFloat x), NVConstant (NInt y)  ) -> toValue (x + fromInteger y)
-  (NVConstant (NInt   x), NVConstant (NFloat y)) -> toValue (fromInteger x + y)
-  (NVConstant (NFloat x), NVConstant (NFloat y)) -> toValue (x + y)
-  (_                    , _                    ) -> throwError $ Addition x' y'
+add_ x y =
+  demand
+    (\x' ->
+      demand
+        (\y' ->
+          case (x', y') of
+            (NVConstant (NInt   x), NVConstant (NInt   y)) -> toValue (x + y :: Integer)
+            (NVConstant (NFloat x), NVConstant (NInt   y)) -> toValue (x + fromInteger y)
+            (NVConstant (NInt   x), NVConstant (NFloat y)) -> toValue (fromInteger x + y)
+            (NVConstant (NFloat x), NVConstant (NFloat y)) -> toValue (x + y)
+            (_                    , _                    ) -> throwError $ Addition x' y'
+        )
+        y
+    )
+    x
 
 mul_
   :: MonadNix e t f m
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-mul_ x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
-  (NVConstant (NInt   x), NVConstant (NInt y)  ) -> toValue (x * y :: Integer)
-  (NVConstant (NFloat x), NVConstant (NInt y)  ) -> toValue (x * fromInteger y)
-  (NVConstant (NInt   x), NVConstant (NFloat y)) -> toValue (fromInteger x * y)
-  (NVConstant (NFloat x), NVConstant (NFloat y)) -> toValue (x * y)
-  (_, _) -> throwError $ Multiplication x' y'
+mul_ x y =
+  demand
+    (\x' ->
+      demand
+        (\y' ->
+          case (x', y') of
+            (NVConstant (NInt   x), NVConstant (NInt y)  ) -> toValue (x * y :: Integer)
+            (NVConstant (NFloat x), NVConstant (NInt y)  ) -> toValue (x * fromInteger y)
+            (NVConstant (NInt   x), NVConstant (NFloat y)) -> toValue (fromInteger x * y)
+            (NVConstant (NFloat x), NVConstant (NFloat y)) -> toValue (x * y)
+            (_, _) -> throwError $ Multiplication x' y'
+        )
+        y
+    )
+    x
 
 div_
   :: MonadNix e t f m
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-div_ x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
-  (NVConstant (NInt x), NVConstant (NInt y)) | y /= 0 ->
-    toValue (floor (fromInteger x / fromInteger y :: Double) :: Integer)
-  (NVConstant (NFloat x), NVConstant (NInt y)) | y /= 0 ->
-    toValue (x / fromInteger y)
-  (NVConstant (NInt x), NVConstant (NFloat y)) | y /= 0 ->
-    toValue (fromInteger x / y)
-  (NVConstant (NFloat x), NVConstant (NFloat y)) | y /= 0 -> toValue (x / y)
-  (_, _) -> throwError $ Division x' y'
+div_ x y =
+  demand
+    (\x' ->
+      demand
+        (\y' ->
+          case (x', y') of
+            (NVConstant (NInt   x), NVConstant (NInt   y)) | y /= 0 -> toValue $ (floor (fromInteger x / fromInteger y :: Double) :: Integer)
+            (NVConstant (NFloat x), NVConstant (NInt   y)) | y /= 0 -> toValue $                     x / fromInteger y
+            (NVConstant (NInt   x), NVConstant (NFloat y)) | y /= 0 -> toValue $         fromInteger x / y
+            (NVConstant (NFloat x), NVConstant (NFloat y)) | y /= 0 -> toValue $                     x / y
+            (x'                   , y'                   )          -> throwError $ Division x' y'
+        )
+        y
+    )
+    x
 
 anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 anyM _ []       = pure False
@@ -753,7 +784,7 @@ catAttrs attrName xs = fromValue attrName >>= fromStringNoContext >>= \n ->
     fmap (nvList . catMaybes)
       $ forM l
       $ fmap (M.lookup n)
-      . flip demand fromValue
+      . demand fromValue
 
 baseNameOf :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 baseNameOf x = do
@@ -795,12 +826,13 @@ builtinsBuiltin
 builtinsBuiltin = throwError $ ErrorCall "HNix does not provide builtins.builtins at the moment. Using builtins directly should be preferred"
 
 dirOf :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-dirOf x = demand x $ \case
-  NVStr ns -> pure $ nvStr
-    (modifyNixContents (Text.pack . takeDirectory . Text.unpack) ns)
-  NVPath path -> pure $ nvPath $ takeDirectory path
-  v ->
-    throwError $ ErrorCall $ "dirOf: expected string or path, got " <> show v
+dirOf =
+  demand
+    (\case
+      NVStr ns -> pure $ nvStr $ modifyNixContents (Text.pack . takeDirectory . Text.unpack) ns
+      NVPath path -> pure $ nvPath $ takeDirectory path
+      v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " <> show v
+    )
 
 -- jww (2018-04-28): This should only be a string argument, and not coerced?
 unsafeDiscardStringContext
@@ -814,7 +846,7 @@ seq_
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-seq_ a b = demand a $ \_ -> pure b
+seq_ a b = demand (const $ pure b) a
 
 -- | We evaluate 'a' only for its effects, so data cycles are ignored.
 deepSeq
@@ -895,26 +927,46 @@ genericClosure = fromValue @(AttrSet (NValue t f m)) >=> \s ->
     (Nothing    , Just _         ) -> throwError $ ErrorCall $ "builtins.genericClosure: Attribute 'startSet' required"
     (Just _     , Nothing        ) -> throwError $ ErrorCall $ "builtins.genericClosure: Attribute 'operator' required"
     (Just startSet, Just operator) ->
-      demand startSet $ fromValue @[NValue t f m] >=> \ss ->
-        demand operator $ \op -> toValue @[NValue t f m] =<< snd <$> go op ss S.empty
+      demand
+        (fromValue @[NValue t f m] >=>
+         (\ss ->
+          demand
+            (\op -> toValue @[NValue t f m] =<< snd <$> go op S.empty ss)
+            operator
+         )
+        )
+        startSet
  where
   go
     :: NValue t f m
-    -> [NValue t f m]
     -> Set (WValue t f m)
+    -> [NValue t f m]
     -> m (Set (WValue t f m), [NValue t f m])
-  go _  []       ks = pure (ks, mempty)
-  go op (t : ts) ks = demand t $ \v -> fromValue @(AttrSet (NValue t f m)) v >>= \s -> do
-    k <- attrsetGet "key" s
-    demand k $ \k' -> do
-      if S.member (WValue k') ks
-        then go op ts ks
-        else do
-          ys <- fromValue @[NValue t f m] =<< (op `callFunc` v)
-          case S.toList ks of
-            []           -> checkComparable k' k'
-            WValue j : _ -> checkComparable k' j
-          fmap (t :) <$> go op (ts <> ys) (S.insert (WValue k') ks)
+  go _  ks []       = pure (ks, mempty)
+  go op ks (t : ts) =
+    demand
+      (\v -> fromValue @(AttrSet (NValue t f m)) v >>=
+        (\s -> do
+          k <- attrsetGet "key" s
+          demand
+            (\k' -> do
+              bool
+                (do
+                  ys <- fromValue @[NValue t f m] =<< (op `callFunc` v)
+                  checkComparable k'
+                    (case S.toList ks of
+                      []           -> k'
+                      WValue j : _ -> j
+                    )
+                  fmap (t :) <$> go op (S.insert (WValue k') ks) (ts <> ys)
+                )
+                (go op ks ts)
+                (S.member (WValue k') ks)
+              )
+              k
+        )
+      )
+      t
 
 -- | Takes:
 -- 1. List of strings to match.
@@ -1032,16 +1084,16 @@ intersectAttrs set1 set2 =
 
 functionArgs
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-functionArgs fun = demand fun $ \case
-  NVClosure p _ ->
-    toValue @(AttrSet (NValue t f m)) $ nvConstant . NBool <$> case p of
-      Param name     -> M.singleton name False
-      ParamSet s _ _ -> isJust <$> M.fromList s
-  v ->
-    throwError
-      $  ErrorCall
-      $  "builtins.functionArgs: expected function, got "
-      <> show v
+functionArgs fun =
+  demand
+    (\case
+      NVClosure p _ ->
+        toValue @(AttrSet (NValue t f m)) $ nvConstant . NBool <$> case p of
+          Param name     -> M.singleton name False
+          ParamSet s _ _ -> isJust <$> M.fromList s
+      v -> throwError $ ErrorCall $ "builtins.functionArgs: expected function, got " <> show v
+    )
+    fun
 
 toFile
   :: MonadNix e t f m
@@ -1061,14 +1113,14 @@ toPath :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 toPath = fromValue @Path >=> toValue @Path
 
 pathExists_ :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-pathExists_ path = demand path $ \case
-  NVPath p  -> toValue =<< pathExists p
-  NVStr  ns -> toValue =<< pathExists (Text.unpack (stringIgnoreContext ns))
-  v ->
-    throwError
-      $  ErrorCall
-      $  "builtins.pathExists: expected path, got "
-      <> show v
+pathExists_ =
+  demand
+    (
+     \case
+      NVPath p  -> toValue =<< pathExists p
+      NVStr  ns -> toValue =<< pathExists (Text.unpack $ stringIgnoreContext ns)
+      v -> throwError $ ErrorCall $ "builtins.pathExists: expected path, got " <> show v
+    )
 
 hasKind
   :: forall a e t f m
@@ -1105,14 +1157,20 @@ isNull = hasKind @()
 
 -- isString cannot use `hasKind` because it coerces derivations to strings.
 isString :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-isString v = demand v $ \case
-  NVStr{} -> toValue True
-  _       -> toValue False
+isString =
+  demand
+    (toValue . \case
+      NVStr{} -> True
+      _       -> False
+    )
 
 isFunction :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-isFunction func = demand func $ \case
-  NVClosure{} -> toValue True
-  _           -> toValue False
+isFunction =
+  demand
+    (toValue . \case
+      NVClosure{} -> True
+      _           -> False
+    )
 
 throw_ :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 throw_ mnv = do
@@ -1133,13 +1191,20 @@ scopedImport asetArg pathArg = fromValue @(AttrSet (NValue t f m)) asetArg >>= \
   fromValue pathArg >>= \(Path p) -> do
     path  <- pathToDefaultNix @t @f @m p
     mres  <- lookupVar "__cur_file"
-    path' <- case mres of
-      Nothing -> do
-        traceM "No known current directory"
-        pure path
-      Just p -> demand p $ fromValue >=> \(Path p') -> do
-        traceM $ "Current file being evaluated is: " <> show p'
-        pure $ takeDirectory p' </> path
+    path' <-
+      maybe
+        (do
+          traceM "No known current directory"
+          pure path
+        )
+        (demand
+          (fromValue >=> \(Path p') ->
+            do
+              traceM $ "Current file being evaluated is: " <> show p'
+              pure $ takeDirectory p' </> path
+          )
+        )
+        mres
     clearScopes @(NValue t f m)
       $ withNixContext (pure path')
       $ pushScope s
@@ -1175,31 +1240,33 @@ lessThan
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-lessThan ta tb = demand ta $ \va -> demand tb $ \vb -> do
-  let badType =
-        throwError
-          $  ErrorCall
-          $  "builtins.lessThan: expected two numbers or two strings, "
-          <> "got "
-          <> show va
-          <> " and "
-          <> show vb
-  nvConstant . NBool <$> case (va, vb) of
-    (NVConstant ca, NVConstant cb) -> case (ca, cb) of
-      (NInt   a, NInt b  ) -> pure $ a < b
-      (NFloat a, NInt b  ) -> pure $ a < fromInteger b
-      (NInt   a, NFloat b) -> pure $ fromInteger a < b
-      (NFloat a, NFloat b) -> pure $ a < b
-      _                    -> badType
-    (NVStr a, NVStr b) ->
-      pure $ stringIgnoreContext a < stringIgnoreContext b
-    _ -> badType
+lessThan ta tb =
+  demand
+    (\va ->
+      demand
+        (\vb -> do
+
+      let badType = throwError $ ErrorCall $ "builtins.lessThan: expected two numbers or two strings, " <> "got " <> show va <> " and " <> show vb
+
+      nvConstant . NBool <$> case (va, vb) of
+        (NVConstant ca, NVConstant cb) -> case (ca, cb) of
+          (NInt   a, NInt b  ) -> pure $ a < b
+          (NFloat a, NInt b  ) -> pure $ a < fromInteger b
+          (NInt   a, NFloat b) -> pure $ fromInteger a < b
+          (NFloat a, NFloat b) -> pure $ a < b
+          _                    -> badType
+        (NVStr a, NVStr b) -> pure $ stringIgnoreContext a < stringIgnoreContext b
+        _ -> badType
+        )
+        tb
+    )
+    ta
 
 concatLists
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 concatLists =
   fromValue @[NValue t f m]
-    >=> mapM (flip demand $ fromValue @[NValue t f m] >=> pure)
+    >=> mapM (demand $ fromValue @[NValue t f m] >=> pure)
     >=> toValue
     .   concat
 
@@ -1222,14 +1289,17 @@ listToAttrs
 listToAttrs = fromValue @[NValue t f m] >=> \l ->
   fmap (flip nvSet M.empty . M.fromList . reverse)
     $   forM l
-    $   flip demand
+    $   demand
     $   fromValue @(AttrSet (NValue t f m))
     >=> \s -> do
           t <- attrsetGet "name" s
-          demand t $ fromValue >=> \n -> do
-            name <- fromStringNoContext n
-            val  <- attrsetGet "value" s
-            pure (name, val)
+          demand
+            (fromValue >=> \n -> do
+              name <- fromStringNoContext n
+              val  <- attrsetGet "value" s
+              pure (name, val)
+            )
+            t
 
 -- prim_hashString from nix/src/libexpr/primops.cc
 -- fail if context in the algo arg
@@ -1291,8 +1361,7 @@ absolutePathFromValue = \case
   v           -> throwError $ ErrorCall $ "expected a path, got " <> show v
 
 readFile_ :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-readFile_ path = demand path $
-  absolutePathFromValue >=> Nix.Render.readFile >=> toValue
+readFile_ = demand (absolutePathFromValue >=> Nix.Render.readFile >=> toValue)
 
 findFile_
   :: forall e t f m
@@ -1300,17 +1369,22 @@ findFile_
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-findFile_ aset filePath = demand aset $ \aset' -> demand filePath $ \filePath' ->
-  case (aset', filePath') of
-    (NVList x, NVStr ns) -> do
-      mres <- findPath @t @f @m x (Text.unpack (stringIgnoreContext ns))
-      pure $ nvPath mres
-    (NVList _, y) ->
-      throwError $ ErrorCall $ "expected a string, got " <> show y
-    (x, NVStr _) -> throwError $ ErrorCall $ "expected a list, got " <> show x
-    (x, y) ->
-      throwError $ ErrorCall $ "Invalid types for builtins.findFile: " <> show
-        (x, y)
+findFile_ aset filePath =
+  demand
+    (\aset' ->
+      demand
+        (\filePath' ->
+          case (aset', filePath') of
+            (NVList x, NVStr ns) -> do
+              mres <- findPath @t @f @m x (Text.unpack (stringIgnoreContext ns))
+              pure $ nvPath mres
+            (NVList _, y) -> throwError $ ErrorCall $ "expected a string, got " <> show y
+            (x, NVStr _) -> throwError $ ErrorCall $ "expected a list, got " <> show x
+            (x, y) -> throwError $ ErrorCall $ "Invalid types for builtins.findFile: " <> show (x, y)
+        )
+        filePath
+    )
+    aset
 
 data FileType
    = FileTypeRegular
@@ -1328,26 +1402,31 @@ instance Convertible e t f m => ToValue FileType m (NValue t f m) where
 
 readDir_
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-readDir_ p = demand p $ \path' -> do
-  path           <- absolutePathFromValue path'
-  items          <- listDirectory path
-  itemsWithTypes <- forM items $ \item -> do
-    s <- getSymbolicLinkStatus $ path </> item
-    let t = if
-          | isRegularFile s  -> FileTypeRegular
-          | isDirectory s    -> FileTypeDirectory
-          | isSymbolicLink s -> FileTypeSymlink
-          | otherwise        -> FileTypeUnknown
-    pure (Text.pack item, t)
-  getDeeper <$> toValue (M.fromList itemsWithTypes)
+readDir_ =
+  demand
+    (\path' -> do
+      path           <- absolutePathFromValue path'
+      items          <- listDirectory path
+      itemsWithTypes <- forM items $ \item -> do
+        s <- getSymbolicLinkStatus $ path </> item
+        let t = if
+              | isRegularFile s  -> FileTypeRegular
+              | isDirectory s    -> FileTypeDirectory
+              | isSymbolicLink s -> FileTypeSymlink
+              | otherwise        -> FileTypeUnknown
+        pure (Text.pack item, t)
+      getDeeper <$> toValue (M.fromList itemsWithTypes))
 
 fromJSON
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-fromJSON arg = demand arg $ fromValue >=> fromStringNoContext >=> \encoded ->
-  case A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded of
-    Left jsonError ->
-      throwError $ ErrorCall $ "builtins.fromJSON: " <> jsonError
-    Right v -> jsonToNValue v
+fromJSON =
+  demand
+    (fromValue >=> fromStringNoContext >=> \encoded ->
+      either
+        (\ jsonError -> throwError $ ErrorCall $ "builtins.fromJSON: " <> jsonError)
+        jsonToNValue
+        (A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded)
+    )
  where
   jsonToNValue = \case
     A.Object m -> flip nvSet M.empty <$> traverse jsonToNValue m
@@ -1360,30 +1439,32 @@ fromJSON arg = demand arg $ fromValue >=> fromStringNoContext >=> \encoded ->
     A.Null     -> pure $ nvConstant NNull
 
 prim_toJSON :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-prim_toJSON x = demand x $ fmap nvStr . nvalueToJSONNixString
+prim_toJSON = demand (fmap nvStr . nvalueToJSONNixString)
 
 toXML_ :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-toXML_ v = demand v $ fmap (nvStr . toXML) . normalForm
+toXML_ = demand (fmap (nvStr . toXML) . normalForm)
 
 typeOf :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-typeOf v = demand v $ toValue . makeNixStringWithoutContext . \case
-  NVConstant a -> case a of
-    NURI   _ -> "string"
-    NInt   _ -> "int"
-    NFloat _ -> "float"
-    NBool  _ -> "bool"
-    NNull    -> "null"
-  NVStr  _      -> "string"
-  NVList _      -> "list"
-  NVSet _ _     -> "set"
-  NVClosure{}   -> "lambda"
-  NVPath _      -> "path"
-  NVBuiltin _ _ -> "lambda"
-  _             -> error "Pattern synonyms obscure complete patterns"
+typeOf = demand
+  (toValue . makeNixStringWithoutContext . \case
+    NVConstant a -> case a of
+      NURI   _ -> "string"
+      NInt   _ -> "int"
+      NFloat _ -> "float"
+      NBool  _ -> "bool"
+      NNull    -> "null"
+    NVStr  _      -> "string"
+    NVList _      -> "list"
+    NVSet _ _     -> "set"
+    NVClosure{}   -> "lambda"
+    NVPath _      -> "path"
+    NVBuiltin _ _ -> "lambda"
+    _             -> error "Pattern synonyms obscure complete patterns"
+  )
 
 tryEval
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-tryEval e = catch (demand e (pure . onSuccess)) (pure . onError)
+tryEval e = catch (demand (pure . onSuccess) e) (pure . onError)
  where
   onSuccess v = flip nvSet M.empty $ M.fromList
     [("success", nvConstant (NBool True)), ("value", v)]
@@ -1428,14 +1509,13 @@ exec_ xs = do
 
 fetchurl
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-fetchurl v = demand v $ \case
-  NVSet s _ -> attrsetGet "url" s >>= demand ?? go (M.lookup "sha256" s)
-  v@NVStr{} -> go Nothing v
-  v ->
-    throwError
-      $  ErrorCall
-      $  "builtins.fetchurl: Expected URI or set, got "
-      <> show v
+fetchurl =
+  demand
+    (\case
+      NVSet s _ -> attrsetGet "url" s >>= demand (go (M.lookup "sha256" s))
+      v@NVStr{} -> go Nothing v
+      v -> throwError $ ErrorCall $ "builtins.fetchurl: Expected URI or set, got " <> show v
+    )
  where
   go :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
   go _msha = \case
@@ -1488,14 +1568,14 @@ getRecursiveSize = fmap (nvConstant . NInt . fromIntegral) . recursiveSize
 
 getContext
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-getContext x = demand x $ \case
-  (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
-  x ->
-    throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x
+getContext =
+  demand
+    (\case
+      (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
+      x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x)
 
 appendContext
   :: forall e t f m
@@ -1503,45 +1583,55 @@ appendContext
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-appendContext x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
-  (NVStr ns, NVSet attrs _) -> do
-    newContextValues <- forM attrs $ \attr -> demand attr $ \case
-      NVSet attrs _ -> do
-        -- TODO: Fail for unexpected keys.
-        path <- maybe (pure False) (demand ?? fromValue)
-          $ M.lookup "path" attrs
-        allOutputs <- maybe (pure False) (demand ?? fromValue)
-          $ M.lookup "allOutputs" attrs
-        outputs <- case M.lookup "outputs" attrs of
-          Nothing -> pure mempty
-          Just os -> demand os $ \case
-            NVList vs ->
-              forM vs $ fmap stringIgnoreContext . fromValue
-            x ->
-              throwError
-                $ ErrorCall
-                $ "Invalid types for context value outputs in builtins.appendContext: "
-                <> show x
-        pure $ NixLikeContextValue path allOutputs outputs
-      x ->
-        throwError
-          $  ErrorCall
-          $  "Invalid types for context value in builtins.appendContext: "
-          <> show x
-    toValue
-      $ makeNixString (stringIgnoreContext ns)
-      $ fromNixLikeContext
-      $ NixLikeContext
-      $ M.unionWith (<>) newContextValues
-      $ getNixLikeContext
-      $ toNixLikeContext
-      $ NixString.getContext ns
-  (x, y) ->
-    throwError
-      $  ErrorCall
-      $  "Invalid types for builtins.appendContext: "
-      <> show (x, y)
-
+appendContext x y =
+  demand
+    (\x' ->
+      demand
+        (\y' ->
+          (case (x', y') of
+            (NVStr ns, NVSet attrs _) -> do
+              newContextValues <- forM attrs $
+                demand
+                  (\case
+                    NVSet attrs _ -> do
+                      -- TODO: Fail for unexpected keys.
+                      path <-
+                        maybe
+                          (pure False)
+                          (demand fromValue)
+                          (M.lookup "path" attrs)
+                      allOutputs <-
+                        maybe
+                          (pure False)
+                          (demand fromValue)
+                          (M.lookup "allOutputs" attrs)
+                      outputs <-
+                        maybe
+                          (pure mempty)
+                          (demand
+                            (\case
+                              NVList vs -> forM vs $ fmap stringIgnoreContext . fromValue
+                              x -> throwError $ ErrorCall $ "Invalid types for context value outputs in builtins.appendContext: " <> show x
+                            )
+                          )
+                        (M.lookup "outputs" attrs)
+                      pure $ NixLikeContextValue path allOutputs outputs
+                    x -> throwError $ ErrorCall $ "Invalid types for context value in builtins.appendContext: " <> show x
+                    )
+              toValue
+                $ makeNixString (stringIgnoreContext ns)
+                $ fromNixLikeContext
+                $ NixLikeContext
+                $ M.unionWith (<>) newContextValues
+                $ getNixLikeContext
+                $ toNixLikeContext
+                $ NixString.getContext ns
+            (x, y) -> throwError $ ErrorCall $ "Invalid types for builtins.appendContext: " <> show (x, y)
+          )
+        )
+        y
+    )
+    x
 newtype Prim m a = Prim { runPrim :: m a }
 
 -- | Types that support conversion to nix in a particular monad
diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs
index f4a56f529..7e73f13e6 100644
--- a/src/Nix/Convert.hs
+++ b/src/Nix/Convert.hs
@@ -76,10 +76,10 @@ instance ( Convertible e t f m
          , FromValue a m (NValue' t f m (NValue t f m))
          )
   => FromValue a m (NValue t f m) where
-  fromValueMay = flip demand $ \case
+  fromValueMay = demand $ \case
     Pure t -> force fromValueMay t
     Free v -> fromValueMay v
-  fromValue = flip demand $ \case
+  fromValue = demand $ \case
     Pure t -> force fromValue t
     Free v -> fromValue v
 
@@ -88,12 +88,20 @@ instance ( Convertible e t f m
          , FromValue a m (Deeper (NValue' t f m (NValue t f m)))
          )
   => FromValue a m (Deeper (NValue t f m)) where
-  fromValueMay (Deeper v) = demand v $ \case
-    Pure t -> force (fromValueMay . Deeper) t
-    Free v -> fromValueMay (Deeper v)
-  fromValue (Deeper v) = demand v $ \case
-    Pure t -> force (fromValue . Deeper) t
-    Free v -> fromValue (Deeper v)
+  fromValueMay (Deeper v) =
+    demand
+      (free
+        (force $ fromValueMay . Deeper)
+        (fromValueMay . Deeper)
+      )
+      v
+  fromValue (Deeper v) =
+    demand
+      (free
+        (force $ fromValue . Deeper)
+        (fromValue . Deeper)
+      )
+      v
 
 instance Convertible e t f m
   => FromValue () m (NValue' t f m (NValue t f m)) where
diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs
index a131b2f84..c1b15f3f2 100644
--- a/src/Nix/Effects/Basic.hs
+++ b/src/Nix/Effects/Basic.hs
@@ -12,6 +12,7 @@ module Nix.Effects.Basic where
 
 import           Control.Monad
 import           Control.Monad.State.Strict
+import           Data.Bool                      ( bool )
 import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
 import           Data.List
@@ -45,23 +46,24 @@ import           GHC.DataSize
 defaultMakeAbsolutePath :: MonadNix e t f m => FilePath -> m FilePath
 defaultMakeAbsolutePath origPath = do
   origPathExpanded <- expandHomePath origPath
-  absPath          <- if isAbsolute origPathExpanded
-    then pure origPathExpanded
-    else do
-      cwd <- do
-        mres <- lookupVar "__cur_file"
-        case mres of
-          Nothing -> getCurrentDirectory
-          Just v  -> demand v $ \case
-            NVPath s -> pure $ takeDirectory s
-            val ->
-              throwError
-                $  ErrorCall
-                $  "when resolving relative path,"
-                <> " __cur_file is in scope,"
-                <> " but is not a path; it is: "
-                <> show val
-      pure $ cwd <///> origPathExpanded
+  absPath          <-
+    bool
+      (do
+        cwd <- do
+          mres <- lookupVar "__cur_file"
+          maybe
+            getCurrentDirectory
+            (demand
+              (\case
+                NVPath s -> pure $ takeDirectory s
+                val -> throwError $ ErrorCall $ "when resolving relative path, __cur_file is in scope, but is not a path; it is: " <> show val
+              )
+            )
+            mres
+        pure $ cwd <///> origPathExpanded
+      )
+      (pure origPathExpanded)
+      (isAbsolute origPathExpanded)
   removeDotDotIndirections <$> canonicalizePath absPath
 
 expandHomePath :: MonadFile m => FilePath -> m FilePath
@@ -94,10 +96,11 @@ defaultFindEnvPath = findEnvPathM
 findEnvPathM :: forall e t f m . MonadNix e t f m => FilePath -> m FilePath
 findEnvPathM name = do
   mres <- lookupVar "__nixPath"
-  case mres of
-    Nothing -> error "impossible"
-    Just x  -> demand x $ fromValue >=> \(l :: [NValue t f m]) ->
-      findPathBy nixFilePath l name
+  maybe
+    (error "impossible")
+    (demand (fromValue >=> \(l :: [NValue t f m]) ->
+      findPathBy nixFilePath l name))
+    mres
  where
   nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
   nixFilePath path = do
@@ -130,19 +133,33 @@ findPathBy finder ls name = do
     mpath
  where
   go :: Maybe FilePath -> NValue t f m -> m (Maybe FilePath)
-  go p@(Just _) _ = pure p
-  go Nothing l =
-    demand l $ fromValue >=> \(s :: HashMap Text (NValue t f m)) -> do
-      p <- resolvePath s
-      demand p $ fromValue >=> \(Path path) -> case M.lookup "prefix" s of
-        Nothing -> tryPath path mempty
-        Just pf -> demand pf $ fromValueMay >=> \case
-          Just (nsPfx :: NixString) ->
-            let pfx = stringIgnoreContext nsPfx
-            in  if not (Text.null pfx)
-                  then tryPath path (pure (Text.unpack pfx))
-                  else tryPath path mempty
-          _ -> tryPath path mempty
+  go p =
+    maybe
+      (demand
+        (fromValue >=> \(s :: HashMap Text (NValue t f m)) -> do
+          p <- resolvePath s
+          demand
+            (fromValue >=> \(Path path) ->
+              maybe
+                (tryPath path mempty)
+                (demand (
+                    fromValueMay >=> \case
+                      Just (nsPfx :: NixString) ->
+                        let pfx = stringIgnoreContext nsPfx
+                        in bool
+                            (tryPath path mempty)
+                            (tryPath path (pure (Text.unpack pfx)))
+                            (not $ Text.null pfx)
+                      _ -> tryPath path mempty
+                    )
+                )
+                (M.lookup "prefix" s)
+            )
+            p
+        )
+      )
+      (const . pure . pure)
+      p
 
   tryPath p (Just n) | n' : ns <- splitDirectories name, n == n' =
     finder $ p <///> joinPath ns
@@ -160,11 +177,11 @@ findPathBy finder ls name = do
 
 fetchTarball
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-fetchTarball = flip demand $ \case
+fetchTarball = demand $ \case
   NVSet s _ -> case M.lookup "url" s of
     Nothing ->
       throwError $ ErrorCall "builtins.fetchTarball: Missing url attribute"
-    Just url -> demand url $ go (M.lookup "sha256" s)
+    Just url -> demand (go (M.lookup "sha256" s)) url
   v@NVStr{} -> go Nothing v
   v ->
     throwError
@@ -196,16 +213,14 @@ fetchTarball = flip demand $ \case
   fetch :: Text -> Maybe (NValue t f m) -> m (NValue t f m)
   fetch uri Nothing =
     nixInstantiateExpr $ "builtins.fetchTarball \"" <> Text.unpack uri <> "\""
-  fetch url (Just t) = demand t $ fromValue >=> \nsSha ->
-    let sha = stringIgnoreContext nsSha
-    in  nixInstantiateExpr
-          $  "builtins.fetchTarball { "
-          <> "url    = \""
-          <> Text.unpack url
-          <> "\"; "
-          <> "sha256 = \""
-          <> Text.unpack sha
-          <> "\"; }"
+  fetch url (Just t) =
+    demand
+      (fromValue >=> \nsSha ->
+        let sha = stringIgnoreContext nsSha
+        in  nixInstantiateExpr
+          $ "builtins.fetchTarball { " <> "url    = \"" <> Text.unpack url <> "\"; " <> "sha256 = \"" <> Text.unpack sha <> "\"; }"
+      )
+      t
 
 defaultFindPath :: MonadNix e t f m => [NValue t f m] -> FilePath -> m FilePath
 defaultFindPath = findPathM
diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index 0acc96cc6..a78df7523 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -348,8 +348,8 @@ buildDerivationWithContext drvAttrs = do
 
     -- common functions, lifted to WithStringContextT
 
-    demand' :: NValue t f m -> (NValue t f m -> WithStringContextT m a) -> WithStringContextT m a
-    demand' v f = join $ lift $ demand v (pure . f)
+    demand' :: (NValue t f m -> WithStringContextT m a) -> NValue t f m -> WithStringContextT m a
+    demand' f v = join $ lift $ demand (pure . f) v
 
     fromValue' :: (FromValue a m (NValue' t f m (NValue t f m)), MonadNix e t f m) => NValue t f m -> WithStringContextT m a
     fromValue' = lift . fromValue
diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
index 96f78090c..38812857f 100644
--- a/src/Nix/Eval.hs
+++ b/src/Nix/Eval.hs
@@ -177,7 +177,7 @@ evalWithAttrSet aset body = do
   -- computed once.
   scope <- currentScopes :: m (Scopes m v)
   s     <- defer $ withScopes scope aset
-  let s' = demand s $ fmap fst . fromValue @(AttrSet v, AttrSet SourcePos)
+  let s' = demand (fmap fst . fromValue @(AttrSet v, AttrSet SourcePos)) s
   pushWeakScope s' body
 
 attrSetAlter
@@ -198,7 +198,7 @@ attrSetAlter (k : ks) pos m p val = case M.lookup k m of
     -> go
     | otherwise
     -> x >>= fromValue @(AttrSet v, AttrSet SourcePos) >>= \(st, sp) ->
-      recurse (demand ?? pure <$> st) sp
+      recurse (demand pure <$> st) sp
  where
   go = pure (M.insert k val m, M.insert k pos p)
 
@@ -257,7 +257,7 @@ evalBinds recursive binds = do
     finalValue >>= fromValue >>= \(o', p') ->
           -- jww (2018-05-09): What to do with the key position here?
                                               pure $ fmap
-      (\(k, v) -> ([k], fromMaybe pos (M.lookup k p'), demand v pure))
+      (\(k, v) -> ([k], fromMaybe pos (M.lookup k p'), demand pure v))
       (M.toList o')
 
   go _ (NamedVar pathExpr finalValue pos) = do
@@ -284,21 +284,29 @@ evalBinds recursive binds = do
       result     -> [result]
 
   go scope (Inherit ms names pos) =
-    fmap catMaybes $ forM names $ evalSetterKeyName >=> \case
-      Nothing  -> pure Nothing
-      Just key -> pure $ Just
-        ( [key]
-        , pos
-        , do
-          mv <- case ms of
-            Nothing -> withScopes scope $ lookupVar key
-            Just s ->
-              s >>= fromValue @(AttrSet v, AttrSet SourcePos) >>= \(attrset, _) ->
-                clearScopes @v $ pushScope attrset $ lookupVar key
-          case mv of
-            Nothing -> attrMissing (key :| []) Nothing
-            Just v  -> demand v pure
+    fmap catMaybes $ forM names $ evalSetterKeyName >=>
+      (pure . maybe
+        Nothing
+        (\ key -> pure
+          ([key]
+          , pos
+          , do
+            mv <-
+              maybe
+                (withScopes scope $ lookupVar key)
+                (\ s ->
+                    --  2021-02-25: NOTE: This is obviously a do block.
+                    -- In the middle of the huge move, can not test refactor compilation.
+                  s >>= fromValue @(AttrSet v, AttrSet SourcePos) >>= \(attrset, _) ->
+                    clearScopes @v $ pushScope attrset $ lookupVar key)
+                ms
+            maybe
+              (attrMissing (key :| []) Nothing)
+              (demand pure)
+              mv
+          )
         )
+      )
 
   buildResult
     :: Scopes m v
@@ -329,8 +337,8 @@ evalSelect aset attr = do
   extract x path@(k :| ks) = fromValueMay x >>= \case
     Just (s :: AttrSet v, p :: AttrSet SourcePos)
       | Just t <- M.lookup k s -> case ks of
-        []     -> pure $ Right $ demand t pure
-        y : ys -> demand t $ extract ?? (y :| ys)
+        []     -> pure $ pure $ demand pure t
+        y : ys -> demand (extract ?? (y :| ys)) t
       | otherwise -> Left . (, path) <$> toValue (s, p)
     Nothing -> pure $ Left (x, path)
 
@@ -341,10 +349,10 @@ evalGetterKeyName
    . (MonadEval v m, FromValue NixString m v)
   => NKeyName (m v)
   -> m Text
-evalGetterKeyName = evalSetterKeyName >=> \case
-  Just k -> pure k
-  Nothing ->
-    evalError @v $ ErrorCall "value is null while a string was expected"
+evalGetterKeyName = evalSetterKeyName >=>
+  maybe
+    (evalError @v $ ErrorCall "value is null while a string was expected")
+    pure
 
 -- | Evaluate a component of an attribute path in a context where we are
 -- *binding* a value
diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs
index 1570b6193..aba198107 100644
--- a/src/Nix/Exec.hs
+++ b/src/Nix/Exec.hs
@@ -295,19 +295,22 @@ callFunc
   => NValue t f m
   -> NValue t f m
   -> m (NValue t f m)
-callFunc fun arg = demand fun $ \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
-      demand f $ (`callFunc` s) >=> (`callFunc` arg)
-    x -> throwError $ ErrorCall $ "Attempt to call non-function: " <> show x
+callFunc fun arg =
+  demand
+    (\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
+        demand ((`callFunc` s) >=> (`callFunc` arg)) f
+      x -> throwError $ ErrorCall $ "Attempt to call non-function: " <> show x
+    )
+    fun
 
 execUnaryOp
   :: (Framed e m, MonadCited t f m, Show t)
diff --git a/src/Nix/Json.hs b/src/Nix/Json.hs
index 67ab77019..63d6e1afd 100644
--- a/src/Nix/Json.hs
+++ b/src/Nix/Json.hs
@@ -38,17 +38,17 @@ nvalueToJSON = \case
   NVConstant (NInt   n) -> pure $ A.toJSON n
   NVConstant (NFloat n) -> pure $ A.toJSON n
   NVConstant (NBool  b) -> pure $ A.toJSON b
-  NVConstant NNull      -> pure $ A.Null
+  NVConstant NNull      -> pure   A.Null
   NVStr      ns         -> A.toJSON <$> extractNixString ns
   NVList l ->
     A.Array
       .   V.fromList
-      <$> traverse (join . lift . flip demand (pure . nvalueToJSON)) l
-  NVSet m _ -> case HM.lookup "outPath" m of
-    Nothing ->
-      A.Object
-        <$> traverse (join . lift . flip demand (pure . nvalueToJSON)) m
-    Just outPath -> join $ lift $ demand outPath (pure . nvalueToJSON)
+      <$> traverse (join . lift . demand (pure . nvalueToJSON)) l
+  NVSet m _ ->
+    maybe
+      (A.Object <$> traverse (join . lift . demand (pure . nvalueToJSON)) m)
+      (join . lift . demand (pure . nvalueToJSON))
+      (HM.lookup "outPath" m)
   NVPath p -> do
     fp <- lift $ unStorePath <$> addPath p
     addSingletonStringContext $ StringContext (Text.pack fp) DirectPath
diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs
index 716d222ae..b0570024d 100644
--- a/src/Nix/Lint.hs
+++ b/src/Nix/Lint.hs
@@ -116,7 +116,7 @@ unpackSymbolic
   :: (MonadVar m, MonadThunkId m, MonadCatch m)
   => Symbolic m
   -> m (NSymbolicF (NTypeF m (Symbolic m)))
-unpackSymbolic = flip demand $ readVar . getSV
+unpackSymbolic = demand $ readVar . getSV
 
 type MonadLint e m
   = ( Scoped (Symbolic m) m
@@ -140,11 +140,11 @@ renderSymbolic = unpackSymbolic >=> \case
       TNull  -> "null"
     TStr    -> pure "string"
     TList r -> do
-      x <- demand r renderSymbolic
+      x <- demand renderSymbolic r
       pure $ "[" <> x <> "]"
     TSet Nothing  -> pure "<any set>"
     TSet (Just s) -> do
-      x <- traverse (`demand` renderSymbolic) s
+      x <- traverse (demand renderSymbolic) s
       pure $ "{" <> show x <> "}"
     f@(TClosure p) -> do
       (args, sym) <- do
@@ -177,17 +177,30 @@ merge context = go
     (TPath, TPath) -> (TPath :) <$> go xs ys
     (TConstant ls, TConstant rs) ->
       (TConstant (ls `intersect` rs) :) <$> go xs ys
-    (TList l, TList r) -> demand l $ \l' -> demand r $ \r' -> do
-      m <- defer $ unify context l' r'
-      (TList m :) <$> go xs ys
+    (TList l, TList r) ->
+      demand
+        (\l' ->
+          demand
+            (\r' -> do
+              m <- defer $ unify context l' r'
+              (TList m :) <$> go xs ys
+            )
+            r
+        )
+        l
     (TSet x       , TSet Nothing ) -> (TSet x :) <$> go xs ys
     (TSet Nothing , TSet x       ) -> (TSet x :) <$> go xs ys
     (TSet (Just l), TSet (Just r)) -> do
       m <- sequenceA $ M.intersectionWith
         (\i j -> i >>= \i' ->
-          j
-            >>= \j' -> demand i'
-                  $ \i'' -> demand j' $ \j'' -> defer $ unify context i'' j''
+          j >>= \j' ->
+            demand
+              (\i'' ->
+                demand
+                  (defer . unify context i'')
+                  j'
+              )
+              i'
         )
         (pure <$> l)
         (pure <$> r)
@@ -273,9 +286,9 @@ instance (MonadThunkId m, MonadAtomicRef m, MonadCatch m)
   defer :: m (Symbolic m) -> m (Symbolic m)
   defer = fmap ST . thunk
 
-  demand :: Symbolic m -> (Symbolic m -> m r) -> m r
-  demand (ST v) f = force (`demand` f) v
-  demand (SV v) f = f (SV v)
+  demand :: (Symbolic m -> m r) -> Symbolic m -> m r
+  demand f (ST v)= force (demand f) v
+  demand f (SV v)= f (SV v)
 
 instance MonadLint e m => MonadEval (Symbolic m) m where
   freeVariable var = symerr $ "Undefined variable '" <> Text.unpack var <> "'"
@@ -327,10 +340,13 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
   -- computed once.
   evalWith scope body = do
     s <- defer scope
-    pushWeakScope ?? body $ demand s $ 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"
+    pushWeakScope ?? body $
+      demand
+        (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")
+        s
 
   evalIf cond t f = do
     t' <- t
diff --git a/src/Nix/Standard.hs b/src/Nix/Standard.hs
index b8f8e05a5..24827b28e 100644
--- a/src/Nix/Standard.hs
+++ b/src/Nix/Standard.hs
@@ -48,6 +48,7 @@ import           Nix.Render
 import           Nix.Scope
 import           Nix.Thunk
 import           Nix.Thunk.Basic
+import           Nix.Utils                      ( free )
 import           Nix.Utils.Fix1
 import           Nix.Value
 import           Nix.Value.Monad
@@ -158,13 +159,16 @@ instance ( MonadAtomicRef m
   defer = fmap pure . thunk
 
   demand
-    :: StdValue m
-    -> ( StdValue m
+    :: ( StdValue m
       -> m r
       )
+    -> StdValue m
     -> m r
-  demand (Pure v) f = force (`demand` f) v
-  demand (Free v) f = f (Free v)
+  demand f v =
+    free
+      (force (demand f))
+      (const $ f v)
+      v
 
   inform
     :: StdValue m
diff --git a/src/Nix/String/Coerce.hs b/src/Nix/String/Coerce.hs
index 1c7312d54..f8fddd02d 100644
--- a/src/Nix/String/Coerce.hs
+++ b/src/Nix/String/Coerce.hs
@@ -52,33 +52,36 @@ coerceToString
   -> m NixString
 coerceToString call ctsm clevel = go
  where
-  go x = demand x $ \case
-    NVConstant (NBool b)
-      |
-        -- TODO Return a singleton for "" and "1"
-        b && clevel == CoerceAny -> pure
-      $  makeNixStringWithoutContext "1"
-      | clevel == CoerceAny -> pure $ makeNixStringWithoutContext ""
-    NVConstant (NInt n) | clevel == CoerceAny ->
-      pure $ makeNixStringWithoutContext $ Text.pack $ show n
-    NVConstant (NFloat n) | clevel == CoerceAny ->
-      pure $ makeNixStringWithoutContext $ Text.pack $ show n
-    NVConstant NNull | clevel == CoerceAny ->
-      pure $ makeNixStringWithoutContext ""
-    NVStr ns -> pure ns
-    NVPath p
-      | ctsm == CopyToStore -> storePathToNixString <$> addPath p
-      | otherwise -> pure $ makeNixStringWithoutContext $ Text.pack p
-    NVList l | clevel == CoerceAny ->
-      nixStringUnwords <$> traverse (`demand` go) l
+  go x =
+    demand
+      (\case
+        NVConstant (NBool b)
+          |
+            -- TODO Return a singleton for "" and "1"
+            b && clevel == CoerceAny -> pure
+          $  makeNixStringWithoutContext "1"
+          | clevel == CoerceAny -> pure $ makeNixStringWithoutContext ""
+        NVConstant (NInt n) | clevel == CoerceAny ->
+          pure $ makeNixStringWithoutContext $ Text.pack $ show n
+        NVConstant (NFloat n) | clevel == CoerceAny ->
+          pure $ makeNixStringWithoutContext $ Text.pack $ show n
+        NVConstant NNull | clevel == CoerceAny ->
+          pure $ makeNixStringWithoutContext ""
+        NVStr ns -> pure ns
+        NVPath p
+          | ctsm == CopyToStore -> storePathToNixString <$> addPath p
+          | otherwise -> pure $ makeNixStringWithoutContext $ Text.pack p
+        NVList l | clevel == CoerceAny ->
+          nixStringUnwords <$> traverse (demand go) l
 
-    v@(NVSet s _) | Just p <- M.lookup "__toString" s ->
-      demand p $ (`call` v) >=> go
+        v@(NVSet s _) | Just p <- M.lookup "__toString" s ->
+          demand ((`call` v) >=> go) p
 
-    NVSet s _ | Just p <- M.lookup "outPath" s -> demand p go
-
-    v -> throwError $ ErrorCall $ "Expected a string, but saw: " <> show v
+        NVSet s _ | Just p <- M.lookup "outPath" s -> demand go p
 
+        v -> throwError $ ErrorCall $ "Expected a string, but saw: " <> show v
+      )
+      x
   nixStringUnwords =
     intercalateNixString (makeNixStringWithoutContext " ")
   storePathToNixString :: StorePath -> NixString
diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs
index 39e613cff..bb48abc01 100644
--- a/src/Nix/Type/Infer.hs
+++ b/src/Nix/Type/Infer.hs
@@ -407,11 +407,11 @@ instance Monad m => MonadValue (Judgment s) (InferT s m) where
   defer  = id
 
   demand
-    :: Judgment s
-    -> ( Judgment s
+    :: ( Judgment s
       -> InferT s m r)
+    -> Judgment s
     -> InferT s m r
-  demand = flip ($)
+  demand = ($)
 
   inform
     :: Judgment s
@@ -564,17 +564,17 @@ instance MonadInfer m
   toValue (xs, _) =
     Judgment
       <$> foldrM go As.empty xs
-      <*> (concat <$> traverse (`demand` (pure . typeConstraints)) xs)
-      <*> (TSet True <$> traverse (`demand` (pure . inferredType)) xs)
-    where go x rest = demand x $ \x' -> pure $ As.merge (assumptions x') rest
+      <*> (concat <$> traverse (demand (pure . typeConstraints)) xs)
+      <*> (TSet True <$> traverse (demand (pure . inferredType)) xs)
+    where go x rest = demand (\x' -> pure $ As.merge (assumptions x') rest) x
 
 instance MonadInfer m => ToValue [Judgment s] (InferT s m) (Judgment s) where
   toValue xs =
     Judgment
       <$> foldrM go As.empty xs
-      <*> (concat <$> traverse (`demand` (pure . typeConstraints)) xs)
-      <*> (TList <$> traverse (`demand` (pure . inferredType)) xs)
-    where go x rest = demand x $ \x' -> pure $ As.merge (assumptions x') rest
+      <*> (concat <$> traverse (demand (pure . typeConstraints)) xs)
+      <*> (TList <$> traverse (demand (pure . inferredType)) xs)
+    where go x rest = demand (\x' -> pure $ As.merge (assumptions x') rest) x
 
 instance MonadInfer m => ToValue Bool (InferT s m) (Judgment s) where
   toValue _ = pure $ Judgment As.empty mempty typeBool
diff --git a/src/Nix/Value/Monad.hs b/src/Nix/Value/Monad.hs
index 3d337b245..63cd6942e 100644
--- a/src/Nix/Value/Monad.hs
+++ b/src/Nix/Value/Monad.hs
@@ -4,7 +4,7 @@ module Nix.Value.Monad where
 
 class MonadValue v m where
   defer :: m v -> m v
-  demand :: v -> (v -> m r) -> m r
+  demand :: (v -> m r) -> v -> m r
   -- | If 'v' is a thunk, 'inform' allows us to modify the action to be
   --   performed by the thunk, perhaps by enriching it with scope info, for
   --   example.

From de6327c56481f7afb6e48006340b02e28f71de93 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Fri, 26 Feb 2021 22:50:08 +0200
Subject: [PATCH 26/26] ChangeLog: add note about flipping `demand`

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

diff --git a/ChangeLog.md b/ChangeLog.md
index 9eb4d8024..559b1e745 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -17,6 +17,8 @@
       * `querryM`
       * `querryThunk`
 
+  * [(link)](https://github.com/haskell-nix/hnix/pull/862/files#diff-caa5d6592de00a0b23b2996143181d5cb60ebe00abcd0ba39b271caa764aa086) `Nix.Value.Monad`: `class MonadValue v m`: `demand` unflipped the arguments. All its implementations got more straigh-forward to use and `demand` now tail recurse.
+
   * [(link)](https://github.com/haskell-nix/hnix/pull/859/commits/8e043bcbda13ea4fd66d3eefd6da690bb3923edd) `Nix.Value.Equal`: `valueEqM`: freed from `RankNTypes: forall t f m .`.
 
   * [(link)](https://github.com/haskell-nix/hnix/pull/802/commits/529095deaf6bc6b102fe5a3ac7baccfbb8852e49#) `Nix.Strings`: all `hacky*` functions replaced with lawful implemetations, because of that all functions become lawful - dropped the `principled` suffix from functions: