Merge #942: Quickfix for #941 & refactors

  * `Nix.Type.Env`:
    * added instances:
      * `Env`: `{Semigroup,Monoid,One}`
  * `Nix`:
    * changed argument order:
      * `nixEval`:

        ```haskell
        -- was:
          => Maybe FilePath -> Transform g (m a) -> Alg g (m a) -> Fix g -> m a
        -- became:
          => Transform g (m a) -> Alg g (m a) -> Maybe FilePath -> Fix g -> m a
        ```

  * `Nix.Normal`
    * add `thunkVal` literal & use it where appropriate `{deThunk, removeEffects}`
    * rename `opaque(,->Val)`, indicate that it is a literal.

Author: Anton-Latukha

ChangeLog.md

@@ -21,9 +21,25 @@ Breaking:
   * `Nix.Types.Assumption`:
     * added instances:
       * `Assumption`: `{Semigroup,Monoid,One}`
+
   * `Nix.Type.Env`:
     * added instances:
       * `Env`: `{Semigroup,Monoid,One}`
+  * `Nix`:
+    * changed argument order:
+      * `nixEval`:
+        
+        ```haskell
+        -- was:
+          => Maybe FilePath -> Transform g (m a) -> Alg g (m a) -> Fix g -> m a
+        -- became:
+          => Transform g (m a) -> Alg g (m a) -> Maybe FilePath -> Fix g -> m a
+        ```
+        
+  * `Nix.Normal`
+    * add `thunkVal` literal & use it where appropriate `{deThunk, removeEffects}`
+    * rename `opaque(,->Val)`, indicate that it is a literal.
+       
 
 
 ### [(diff)](https://github.com/haskell-nix/hnix/compare/0.13.0.1...0.13.1#files_bucket) 0.13.1 (2021-05-22)

main/Main.hs

@@ -157,7 +157,12 @@ main =
     printer
       | finder opts = findAttrs <=< fromValue @(AttrSet (StdValue (StandardT (StdIdT IO))))
       | xml    opts = liftIO . Text.putStrLn . stringIgnoreContext . toXML <=< normalForm
-      | json   opts = liftIO . Text.putStrLn . stringIgnoreContext         <=< nvalueToJSONNixString
+      -- 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   opts = liftIO . Text.putStrLn . stringIgnoreContext         <=< nvalueToJSONNixString <=< normalForm
       | strict opts = liftIO . print         . prettyNValue                <=< normalForm
       | values opts = liftIO . print         . prettyNValueProv            <=< removeEffects
       | otherwise   = liftIO . print         . prettyNValue                <=< removeEffects

src/Nix.hs

@@ -55,20 +55,20 @@ import           Nix.XML
 --   transformations, allowing them to be easily composed.
 nixEval
   :: (MonadNix e t f m, Has e Options, Functor g)
-  => Maybe FilePath
-  -> Transform g (m a)
+  => Transform g (m a)
   -> Alg g (m a)
+  -> Maybe FilePath
   -> Fix g
   -> m a
-nixEval mpath xform alg = withNixContext mpath . adi alg xform
+nixEval transform alg mpath = withNixContext mpath . adi alg transform
 
 -- | Evaluate a nix expression in the default context
 nixEvalExpr
   :: (MonadNix e t f m, Has e Options)
   => Maybe FilePath
   -> NExpr
   -> m (NValue t f m)
-nixEvalExpr mpath = nixEval mpath id Eval.eval
+nixEvalExpr = nixEval id Eval.eval
 
 -- | Evaluate a nix expression in the default context
 nixEvalExprLoc
@@ -77,9 +77,8 @@ nixEvalExprLoc
   => Maybe FilePath
   -> NExprLoc
   -> m (NValue t f m)
-nixEvalExprLoc mpath =
+nixEvalExprLoc =
   nixEval
-    mpath
     Eval.addMetaInfo
     Eval.evalContent
 
@@ -126,7 +125,7 @@ evaluateExpression mpath evaluator handler expr =
 
   eval' = normalForm <=< nixEvalExpr mpath
 
-  argmap args = nvSet mempty (M.fromList args)
+  argmap args = nvSet mempty $ M.fromList args
 
 processResult
   :: forall e t f m a
@@ -135,34 +134,26 @@ processResult
   -> NValue t f m
   -> m a
 processResult h val = do
-  opts :: Options <- asks (view hasLens)
+  opts :: Options <- asks $ view hasLens
   maybe
     (h val)
-    (\ (Text.splitOn "." -> keys) -> go keys val)
+    (\ (Text.splitOn "." -> keys) -> processKeys keys val)
     (attr opts)
  where
-  go :: [Text] -> NValue t f m -> m a
-  go [] v = h v
-  go ((Text.decimal -> Right (n,"")) : ks) v =
-    (\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 $ toString $ "Set does not contain key '" <> k <> "'")
-          (list
-            h
-            go
-            ks
-          )
-          (M.lookup k xs)
-      _ -> errorWithoutStackTrace $ toString $ "Expected a set for selector '" <> k <> "', but got: " <> show v
-    ) =<< demand v
+  processKeys :: [Text] -> NValue t f m -> m a
+  processKeys kys v =
+    list
+      (h v)
+      (\ (k : ks) ->
+        do
+          v' <- demand v
+          case (k, v') of
+            (Text.decimal -> Right (n,""), NVList xs) -> processKeys ks $ xs !! n
+            (_,         NVSet xs _) ->
+              maybe
+                (errorWithoutStackTrace $ toString $ "Set does not contain key '" <> k <> "'")
+                (processKeys ks)
+                (M.lookup k xs)
+            (_, _) -> errorWithoutStackTrace $ toString $ "Expected a set or list for selector '" <> k <> "', but got: " <> show v
+      )
+      kys

src/Nix/Normal.hs

@@ -140,6 +140,9 @@ normalForm_
   -> m ()
 normalForm_ t = void $ normalizeValue t
 
+opaqueVal :: Applicative f => NValue t f m
+opaqueVal = nvStr $ makeNixStringWithoutContext "<cycle>"
+
 -- | Detect cycles & stub them.
 stubCycles
   :: forall t f m
@@ -161,7 +164,10 @@ stubCycles =
     )
     Free
  where
-  Free (NValue' cyc) = opaque
+  Free (NValue' cyc) = opaqueVal
+
+thunkVal :: Applicative f => NValue t f m
+thunkVal = nvStr $ makeNixStringWithoutContext "<thunk>"
 
 removeEffects
   :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
@@ -171,14 +177,11 @@ removeEffects =
   iterNValueM
     id
     --  2021-02-25: NOTE: Please, unflip this up the stack
-    (\ t f -> f =<< queryM (pure opaque) t)
+    (\ t f -> f =<< queryM (pure thunkVal) t)
     (fmap Free . sequenceNValue' id)
 
-opaque :: Applicative f => NValue t f m
-opaque = nvStr $ makeNixStringWithoutContext "<cycle>"
-
 dethunk
   :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
   => t
   -> m (NValue t f m)
-dethunk = removeEffects <=< queryM (pure opaque)
+dethunk = removeEffects <=< queryM (pure thunkVal)

src/Nix/Render/Frame.hs

@@ -206,7 +206,7 @@ renderValue
   -> NValue t f m
   -> m (Doc ann)
 renderValue _level _longLabel _shortLabel v = do
-  opts :: Options <- asks (view hasLens)
+  opts :: Options <- asks $ view hasLens
   bool
     prettyNValue
     prettyNValueProv