From 6fbd20ceeb54dab95b042f506ca9370473c86549 Mon Sep 17 00:00:00 2001
From: "Brian J. Cardiff" <bcardiff@gmail.com>
Date: Sat, 17 Aug 2024 23:40:51 -0300
Subject: [PATCH] Make PromptIO a newtype

---
 cabal-install/src/Distribution/Client/Init/Types.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/cabal-install/src/Distribution/Client/Init/Types.hs b/cabal-install/src/Distribution/Client/Init/Types.hs
index 591fe15ff55..5934f1185a5 100644
--- a/cabal-install/src/Distribution/Client/Init/Types.hs
+++ b/cabal-install/src/Distribution/Client/Init/Types.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- |
 -- Module      :  Distribution.Client.Init.Types
@@ -69,6 +70,7 @@ import qualified Distribution.Client.Compat.Prelude as P
 import Prelude (read)
 
 import Control.Monad.Catch
+import Control.Monad.IO.Class
 import Control.Monad.Reader
 
 import Data.List.NonEmpty (fromList)
@@ -290,10 +292,11 @@ mkLiterate _ hs = hs
 -- -------------------------------------------------------------------- --
 -- Interactive prompt monad
 
-type PromptIO = ReaderT (Data.IORef.IORef SessionState) IO
+newtype PromptIO a = PromptIO (ReaderT (Data.IORef.IORef SessionState) IO a)
+  deriving (Functor, Applicative, Monad, MonadIO, MonadReader (Data.IORef.IORef SessionState))
 
 runPromptIO :: PromptIO a -> IO a
-runPromptIO pio =
+runPromptIO (PromptIO pio) =
   (Data.IORef.newIORef newSessionState) >>= (runReaderT pio)
 
 type Inputs = NonEmpty String
@@ -388,9 +391,9 @@ instance Interactive PromptIO where
   getEnvironment = liftIO P.getEnvironment
   getCurrentYear = liftIO P.getCurrentYear
   listFilesInside test dir = do
-    sessionState <- ask
-    -- test is run within the same env
-    liftIO $ P.listFilesInside (\f -> liftIO $ runReaderT (test f) sessionState) dir
+    -- test is run within a new env and not the current env
+    -- all usages of listFilesInside are pure functions actually
+    liftIO $ P.listFilesInside (\f -> liftIO $ runPromptIO (test f)) dir
   listFilesRecursive = liftIO <$> P.listFilesRecursive
 
   putStr = liftIO <$> P.putStr