Move Kliesli to MonadThunkF

ChangeLog.md

@@ -5,23 +5,51 @@
 
 * Breaking:
 
-  * [(link)](https://github.com/haskell-nix/hnix/pull/863/files) `Nix.Thunk`: `class MonadThunk t m a | t -> m, t -> a` : `force{,Eff}`. Moved the functional argument out of the function. Now it only accepts and forces thunk. Please use `=<< force t` or `<=< force` for the nice code. All their implementations got more straigh-forward to use and `force*`s now tail recurse.
-      * `force`
-      * `forceThunk`
+  * [(link)](https://github.com/haskell-nix/hnix/pull/859/files) [(link)](https://github.com/haskell-nix/hnix/pull/863/files) [(link)](https://github.com/haskell-nix/hnix/pull/866/files) `Nix.Thunk`: `class MonadThunk t m a | t -> m, t -> a`. Class was initially designed with Kleisli arrows (`v -> m a`) in mind, which where put to have the design open and inviting customization & integration. Those functional arguments are for custom implementation, so  which in reality of the project were never used and HNax just "essentially" (simplifying, because `pure` was mixed with monadic binds to `f`) was passing `pure` into them (actually, `f <=< pure`). These Kliesli functors got arguments sorted properly and were moved to a `MonadThunkF` class and names gained `*F`. And `MonadThunk` now does only what is needed, for example `force` gets the thunk and computes it. All `MonadThunk{,F}` functions become with a classic Haskell arguments order, specialized, and got more straigh-forward to understand and use, and so now they tail recurse also.
 
-      If still want to use old `force*` - the `force{,Eff}F` are provided.
+      Now, for example, instead of `force t f` use it as `v <- force t` `f =<< force t`, or `f <=< force`.
+
+      tl;dr: results:
+
+      ```haskell
+      class MonadThunkId m => MonadThunk t m a | t -> m, t -> a where
+
+        thunkId  :: t -> ThunkId m
+
+        thunk    :: m a -> m t
+
+        queryM   :: m a -> t -> m a
+        -- was :: t -> m r -> (a   -> m r) -> m r
+        -- old became `queryMF`
+
+        force    :: t -> m a
+        -- was :: t   -> (a   -> m r) -> m r
+        -- old became `forceF`
+
+        forceEff :: t -> m a
+        -- was :: t   -> (a   -> m r) -> m r
+        -- old became `forceEffF`
+
+        further  :: t -> m t
+        -- was :: t   -> (m a -> m a) -> m t
+        -- old became `furtherF`
+
+
+      -- | Class of Kleisli functors for easiness of customized implementation developlemnt.
+      class MonadThunkF t m a | t -> m, t -> a where
+        queryMF   :: (a   -> m r) -> m r -> t -> m r
+        forceF    :: (a   -> m r) -> t   -> m r
+        forceEffF :: (a   -> m r) -> t   -> m r
+        furtherF  :: (m a -> m a) -> t   -> m t
+      ```
+
+  * [(link)](https://github.com/haskell-nix/hnix/pull/862/files) `Nix.Value.Monad`: `class MonadValue v m`: `demand` unflipped the arguments into a classical order. As a result, `demand` now tail recurse.
+
+      ```haskell
+      demand :: (v -> m r) -> v -> m r
+      -- was :: v -> (v -> m r) -> m r
+      ```
 
-
-  * [(link)](https://github.com/haskell-nix/hnix/pull/859/files) `Nix.Thunk`: `class MonadThunk t m a | t -> m, t -> a` : unflipped the arguments. All their implementations got more straigh-forward to use and some functions now tail recurse.
-    * Simply flip the first two arguments for:
-      * `further`
-      * `furtherEff`
-    * Simply switch the 1<->3 arguments in:
-      * `querryM`
-      * `querryThunk`
-
-  * [(link)](https://github.com/haskell-nix/hnix/pull/862/files) `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/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`.
 
   * [(link)](https://github.com/haskell-nix/hnix/pull/859/commits/8e043bcbda13ea4fd66d3eefd6da690bb3923edd) `Nix.Value.Equal`: `valueEqM`: freed from `RankNTypes: forall t f m .`.
@@ -64,43 +92,43 @@
     * Children found their parents:
 
         ```haskell
-        Binary   NAtom: Nix.Expr.Types -> Nix.Atoms
-        FromJSON NAtom: Nix.Expr.Types -> Nix.Atoms
-        ToJSON   NAtom: Nix.Expr.Types -> Nix.Atoms
+        Binary   NAtom :: Nix.Expr.Types -> Nix.Atoms
+        FromJSON NAtom :: Nix.Expr.Types -> Nix.Atoms
+        ToJSON   NAtom :: Nix.Expr.Types -> Nix.Atoms
 
         -- | Instance was TH, now simple derivable
-        Eq1 (NValueF p m)    : Nix.Value.Equal -> Nix.Value
+        Eq1 (NValueF p m)     :: Nix.Value.Equal -> Nix.Value
 
-        Eq1 (NValue' t f m a): Nix.Value.Equal -> Nix.Value 
+        Eq1 (NValue' t f m a) :: Nix.Value.Equal -> Nix.Value 
 
-        HasCitations m v (NValue' t f m a): Nix.Pretty -> Nix.Cited
-        HasCitations m v (NValue  t f m)  : Nix.Pretty -> Nix.Cited
+        HasCitations m v (NValue' t f m a) :: Nix.Pretty -> Nix.Cited
+        HasCitations m v (NValue  t f m)   :: Nix.Pretty -> Nix.Cited
 
         when
           (package hashable >= 1.3.1) -- gained instance
-          $ Hashable1 NonEmpty: Nix.Expr.Types -> Void -- instance was upstreamed
+          $ Hashable1 NonEmpty:: Nix.Expr.Types -> Void -- please use upstreamed instance
 
         -- | Upstreamed, going to apper in the next release of `ref-tf`.
-        MonadAtomicRef   (Fix1T t m): Nix.Standard -> Nix.Utils.Fix1
-
-        MonadRef         (Fix1T t m): Nix.Standard -> Nix.Utils.Fix1
-        MonadEnv         (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadExec        (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadHttp        (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadInstantiate (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadIntrospect  (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadPaths       (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadPutStr      (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadStore       (Fix1T t m): Nix.Standard -> Nix.Effects
-        MonadFile        (Fix1T t m): Nix.Standard -> Nix.Render
-
-        MonadEnv         (Fix1 t)   : Nix.Standard -> Nix.Effects
-        MonadExec        (Fix1 t)   : Nix.Standard -> Nix.Effects
-        MonadHttp        (Fix1 t)   : Nix.Standard -> Nix.Effects
-        MonadInstantiate (Fix1 t)   : Nix.Standard -> Nix.Effects
-        MonadIntrospect  (Fix1 t)   : Nix.Standard -> Nix.Effects
-        MonadPaths       (Fix1 t)   : Nix.Standard -> Nix.Effects
-        MonadPutStr      (Fix1 t)   : Nix.Standard -> Nix.Effects
+        MonadAtomicRef   (Fix1T t m) :: Nix.Standard -> Nix.Utils.Fix1
+
+        MonadRef         (Fix1T t m) :: Nix.Standard -> Nix.Utils.Fix1
+        MonadEnv         (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadExec        (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadHttp        (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadInstantiate (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadIntrospect  (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadPaths       (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadPutStr      (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadStore       (Fix1T t m) :: Nix.Standard -> Nix.Effects
+        MonadFile        (Fix1T t m) :: Nix.Standard -> Nix.Render
+
+        MonadEnv         (Fix1 t)    :: Nix.Standard -> Nix.Effects
+        MonadExec        (Fix1 t)    :: Nix.Standard -> Nix.Effects
+        MonadHttp        (Fix1 t)    :: Nix.Standard -> Nix.Effects
+        MonadInstantiate (Fix1 t)    :: Nix.Standard -> Nix.Effects
+        MonadIntrospect  (Fix1 t)    :: Nix.Standard -> Nix.Effects
+        MonadPaths       (Fix1 t)    :: Nix.Standard -> Nix.Effects
+        MonadPutStr      (Fix1 t)    :: Nix.Standard -> Nix.Effects
         ```
 
 

main/Main.hs

@@ -16,7 +16,6 @@ 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 )

main/Repl.hs

@@ -43,7 +43,9 @@ import           Control.Monad.Identity
 import           Control.Monad.Reader
 import           Control.Monad.State.Strict
 
-import           Prettyprinter                  (Doc, (<+>))
+import           Prettyprinter                  ( Doc
+                                                , space
+                                                )
 import qualified Prettyprinter
 import qualified Prettyprinter.Render.Text
 
@@ -450,7 +452,7 @@ helpOptions =
   , HelpOption
       "set"
       ""
-      (    "Set REPL option"
+      ("Set REPL option"
         <> Prettyprinter.line
         <> "Available options:"
         <> Prettyprinter.line
@@ -503,14 +505,14 @@ helpSetOptions =
 
 renderSetOptions :: [HelpSetOption] -> Doc ()
 renderSetOptions so =
-  Prettyprinter.indent 4
-    $ Prettyprinter.vsep
-    $ flip fmap so
-    $ \h ->
-             Prettyprinter.pretty (helpSetOptionName h)
-         <+> helpSetOptionSyntax h
-         <>  Prettyprinter.line
-         <>  Prettyprinter.indent 4 (helpSetOptionDoc h)
+  Prettyprinter.indent 4 $
+    Prettyprinter.vsep $
+      (\h ->
+        Prettyprinter.pretty (helpSetOptionName h) <> space
+        <> helpSetOptionSyntax h
+        <> Prettyprinter.line
+        <> Prettyprinter.indent 4 (helpSetOptionDoc h)
+      ) <$> so
 
 help :: (MonadNix e t f m, MonadIO m)
      => HelpOptions e t f m
@@ -519,16 +521,15 @@ help :: (MonadNix e t f m, MonadIO m)
 help hs _ = do
   liftIO $ putStrLn "Available commands:\n"
   forM_ hs $ \h ->
-      liftIO
-    . Data.Text.IO.putStrLn
-    . Prettyprinter.Render.Text.renderStrict
-    . Prettyprinter.layoutPretty
-        Prettyprinter.defaultLayoutOptions
-    $     ":"
-       <>  Prettyprinter.pretty (helpOptionName h)
-       <+> helpOptionSyntax h
-       <>  Prettyprinter.line
-       <>  Prettyprinter.indent 4 (helpOptionDoc h)
+    liftIO .
+      Data.Text.IO.putStrLn .
+        Prettyprinter.Render.Text.renderStrict .
+          Prettyprinter.layoutPretty Prettyprinter.defaultLayoutOptions $
+            ":"
+            <> Prettyprinter.pretty (helpOptionName h) <> space
+            <> helpOptionSyntax h
+            <> Prettyprinter.line
+            <> Prettyprinter.indent 4 (helpOptionDoc h)
 
 options
   :: (MonadNix e t f m, MonadIO m)

src/Nix.hs

@@ -28,10 +28,13 @@ module Nix
   )
 where
 
-import           Control.Applicative
+import           Control.Applicative            ( Alternative )
 import           Control.Arrow                  ( second )
-import           Control.Monad.Reader
-import           Data.Fix
+import           Control.Monad.Reader           ( MonadIO
+                                                , asks
+                                                , (<=<)
+                                                )
+import           Data.Fix                       ( Fix )
 import qualified Data.HashMap.Lazy             as M
 import qualified Data.Text                     as Text
 import qualified Data.Text.Read                as Text
@@ -81,10 +84,11 @@ nixEvalExprLoc
   => Maybe FilePath
   -> NExprLoc
   -> m (NValue t f m)
-nixEvalExprLoc mpath = nixEval
-  mpath
-  (Eval.addStackFrames . Eval.addSourcePositions)
-  (Eval.eval . annotated . getCompose)
+nixEvalExprLoc mpath =
+  nixEval
+    mpath
+    (Eval.addStackFrames . Eval.addSourcePositions)
+    (Eval.eval . annotated . getCompose)
 
 -- | Evaluate a nix expression with tracing in the default context. Note that
 --   this function doesn't do any tracing itself, but 'evalExprLoc' will be
@@ -113,15 +117,17 @@ evaluateExpression mpath evaluator handler expr = do
   evaluator mpath expr >>= \f ->
     demand
       (\f' ->
-        processResult handler =<< case f' of
-          NVClosure _ g -> g (argmap args)
-          _             -> pure f
+        processResult handler =<<
+          case f' of
+            NVClosure _ g -> g (argmap args)
+            _             -> pure f
       )
       f
  where
-  parseArg s = case parseNixText s of
-    Success x   -> x
-    Failure err -> errorWithoutStackTrace (show err)
+  parseArg s =
+    case parseNixText s of
+      Success x   -> x
+      Failure err -> errorWithoutStackTrace (show err)
 
   eval' = normalForm <=< nixEvalExpr mpath
 
@@ -135,19 +141,22 @@ processResult
   -> m a
 processResult h val = do
   opts :: Options <- asks (view hasLens)
-  case attr opts of
-    Nothing                         -> h val
-    Just (Text.splitOn "." -> keys) -> go keys val
+  maybe
+    (h val)
+    (\ (Text.splitOn "." -> keys) -> go keys val)
+    (attr opts)
  where
   go :: [Text.Text] -> NValue t f m -> m a
   go [] v = h v
   go ((Text.decimal -> Right (n,"")) : ks) v =
     demand
       (\case
         NVList xs ->
-          case ks of
-            [] -> h (xs !! n)
-            _  -> go ks (xs !! n)
+          list
+            h
+            go
+            ks
+          (xs !! n)
         _ -> errorWithoutStackTrace $ "Expected a list for selector '" <> show n <> "', but got: " <> show v
       )
       v
@@ -157,10 +166,12 @@ processResult h val = do
         NVSet xs _ ->
           maybe
             (errorWithoutStackTrace $ "Set does not contain key '" <> Text.unpack k <> "'")
-            (case ks of
-              [] -> h
-              _  -> go ks)
-          (M.lookup k xs)
+            (list
+              h
+              go
+              ks
+            )
+            (M.lookup k xs)
         _ -> errorWithoutStackTrace $ "Expected a set for selector '" <> Text.unpack k <> "', but got: " <> show v
       )
       v

src/Nix/Builtins.hs

@@ -38,7 +38,6 @@ import qualified Data.Aeson                    as A
 import           Data.Align                     ( alignWith )
 import           Data.Array
 import           Data.Bits
-import           Data.Bool                         ( bool )
 import           Data.ByteString                ( ByteString )
 import qualified Data.ByteString               as B
 import           Data.ByteString.Base16        as Base16