Factor out MonadIntrospect

src/Nix/Effects.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -30,7 +31,7 @@ import           System.Process
 -- | A path into the nix store
 newtype StorePath = StorePath { unStorePath :: FilePath }
 
-class (MonadFile m, MonadStore m, MonadPutStr m, MonadHttp m, MonadEnv m, MonadInstantiate m, MonadExec m) => MonadEffects m where
+class (MonadFile m, MonadStore m, MonadPutStr m, MonadHttp m, MonadEnv m, MonadInstantiate m, MonadExec m, MonadIntrospect m) => MonadEffects m where
     -- | Determine the absolute path of relative path in the current context
     makeAbsolutePath :: FilePath -> m FilePath
     findEnvPath :: String -> m FilePath
@@ -44,10 +45,25 @@ class (MonadFile m, MonadStore m, MonadPutStr m, MonadHttp m, MonadEnv m, MonadI
 
     derivationStrict :: NValue m -> m (NValue m)
 
-    getRecursiveSize :: a -> m (NValue m)
-
     traceEffect :: String -> m ()
 
+class Monad m => MonadIntrospect m where
+    recursiveSize :: a -> m Word
+    default recursiveSize :: (MonadTrans t, MonadIntrospect m', m ~ t m') => a -> m Word
+    recursiveSize = lift . recursiveSize
+
+instance MonadIntrospect IO where
+    recursiveSize =
+#ifdef MIN_VERSION_ghc_datasize
+#if MIN_VERSION_ghc_datasize(0,2,0) && __GLASGOW_HASKELL__ >= 804
+        recursiveSize
+#else
+        \_ -> return 0
+#endif
+#else
+        \_ -> return 0
+#endif
+
 class Monad m => MonadExec m where
     exec' :: [String] -> m (Either ErrorCall NExprLoc)
     default exec' :: (MonadTrans t, MonadExec m', m ~ t m') => [String] -> m (Either ErrorCall NExprLoc)

src/Nix/Exec.hs

@@ -507,9 +507,11 @@ instance MonadInstantiate m => MonadInstantiate (Lazy m)
 
 instance MonadExec m => MonadExec (Lazy m)
 
+instance MonadIntrospect m => MonadIntrospect (Lazy m)
+
 instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
           MonadPutStr m, MonadHttp m, MonadEnv m, MonadInstantiate m, MonadExec m,
-          MonadIO m, Alternative m, MonadPlus m, Typeable m)
+          MonadIntrospect m, MonadIO m, Alternative m, MonadPlus m, Typeable m)
       => MonadEffects (Lazy m) where
     makeAbsolutePath origPath = do
         origPathExpanded <- expandHomePath origPath
@@ -571,19 +573,11 @@ instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
           where
             coerceNix = toNix . Text.pack <=< coerceToString True True
 
-    getRecursiveSize =
-#ifdef MIN_VERSION_ghc_datasize
-#if MIN_VERSION_ghc_datasize(0,2,0) && __GLASGOW_HASKELL__ >= 804
-        toNix @Integer <=< fmap fromIntegral . liftIO . recursiveSize
-#else
-        const $ toNix (0 :: Integer)
-#endif
-#else
-        const $ toNix (0 :: Integer)
-#endif
-
     traceEffect = putStrLn
 
+getRecursiveSize :: MonadIntrospect m => a -> m (NValue m)
+getRecursiveSize = toNix @Integer . fromIntegral <=< recursiveSize
+
 runLazyM :: Options -> MonadIO m => Lazy m a -> m a
 runLazyM opts = (`evalStateT` M.empty)
               . (`runReaderT` newContext opts)