#1005: coercion to NixString; iterNValue': flip 1st arg; unflip runFreshIdT

PR is interesting in `Utils` & `Value` where things were updated to fixpoint combinators.

Which, if internally laziness is preserved - running the function & apply the argument to it only once & optimize during compilation.

In Haskell Core I found that `fix` sometimes roughly converts just to `let x = f x in x` (stays a basic `let`, `letrec` in terms of Core language).

So far I can not reason beyond Core, it is hard to say how `letrec` compiles.

This is a work I did before the `Nix 2.4` release, which broke the CI on all fronts. I decided to not run putting created by upstream fires. Decided to not overcomplicate the Git processes for myself, so decided to finish & contribute the work first & then go do fix things.

Author: Anton-Latukha

main/Main.hs

@@ -19,7 +19,6 @@ import qualified Data.Text.IO                  as Text
 import           Text.Show.Pretty               ( ppShow )
 import           Nix                     hiding ( force )
 import           Nix.Convert
-import           Nix.Fresh.Basic
 import           Nix.Json
 import           Nix.Options.Parser
 import           Nix.Standard
@@ -47,16 +46,16 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
  where
   --  2021-07-15: NOTE: This logic should be weaved stronger through CLI options logic (OptParse-Applicative code)
   -- As this logic is not stated in the CLI documentation, for example. So user has no knowledge of these.
-  execContentsFilesOrRepl :: StandardT (StdIdT IO) ()
+  execContentsFilesOrRepl :: StdIO
   execContentsFilesOrRepl =
     fromMaybe
       loadFromCliFilePathList
-      ( loadBinaryCacheFile <|>
+      $ loadBinaryCacheFile <|>
         loadLiteralExpression <|>
         loadExpressionFromFile
-      )
    where
     -- | The base case: read expressions from the last CLI directive (@[FILE]@) listed on the command line.
+    loadFromCliFilePathList :: StdIO
     loadFromCliFilePathList =
       case filePaths of
         []     -> runRepl
@@ -67,27 +66,28 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
       runRepl = withEmptyNixContext Repl.main
 
       readExpressionFromStdin =
-        do
-          expr <- liftIO Text.getContents
-          processExpr expr
+        processExpr =<< liftIO Text.getContents
 
-    processSeveralFiles :: [Path] -> StandardT (StdIdT IO) ()
+    processSeveralFiles :: [Path] -> StdIO
     processSeveralFiles = traverse_ processFile
      where
       processFile path = handleResult (pure path) =<< parseNixFileLoc path
 
     -- |  The `--read` option: load expression from a serialized file.
+    loadBinaryCacheFile :: Maybe StdIO
     loadBinaryCacheFile =
       (\ (binaryCacheFile :: Path) ->
         do
           let file = replaceExtension binaryCacheFile "nixc"
-          processCLIOptions (Just file) =<< liftIO (readCache binaryCacheFile)
+          processCLIOptions (pure file) =<< liftIO (readCache binaryCacheFile)
       ) <$> readFrom
 
     -- | The `--expr` option: read expression from the argument string
+    loadLiteralExpression :: Maybe StdIO
     loadLiteralExpression = processExpr <$> expression
 
     -- | The `--file` argument: read expressions from the files listed in the argument file
+    loadExpressionFromFile :: Maybe StdIO
     loadExpressionFromFile =
       -- We can start use Text as in the base case, requires changing Path -> Text
       -- But that is a gradual process:
@@ -98,7 +98,8 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
           _fp -> readFile _fp
         ) <$> fromFile
 
-  processExpr text = handleResult Nothing     $   parseNixTextLoc text
+  processExpr :: Text -> StdIO
+  processExpr = handleResult mempty . parseNixTextLoc
 
   withEmptyNixContext = withNixContext mempty
 
@@ -120,10 +121,10 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
               expr' <- liftIO $ reduceExpr mpath expr
               either
                 (\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err)
-                (\ ty  -> liftIO $ putStrLn $ "Type of expression: " <>
-                  ppShow (maybeToMonoid $ Map.lookup @VarName @[Scheme] "it" $ coerce ty)
+                (liftIO . putStrLn . (<>) "Type of expression: " .
+                  ppShow . maybeToMonoid . Map.lookup @VarName @[Scheme] "it" . coerce
                 )
-                (HM.inferTop mempty (one ("it", stripAnnotation expr')))
+                $ HM.inferTop mempty $ curry one "it" $ stripAnnotation expr'
 
                 -- liftIO $ putStrLn $ runST $
                 --     runLintM opts . renderSymbolic =<< lint opts expr
@@ -133,23 +134,20 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
               NixException frames ->
                 errorWithoutStackTrace . show =<<
                   renderFrames
-                    @(StdValue (StandardT (StdIdT IO)))
-                    @(StdThunk (StandardT (StdIdT IO)))
+                    @StdVal
+                    @StdThun
                     frames
 
           when repl $
             withEmptyNixContext $
               bool
                 Repl.main
-                (do
-                  val <- nixEvalExprLoc (coerce mpath) expr
-                  Repl.main' $ pure val
-                )
+                ((Repl.main' . pure) =<< nixEvalExprLoc (coerce mpath) expr)
                 evaluate
       )
 
   --  2021-07-15: NOTE: Logic of CLI Option processing is scattered over several functions, needs to be consolicated.
-  processCLIOptions :: Maybe Path -> NExprLoc -> StandardT (StdIdT IO) ()
+  processCLIOptions :: Maybe Path -> NExprLoc -> StdIO
   processCLIOptions mpath expr
     | evaluate =
       if
@@ -174,37 +172,57 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
     evaluateExprWithEvaluator evaluator = evaluateExpression (coerce mpath) evaluator printer
 
     printer
-      | finder    = findAttrs <=< fromValue @(AttrSet (StdValue (StandardT (StdIdT IO))))
+      :: StdVal
+      -> StdIO
+    printer
+      | finder    = findAttrs <=< fromValue @(AttrSet StdVal)
       | otherwise = printer'
      where
       printer'
-        | xml       = go (stringIgnoreContext . toXML)                     normalForm
+        | xml       = fun (stringIgnoreContext . toXML)                     normalForm
         -- 2021-05-27: NOTE: With naive fix of the #941
         -- This is overall a naive printer implementation, as options should interact/respect one another.
         -- A nice question: "Should respect one another to what degree?": Go full combinator way, for which
         -- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),
         -- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.
-        | json      = go (stringIgnoreContext . mempty . nvalueToJSONNixString) normalForm
-        | strict    = go (show . prettyNValue)                             normalForm
-        | values    = go (show . prettyNValueProv)                         removeEffects
-        | otherwise = go (show . prettyNValue)                             removeEffects
+        | json      = fun (stringIgnoreContext . mempty . nvalueToJSONNixString) normalForm
+        | strict    = fun (show . prettyNValue)                             normalForm
+        | values    = fun (show . prettyNValueProv)                         removeEffects
+        | otherwise = fun (show . prettyNValue)                             removeEffects
        where
-        go
+        fun
           :: (b -> Text)
-          -> (a -> StandardT (StdIdT IO) b)
+          -> (a -> StandardIO b)
           -> a
-          -> StandardT (StdIdT IO) ()
-        go g f = liftIO . Text.putStrLn . g <=< f
+          -> StdIO
+        fun g f = liftIO . Text.putStrLn . g <=< f
 
       findAttrs
-        :: AttrSet (StdValue (StandardT (StdIdT IO)))
-        -> StandardT (StdIdT IO) ()
+        :: AttrSet StdVal
+        -> StdIO
       findAttrs = go mempty
        where
+        go :: Text -> AttrSet StdVal -> StdIO
         go prefix s =
-          do
-            xs <-
-              traverse
+          traverse_
+            (\ (k, mv) ->
+              do
+                let
+                  path              = prefix <> k
+                  (report, descend) = filterEntry path k
+                when report $
+                  do
+                    liftIO $ Text.putStrLn path
+                    when descend $
+                      maybe
+                        stub
+                        (\case
+                          NVSet _ s' -> go (path <> ".") s'
+                          _          -> stub
+                        )
+                        mv
+            )
+            =<< traverse
                 (\ (k, nv) ->
                   (k, ) <$>
                   free
@@ -214,12 +232,12 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
                           path         = prefix <> k
                           (_, descend) = filterEntry path k
 
-                        val <- readRef @(StandardT (StdIdT IO)) ref
+                        val <- readRef @StandardIO ref
                         bool
                           (pure Nothing)
                           (forceEntry path nv)
                           (descend &&
-                           deferred
+                            deferred
                             (const False)
                             (const True)
                             val
@@ -229,25 +247,6 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
                     nv
                 )
                 (sortWith fst $ M.toList $ M.mapKeys coerce s)
-            traverse_
-              (\ (k, mv) ->
-                do
-                  let
-                    path              = prefix <> k
-                    (report, descend) = filterEntry path k
-                  when report $
-                    do
-                      liftIO $ Text.putStrLn path
-                      when descend $
-                        maybe
-                          stub
-                          (\case
-                            NVSet _ s' -> go (path <> ".") s'
-                            _          -> stub
-                          )
-                          mv
-              )
-              xs
          where
           filterEntry path k = case (path, k) of
             ("stdenv", "stdenv"          ) -> (True , True )
@@ -267,36 +266,37 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
             _                              -> (True , True )
 
           forceEntry
-            :: MonadValue a (StandardT (StdIdT IO))
+            :: MonadValue a StandardIO
             => Text
             -> a
-            -> StandardT (StdIdT IO) (Maybe a)
+            -> StandardIO (Maybe a)
           forceEntry k v =
             catch
               (pure <$> demand v)
-              (\ (NixException frames) ->
-                do
-                  liftIO
-                    . Text.putStrLn
-                    . (("Exception forcing " <> k <> ": ") <>)
-                    . show =<<
-                      renderFrames
-                        @(StdValue (StandardT (StdIdT IO)))
-                        @(StdThunk (StandardT (StdIdT IO)))
-                        frames
-                  pure Nothing
-              )
+              fun
+           where
+            fun :: NixException -> StandardIO (Maybe a)
+            fun (coerce -> frames) =
+              do
+                liftIO
+                  . Text.putStrLn
+                  . (("Exception forcing " <> k <> ": ") <>)
+                  . show =<<
+                    renderFrames
+                      @StdVal
+                      @StdThun
+                      frames
+                pure Nothing
 
   reduction path mpathToContext annExpr =
     do
       eres <-
         withNixContext
           mpathToContext
-          (reducingEvalExpr
-            evalContent
-            mpathToContext
-            annExpr
-          )
+          $ reducingEvalExpr
+              evalContent
+              mpathToContext
+              annExpr
       handleReduced path eres
 
   handleReduced

src/Nix/Atoms.hs

@@ -11,7 +11,7 @@ import           Data.Binary                    ( Binary )
 import           Data.Aeson.Types               ( FromJSON
                                                 , ToJSON
                                                 )
---  2021-08-01: NOTE: Check the order efficience of NAtom constructors.
+--  2021-08-01: NOTE: Check the order effectiveness of NAtom constructors.
 
 -- | Atoms are values that evaluate to themselves.
 -- In other words - this is a constructors that are literals in Nix.

src/Nix/Builtins.hs

@@ -447,7 +447,7 @@ nixPathNix =
             <> rest
 
 toStringNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-toStringNix = toValue <=< coerceToString callFunc DontCopyToStore CoerceAny
+toStringNix = toValue <=< coerceAnyToNixString callFunc DontCopyToStore
 
 hasAttrNix
   :: forall e t f m
@@ -825,7 +825,7 @@ catAttrsNix attrName xs =
 baseNameOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
 baseNameOfNix x =
   do
-    ns <- coerceToString callFunc DontCopyToStore CoerceStringy x
+    ns <- coerceStringlikeToNixString DontCopyToStore x
     pure $
       nvStr $
         modifyNixContents
@@ -1208,11 +1208,9 @@ isFunctionNix nv =
         _           -> False
 
 throwNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
-throwNix mnv =
-  do
-    ns <- coerceToString callFunc CopyToStore CoerceStringy mnv
-
-    throwError . ErrorCall . toString $ stringIgnoreContext ns
+throwNix =
+  throwError . ErrorCall . toString . stringIgnoreContext
+    <=< coerceStringlikeToNixString CopyToStore
 
 -- | Implementation of Nix @import@ clause.
 --
@@ -1628,12 +1626,11 @@ execNix
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
 execNix xs =
   do
-    ls <- fromValue @[NValue t f m] xs
-    xs <- traverse (coerceToString callFunc DontCopyToStore CoerceStringy) ls
+    xs' <- traverse (coerceStringlikeToNixString DontCopyToStore) =<< fromValue @[NValue t f m] xs
     -- 2018-11-19: NOTE: Still need to do something with the context here
     -- See prim_exec in nix/src/libexpr/primops.cc
     -- Requires the implementation of EvalState::realiseContext
-    exec $ stringIgnoreContext <$> xs
+    exec $ stringIgnoreContext <$> xs'
 
 fetchurlNix
   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)

src/Nix/Effects.hs

@@ -432,6 +432,8 @@ addTextToStore a b c d =
     pure
     =<< addTextToStore' a b c d
 
+--  2021-10-30: NOTE: Misleading name, please rename.
+-- | Add @Path@ into the Nix Store
 addPath :: (Framed e m, MonadStore m) => Path -> m StorePath
 addPath p =
   either

src/Nix/Effects/Derivation.hs

@@ -309,9 +309,9 @@ defaultDerivationStrict val = do
     toStorePaths = foldl (flip addToInputs) mempty
 
     addToInputs :: Bifunctor p => StringContext -> p (Set Text) (Map Text [Text])  -> p (Set Text) (Map Text [Text])
-    addToInputs (StringContext path kind) = case kind of
-      DirectPath -> first (Set.insert (coerce path))
-      DerivationOutput o -> second (Map.insertWith (<>) (coerce path) $ one o)
+    addToInputs (StringContext (coerce -> path) kind) = case kind of
+      DirectPath -> first $ Set.insert path
+      DerivationOutput o -> second $ Map.insertWith (<>) path $ one o
       AllOutputs ->
         -- TODO: recursive lookup. See prim_derivationStrict
         -- XXX: When is this really used ?
@@ -372,7 +372,7 @@ buildDerivationWithContext drvAttrs = do
           rawString :: Text <- extractNixString jsonString
           pure $ one ("__json", rawString)
         else
-          traverse (extractNixString <=< lift . coerceToString callFunc CopyToStore CoerceAny) $
+          traverse (extractNixString <=< lift . coerceAnyToNixString callFunc CopyToStore) $
             Map.fromList $ M.toList $ deleteKeys [ "args", "__ignoreNulls" ] attrs
 
       pure $ Derivation { platform, builder, args, env,  hashMode, useJson

src/Nix/Eval.hs

@@ -565,7 +565,7 @@ framedEvalExprLoc
 framedEvalExprLoc =
   adi addMetaInfo evalContent
 
--- | Add source postionss & frame context system.
+-- | Add source positions & frame context system.
 addMetaInfo
   :: forall v m e a
   . (Framed e m, Scoped v m, Has e SrcSpan, Typeable m, Typeable v)