Restore the pretty show instance for NValue m (orphaned in Pretty for now)

src/Nix/Builtins.hs

@@ -231,7 +231,7 @@ hasAttr x y = force x $ \x' -> force y $ \y' -> case (x', y') of
     (NVStr key _, NVSet aset _) ->
         return . NVConstant . NBool $ M.member key aset
     (x, y) -> throwError $ "Invalid types for builtin.hasAttr: "
-                 ++ show (void x, void y)
+                 ++ show (x, y)
 
 getAttr :: MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
 getAttr x y = force x $ \x' -> force y $ \y' -> case (x', y') of
@@ -240,7 +240,7 @@ getAttr x y = force x $ \x' -> force y $ \y' -> case (x', y') of
                       ++ Text.unpack key
         Just action -> force action pure
     (x, y) -> throwError $ "Invalid types for builtin.getAttr: "
-                 ++ show (void x, void y)
+                 ++ show (x, y)
 
 unsafeGetAttrPos :: forall e m. MonadBuiltins e m
                  => NThunk m -> NThunk m -> m (NValue m)
@@ -251,13 +251,13 @@ unsafeGetAttrPos x y = force x $ \x' -> force y $ \y' -> case (x', y') of
                 ++ "' does not exist in attr set: " ++ show apos
         Just delta -> return $ posFromSourcePos @m delta
     (x, y) -> throwError $ "Invalid types for builtin.unsafeGetAttrPos: "
-                 ++ show (void x, void y)
+                 ++ show (x, y)
 
 length_ :: MonadBuiltins e m => NThunk m -> m (NValue m)
 length_ = flip force $ \case
     NVList l -> return $ NVConstant $ NInt (fromIntegral (length l))
     arg -> throwError $ "builtins.length takes a list, not a "
-              ++ show (void arg)
+              ++ show arg
 
 anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 anyM _ []       = return False
@@ -271,7 +271,7 @@ any_ pred = flip force $ \case
     NVList l ->
         mkBool =<< anyM extractBool =<< mapM (call1 pred) l
     arg -> throwError $ "builtins.any takes a list as second argument, not a "
-              ++ show (void arg)
+              ++ show arg
 
 allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 allM _ []       = return True
@@ -285,14 +285,14 @@ all_ pred = flip force $ \case
     NVList l ->
         mkBool =<< allM extractBool =<< mapM (call1 pred) l
     arg -> throwError $ "builtins.all takes a list as second argument, not a "
-              ++ show (void arg)
+              ++ show arg
 
 --TODO: Strictness
 foldl'_ :: MonadBuiltins e m => NThunk m -> NThunk m -> NThunk m -> m (NValue m)
 foldl'_ f z = flip force $ \case
     NVList vals -> (`force` pure) =<< foldlM go z vals
     arg -> throwError $ "builtins.foldl' takes a list as third argument, not a "
-              ++ show (void arg)
+              ++ show arg
   where
     go b a = thunk $ call2 f a b
 
@@ -656,7 +656,7 @@ getEnv_ = flip force $ \case
         return $ case mres of
             Nothing -> NVStr "" mempty
             Just v  -> NVStr (Text.pack v) mempty
-    p -> throwError $ "Unexpected argument to getEnv: " ++ show (void p)
+    p -> throwError $ "Unexpected argument to getEnv: " ++ show p
 
 sort_ :: MonadBuiltins e m => NThunk m -> NThunk m -> m (NValue m)
 sort_ comparator list = force list $ \case

src/Nix/Exec.hs

@@ -209,16 +209,16 @@ execBinaryOp NOr larg rarg = case larg of
         then valueRefBool True
         else rarg >>= \case
             NVConstant (NBool r) -> valueRefBool r
-            v -> throwError $ "operator `||`: left argument: boolean expected, got " ++ show (void v)
-    v -> throwError $ "operator `||`: right argument: boolean expected, got " ++ show (void v)
+            v -> throwError $ "operator `||`: left argument: boolean expected, got " ++ show v
+    v -> throwError $ "operator `||`: right argument: boolean expected, got " ++ show v
 
 execBinaryOp NAnd larg rarg = case larg of
     NVConstant (NBool l) -> if l
         then rarg >>= \case
             NVConstant (NBool r) -> valueRefBool r
-            v -> throwError $ "operator `&&`: left argument: boolean expected, got " ++ show (void v)
+            v -> throwError $ "operator `&&`: left argument: boolean expected, got " ++ show v
         else valueRefBool False
-    v -> throwError $ "operator `&&`: right argument: boolean expected, got " ++ show (void v)
+    v -> throwError $ "operator `&&`: right argument: boolean expected, got " ++ show v
 
 -- jww (2018-04-08): Refactor so that eval (NBinary ..) *always* dispatches
 -- based on operator first
@@ -364,7 +364,7 @@ instance (MonadFix m, MonadThrow m, MonadIO m) => MonadEffects (Lazy m) where
                         v -> throwError $ "when resolving relative path,"
                                 ++ " __cur_file is in scope,"
                                 ++ " but is not a path; it is: "
-                                ++ show (void v)
+                                ++ show v
             pure $ cwd </> origPath
         liftIO $ removeDotDotIndirections <$> canonicalizePath absPath
 

src/Nix/Pretty.hs

@@ -1,7 +1,10 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Nix.Pretty where
 
@@ -227,3 +230,10 @@ removeEffects = Fix . fmap dethunk
 
 showValue :: Functor m => NValue m -> String
 showValue = show . prettyNixValue . removeEffects
+
+instance Functor m => Show (NValue m) where
+    show = showValue
+
+instance Functor m => Show (NThunk m) where
+    show (NThunk (Value v)) = show v
+    show (NThunk _) = "<thunk>"

src/Nix/Value.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -72,11 +73,7 @@ newtype NThunk m   = NThunk (Thunk m (NValue m))
 type    NValue m   = NValueF m (NThunk m) -- head normal form
 type    ValueSet m = AttrSet (NThunk m)
 
-instance Show (NThunk m) where
-    show (NThunk (Value v)) = show v
-    show (NThunk _) = "<thunk>"
-
-instance Show f => Show (NValueF m f) where
+instance Show (NValueF m (Fix (NValueF m))) where
     showsPrec = flip go where
       go (NVConstant atom)    = showsCon1 "NVConstant" atom
       go (NVStr text context) = showsCon2 "NVStr"      text (appEndo context [])

tests/EvalTests.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -Wno-missing-signatures -Wno-orphans #-}
 
@@ -89,7 +91,7 @@ genEvalCompareTests = do
     testDir = "tests/eval-compare"
     mkTestCase f = testCase f $ assertEvalFileMatchesNix (testDir </> f)
 
-instance (Show r, Eq r) => Eq (NValueF m r) where
+instance (Show r, Show (NValueF m r), Eq r) => Eq (NValueF m r) where
     NVConstant x == NVConstant y = x == y
     NVList x == NVList y = and (zipWith (==) x y)
     x == y = error $ "Need to add comparison for values: "