class MonadValue: move Kleisli out of inform (#874)

This the last change in the `class MonadValue`.
After this, there are finishing touches to close the #850

Author: Anton-Latukha

src/Nix/Eval.hs

@@ -163,7 +163,7 @@ eval (NAbs    params body) = do
   scope <- currentScopes :: m (Scopes m v)
   evalAbs params $ \arg k -> withScopes scope $ do
     args <- buildArgument params arg
-    pushScope args (k (fmap (inform (withScopes scope)) args) body)
+    pushScope args (k (fmap (withScopes scope . inform) args) body)
 
 eval (NSynHole name) = synHole name
 
@@ -427,13 +427,14 @@ buildArgument params arg = do
     -> Text
     -> These v (Maybe (m v))
     -> Maybe (AttrSet v -> m v)
-  assemble scope isVariadic k = \case
-    That Nothing -> pure $ const $ evalError @v $ ErrorCall $ "Missing value for parameter: " <>show k
-    That (Just f) -> pure $ \args -> defer $ withScopes scope $ pushScope args f
-    This _
-      | isVariadic -> Nothing
-      | otherwise  -> pure $ const $ evalError @v $ ErrorCall $ "Unexpected parameter: " <> show k
-    These x _ -> pure (const (pure x))
+  assemble scope isVariadic k =
+    \case
+      That Nothing -> pure $ const $ evalError @v $ ErrorCall $ "Missing value for parameter: " <>show k
+      That (Just f) -> pure $ \args -> defer $ withScopes scope $ pushScope args f
+      This _
+        | isVariadic -> Nothing
+        | otherwise  -> pure $ const $ evalError @v $ ErrorCall $ "Unexpected parameter: " <> show k
+      These x _ -> pure (const (pure x))
 
 addSourcePositions
   :: (MonadReader e m, Has e SrcSpan) => Transform NExprLocF (m a)

src/Nix/Lint.hs

@@ -283,16 +283,15 @@ instance (MonadThunkId m, MonadAtomicRef m, MonadCatch m)
   defer = fmap ST . thunk
 
   demand :: Symbolic m -> m (Symbolic m)
-  demand = undefined
-  -- demand (ST v)= demand =<< force v
-  -- demand (SV v)= f (SV v)
+  demand (ST v)= demand =<< force v
+  demand (SV v)= pure (SV v)
 
 
 instance (MonadThunkId m, MonadAtomicRef m, MonadCatch m)
   => MonadValueF (Symbolic m) m where
 
   demandF :: (Symbolic m -> m r) -> Symbolic m -> m r
-  demandF f (ST v)= (demandF f) =<< force v
+  demandF f (ST v)= demandF f =<< force v
   demandF f (SV v)= f (SV v)
 
 

src/Nix/Standard.hs

@@ -244,14 +244,10 @@ instance
       v
 
   inform
-    :: ( m (StdValue m)
-      -> m (StdValue m)
-      )
-    -> StdValue m
+    :: StdValue m
     -> m (StdValue m)
-  --  2021-02-27: NOTE: When swapping, switch to `further`.
-  inform f (Pure t) = Pure <$> furtherF f t
-  inform f (Free v) = Free <$> bindNValue' id (inform f) v
+  inform (Pure t) = Pure <$> further t
+  inform (Free v) = Free <$> bindNValue' id inform v
 
 
 -- * @instance MonadValueF (StdValue m) m@
@@ -283,7 +279,7 @@ instance
       )
     -> StdValue m
     -> m (StdValue m)
-  --  2021-02-27: NOTE: When swapping, switch to `further`.
+  --  2021-02-27: NOTE: Switch to `further` and `inform`. Probably just informF f = f <=< inform
   informF f (Pure t) = Pure <$> furtherF f t
   informF f (Free v) = Free <$> bindNValue' id (informF f) v
 

src/Nix/Type/Infer.hs

@@ -388,12 +388,15 @@ instance Monad m => MonadThrow (InferT s m) where
   throwM = throwError . EvaluationError
 
 instance Monad m => MonadCatch (InferT s m) where
-  catch m h = catchError m $ \case
-    EvaluationError e -> maybe
-      (error $ "Exception was not an exception: " <> show e)
-      h
-      (fromException (toException e))
-    err -> error $ "Unexpected error: " <> show err
+  catch m h =
+    catchError m $
+      \case
+        EvaluationError e ->
+          maybe
+            (error $ "Exception was not an exception: " <> show e)
+            h
+            (fromException (toException e))
+        err -> error $ "Unexpected error: " <> show err
 
 type MonadInfer m
   = ({- MonadThunkId m,-}
@@ -409,15 +412,12 @@ instance Monad m => MonadValue (Judgment s) (InferT s m) where
   demand
     :: Judgment s
     -> InferT s m (Judgment s)
-  demand = demandF pure
+  demand = pure
 
   inform
-    :: ( InferT s m (Judgment s)
-      -> InferT s m (Judgment s)
-      )
-    -> Judgment s
+    :: Judgment s
     -> InferT s m (Judgment s)
-  inform f j = f (pure j)
+  inform = pure
 
 
 --  2021-02-22: NOTE: Seems like suporflous instance
@@ -428,15 +428,15 @@ instance Monad m => MonadValueF (Judgment s) (InferT s m) where
       -> InferT s m r)
     -> Judgment s
     -> InferT s m r
-  demandF = ($)
+  demandF f a = f a
 
   informF
     :: ( InferT s m (Judgment s)
       -> InferT s m (Judgment s)
       )
     -> Judgment s
     -> InferT s m (Judgment s)
-  informF f j = f (pure j)
+  informF f j = f $ pure j
 
 {-
 instance MonadInfer m

src/Nix/Value/Monad.hs

@@ -10,7 +10,7 @@ class MonadValue v m where
   -- | 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.
-  inform :: (m v -> m v) -> v -> m v
+  inform :: v -> m v
 
 
 -- * @MonadValueF@ - a Kleisli-able customization class