Merge #873: migration to new demand implementation

 - ✔️ Gradual switches where posible.
 - ✔️ All uses of it, including all `Builtins` are processed.
 - ✔️ A couplr of several level `do` blocks became 1.
 - ✔️ Several of the monadic binds became functors.
 - ✔️ ChangeLog (also would be rewritten couple of times by the further change updates)
 
This almost fully closes the #850

What is further left there is basically to move Kleisli out of `inform`, `informF` is for that, then do the includes of the function uses inside the `do` blocks and fold the lambdas, binds and `do` blocks further. With the current lispy sectioning, it is easy and semi-automatic.

Author: Anton-Latukha

ChangeLog.md

@@ -43,13 +43,19 @@
         furtherF  :: (m a -> m a) -> t   -> m t
       ```
       
-  * [(link)](https://github.com/haskell-nix/hnix/pull/862/files) [(link)](https://github.com/haskell-nix/hnix/pull/870/files) `Nix.Value.Monad`: `class MonadValue v m`: unflipped the arguments of methods into a classical order. As a result, `demand` now tail recurse.
+  * [(link)](https://github.com/haskell-nix/hnix/pull/862/files) [(link)](https://github.com/haskell-nix/hnix/pull/870/files) [(link)](https://github.com/haskell-nix/hnix/pull/871/files)  [(link)](https://github.com/haskell-nix/hnix/pull/872/files) [(link)](https://github.com/haskell-nix/hnix/pull/873/files) `Nix.Value.Monad`: `class MonadValue v m`: instances became specialized, Kleisli versions unflipped the arguments of methods into a classical order and moved to the `class MonadValueF`. As a result, `demand` now gets optimized by GHC and also tail recurse. Please, use `f =<< demand t`, or just use `demandF`, while `demandF` in fact just `kleisli =<< demand t`.
 
       ```haskell
-      demand :: (v -> m r) -> v -> m r
-      -- was :: v -> (v -> m r) -> m r
-      inform :: (m v -> m v) -> v -> m v
-      -- was :: v -> (m v -> m v) -> m v
+      class MonadValue v m where
+      
+        demand :: v       ->         m v
+        -- was :: v -> (v -> m r) -> m r
+      
+      class MonadValueF v m where
+        demandF :: (v -> m r) -> v -> m r
+        -- was :: v -> (v -> m r) -> m r
+        informF :: (m v -> m v) -> v -> m v
+        -- was :: v -> (m v -> m v) -> m v
       ```
 
   * [(link)](https://github.com/haskell-nix/hnix/pull/863/files) `Nix.Normal`: `normalizeValue` removed first functional argument that was passing the function that did the thunk forcing. Now function provides the thunk forcing. Now to normalize simply use `normalizeValue v`.

main/Main.hs

@@ -214,17 +214,18 @@ main = do
             _                              -> (True, True)
 
           forceEntry k v =
-            catch (pure <$> demandF pure v) $ \(NixException frames) -> do
-              liftIO
-                .   putStrLn
-                .   ("Exception forcing " <>)
-                .   (k <>)
-                .   (": " <>)
-                .   show
-                =<< renderFrames @(StdValue (StandardT (StdIdT IO)))
-                      @(StdThunk (StandardT (StdIdT IO)))
-                      frames
-              pure Nothing
+            catch (pure <$> (pure =<< demand v)) $ \(NixException frames) ->
+              do
+                liftIO
+                  . putStrLn
+                  . ("Exception forcing " <>)
+                  . (k <>)
+                  . (": " <>)
+                  . show
+                  =<< renderFrames @(StdValue (StandardT (StdIdT IO)))
+                        @(StdThunk (StandardT (StdIdT IO)))
+                        frames
+                pure Nothing
 
   reduction path mp x = do
     eres <- Nix.withNixContext mp

main/Repl.hs

@@ -27,7 +27,7 @@ import           Nix                     hiding ( exec
                                                 )
 import           Nix.Scope
 import           Nix.Utils
-import           Nix.Value.Monad                ( demandF )
+import           Nix.Value.Monad                ( demand )
 
 import qualified Data.List
 import qualified Data.Maybe
@@ -340,69 +340,74 @@ completion = System.Console.Repline.Prefix
 -- | Main completion function
 --
 -- Heavily inspired by Dhall Repl, with `algebraicComplete`
--- adjusted to monadic variant able to `demandF` thunks.
+-- adjusted to monadic variant able to `demand` thunks.
 completeFunc
   :: forall e t f m . (MonadNix e t f m, MonadIO m)
   => String
   -> String
   -> (StateT (IState t f m) m) [Completion]
 completeFunc reversedPrev word
   -- Commands
-  | reversedPrev == ":"
-  = pure . listCompletion
+  | reversedPrev == ":" =
+    pure . listCompletion
       $ fmap helpOptionName (helpOptions :: HelpOptions e t f m)
 
   -- Files
-  | any (`Data.List.isPrefixOf` word) [ "/", "./", "../", "~/" ]
-  = listFiles word
+  | any (`Data.List.isPrefixOf` word) [ "/", "./", "../", "~/" ] =
+    listFiles word
 
   -- Attributes of sets in REPL context
-  | var : subFields <- Data.Text.split (== '.') (Data.Text.pack word)
-  , not $ null subFields
-  = do
-    s <- get
-    case Data.HashMap.Lazy.lookup var (replCtx s) of
-      Nothing -> pure mempty
-      Just binding -> do
-        candidates <- lift $ algebraicComplete subFields binding
-        pure $ notFinished <$> listCompletion (Data.Text.unpack . (var <>) <$> candidates)
+  | var : subFields <- Data.Text.split (== '.') (Data.Text.pack word) , not $ null subFields =
+    do
+      s <- get
+      maybe
+        (pure mempty)
+        (\ binding ->
+          do
+            candidates <- lift $ algebraicComplete subFields binding
+            pure $ notFinished <$> listCompletion (Data.Text.unpack . (var <>) <$> candidates)
+        )
+        (Data.HashMap.Lazy.lookup var (replCtx s))
 
   -- Builtins, context variables
-  | otherwise
-  = do
-    s <- get
-    let contextKeys = Data.HashMap.Lazy.keys (replCtx s)
-        (Just (NVSet builtins _)) = Data.HashMap.Lazy.lookup "builtins" (replCtx s)
-        shortBuiltins = Data.HashMap.Lazy.keys builtins
-
-    pure $ listCompletion
-      $ ["__includes"]
-      <> (Data.Text.unpack <$> contextKeys)
-      <> (Data.Text.unpack <$> shortBuiltins)
+  | otherwise =
+    do
+      s <- get
+      let contextKeys = Data.HashMap.Lazy.keys (replCtx s)
+          (Just (NVSet builtins _)) = Data.HashMap.Lazy.lookup "builtins" (replCtx s)
+          shortBuiltins = Data.HashMap.Lazy.keys builtins
+
+      pure $ listCompletion
+        $ ["__includes"]
+        <> (Data.Text.unpack <$> contextKeys)
+        <> (Data.Text.unpack <$> shortBuiltins)
 
   where
     listCompletion = fmap simpleCompletion . filter (word `Data.List.isPrefixOf`)
 
     notFinished x = x { isFinished = False }
 
-    algebraicComplete :: (MonadNix e t f m)
-                      => [Text]
-                      -> NValue t f m
-                      -> m [Text]
+    algebraicComplete
+      :: (MonadNix e t f m)
+      => [Text]
+      -> NValue t f m
+      -> m [Text]
     algebraicComplete subFields val =
-      let keys = fmap ("." <>) . Data.HashMap.Lazy.keys
-          withMap m =
-            case subFields of
-              [] -> pure $ keys m
-              -- Stop on last subField (we care about the keys at this level)
-              [_] -> pure $ keys m
-              f:fs ->
-                maybe
-                  (pure mempty)
-                  (demandF (\e' -> (fmap . fmap) (("." <> f) <>) $ algebraicComplete fs e'))
-                  (Data.HashMap.Lazy.lookup f m)
-
-      in case val of
+      let
+        keys = fmap ("." <>) . Data.HashMap.Lazy.keys
+
+        withMap m =
+          case subFields of
+            [] -> pure $ keys m
+            -- Stop on last subField (we care about the keys at this level)
+            [_] -> pure $ keys m
+            f:fs ->
+              maybe
+                (pure mempty)
+                (((fmap . fmap) (("." <> f) <>) . algebraicComplete fs) <=< demand)
+                (Data.HashMap.Lazy.lookup f m)
+      in
+      case val of
         NVSet xs _ -> withMap xs
         _          -> pure mempty
 

src/Nix.hs

@@ -115,14 +115,12 @@ evaluateExpression mpath evaluator handler expr = do
     (second mkStr)
     (argstr opts)
   evaluator mpath expr >>= \f ->
-    demandF
-      (\f' ->
-        processResult handler =<<
-          case f' of
-            NVClosure _ g -> g (argmap args)
-            _             -> pure f
-      )
-      f
+    (\f' ->
+      processResult handler =<<
+        case f' of
+          NVClosure _ g -> g (argmap args)
+          _             -> pure f
+    ) =<< demand f
  where
   parseArg s =
     case parseNixText s of
@@ -149,29 +147,25 @@ processResult h val = do
   go :: [Text.Text] -> NValue t f m -> m a
   go [] v = h v
   go ((Text.decimal -> Right (n,"")) : ks) v =
-    demandF
-      (\case
-        NVList xs ->
-          list
+    (\case
+      NVList xs ->
+        list
+          h
+          go
+          ks
+        (xs !! n)
+      _ -> errorWithoutStackTrace $ "Expected a list for selector '" <> show n <> "', but got: " <> show v
+    ) =<< demand v
+  go (k : ks) v =
+    (\case
+      NVSet xs _ ->
+        maybe
+          (errorWithoutStackTrace $ "Set does not contain key '" <> Text.unpack k <> "'")
+          (list
             h
             go
             ks
-          (xs !! n)
-        _ -> errorWithoutStackTrace $ "Expected a list for selector '" <> show n <> "', but got: " <> show v
-      )
-      v
-  go (k : ks) v =
-    demandF
-      (\case
-        NVSet xs _ ->
-          maybe
-            (errorWithoutStackTrace $ "Set does not contain key '" <> Text.unpack k <> "'")
-            (list
-              h
-              go
-              ks
-            )
-            (M.lookup k xs)
-        _ -> errorWithoutStackTrace $ "Expected a set for selector '" <> Text.unpack k <> "', but got: " <> show v
-      )
-      v
+          )
+          (M.lookup k xs)
+      _ -> errorWithoutStackTrace $ "Expected a set for selector '" <> Text.unpack k <> "', but got: " <> show v
+    ) =<< demand v