From 60d074883447e6fc16a4cf4e7ed990f1511a8593 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Wed, 13 Apr 2022 16:27:01 -0600
Subject: [PATCH] Expose SIO type

---
 yesod-test/ChangeLog.md               |  4 ++
 yesod-test/Yesod/Test.hs              | 42 +++------------------
 yesod-test/Yesod/Test/Internal/SIO.hs | 54 +++++++++++++++++++++++++++
 yesod-test/yesod-test.cabal           |  1 +
 4 files changed, 64 insertions(+), 37 deletions(-)
 create mode 100644 yesod-test/Yesod/Test/Internal/SIO.hs

diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md
index a343b366..03460acc 100644
--- a/yesod-test/ChangeLog.md
+++ b/yesod-test/ChangeLog.md
@@ -1,5 +1,9 @@
 # ChangeLog for yesod-test
 
+## TODO
+
+* Add `Yesod.Test.Internal.SIO` module to expose the `SIO` type.
+
 ## 1.6.12
 
 * Fix import in cookie example [#1713](https://github.com/yesodweb/yesod/pull/1713)
diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index eced072c..f2adff40 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -243,10 +243,7 @@ import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 import Network.Wai
 import Network.Wai.Test hiding (assertHeader, assertNoHeader, request)
-import Control.Monad.Trans.Reader (ReaderT (..))
-import Conduit (MonadThrow)
 import Control.Monad.IO.Class
-import qualified Control.Monad.State.Class as MS
 import System.IO
 import Yesod.Core.Unsafe (runFakeHandler)
 import Yesod.Test.TransversingCSS
@@ -257,7 +254,6 @@ import Text.XML.Cursor hiding (element)
 import qualified Text.XML.Cursor as C
 import qualified Text.HTML.DOM as HD
 import Control.Monad.Trans.Writer
-import Data.IORef
 import qualified Data.Map as M
 import qualified Web.Cookie as Cookie
 import qualified Blaze.ByteString.Builder as Builder
@@ -281,6 +277,7 @@ import Data.Aeson (FromJSON, eitherDecode')
 import Control.Monad (unless)
 
 import Yesod.Test.Internal (getBodyTextPreview, contentTypeHeaderIsUtf8)
+import Yesod.Test.Internal.SIO
 
 {-# DEPRECATED byLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use byLabelExact, byLabelContain, byLabelPrefix or byLabelSuffix instead" #-}
 {-# DEPRECATED fileByLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use fileByLabelExact, fileByLabelContain, fileByLabelPrefix or fileByLabelSuffix instead" #-}
@@ -431,7 +428,7 @@ yit :: String -> YesodExample site () -> YesodSpec site
 yit label example = tell [YesodSpecItem label example]
 
 -- | Modifies the site ('yedSite') of the test, and creates a new WAI app ('yedApp') for it.
--- 
+--
 -- yesod-test allows sending requests to your application to test that it handles them correctly.
 -- In rare cases, you may wish to modify that application in the middle of a test.
 -- This may be useful if you wish to, for example, test your application under a certain configuration,
@@ -455,7 +452,7 @@ testModifySite :: YesodDispatch site
                => (site -> IO (site, Middleware)) -- ^ A function from the existing site, to a new site and middleware for a WAI app.
                -> YesodExample site ()
 testModifySite newSiteFn = do
-  currentSite <- getTestYesod 
+  currentSite <- getTestYesod
   (newSite, middleware) <- liftIO $ newSiteFn currentSite
   app <- liftIO $ toWaiAppPlain newSite
   modifySIO $ \yed -> yed { yedSite = newSite, yedApp = middleware app }
@@ -812,7 +809,7 @@ printMatches query = do
   matches <- htmlQuery query
   liftIO $ hPutStrLn stderr $ show matches
 
--- | Add a parameter with the given name and value to the request body. 
+-- | Add a parameter with the given name and value to the request body.
 -- This function can be called multiple times to add multiple parameters, and be mixed with calls to 'addFile'.
 --
 -- "Post parameter" is an informal description of what is submitted by making an HTTP POST with an HTML @\<form\>@.
@@ -1367,7 +1364,7 @@ setUrl url' = do
 -- > get "/foobar"
 -- > clickOn "a#idofthelink"
 --
--- @since 1.5.7 
+-- @since 1.5.7
 clickOn :: (HasCallStack, Yesod site) => Query -> YesodExample site ()
 clickOn query = do
   withResponse' yedResponse ["Tried to invoke clickOn in order to read HTML of a previous response."] $ \ res ->
@@ -1596,32 +1593,3 @@ instance YesodDispatch site => Hspec.Example (SIO (YesodExampleData site) a) whe
                 return ())
             params
             ($ ())
-
--- | State + IO
---
--- @since 1.6.0
-newtype SIO s a = SIO (ReaderT (IORef s) IO a)
-  deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadUnliftIO)
-
-instance MS.MonadState s (SIO s)
-  where
-  get = getSIO
-  put = putSIO
-
-getSIO :: SIO s s
-getSIO = SIO $ ReaderT readIORef
-
-putSIO :: s -> SIO s ()
-putSIO s = SIO $ ReaderT $ \ref -> writeIORef ref $! s
-
-modifySIO :: (s -> s) -> SIO s ()
-modifySIO f = SIO $ ReaderT $ \ref -> modifyIORef' ref f
-
-evalSIO :: SIO s a -> s -> IO a
-evalSIO (SIO (ReaderT f)) s = newIORef s >>= f
-
-execSIO :: SIO s () -> s -> IO s
-execSIO (SIO (ReaderT f)) s = do
-  ref <- newIORef s
-  f ref
-  readIORef ref
diff --git a/yesod-test/Yesod/Test/Internal/SIO.hs b/yesod-test/Yesod/Test/Internal/SIO.hs
new file mode 100644
index 00000000..5f6df528
--- /dev/null
+++ b/yesod-test/Yesod/Test/Internal/SIO.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+-- | The 'SIO' type is used by "Yesod.Test" to provide exception-safe
+-- environment between requests and assertions.
+--
+-- This module is internal. Breaking changes to this module will not be
+-- reflected in the major version of this package.
+--
+-- @since TODO
+module Yesod.Test.Internal.SIO where
+
+import Control.Monad.Trans.Reader (ReaderT (..))
+import Conduit (MonadThrow)
+import qualified Control.Monad.State.Class as MS
+import Yesod.Core
+import Data.IORef
+
+-- | State + IO
+--
+-- @since 1.6.0
+newtype SIO s a = SIO (ReaderT (IORef s) IO a)
+  deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadUnliftIO)
+
+instance MS.MonadState s (SIO s)
+  where
+  get = getSIO
+  put = putSIO
+
+getSIO :: SIO s s
+getSIO = SIO $ ReaderT readIORef
+
+putSIO :: s -> SIO s ()
+putSIO s = SIO $ ReaderT $ \ref -> writeIORef ref $! s
+
+modifySIO :: (s -> s) -> SIO s ()
+modifySIO f = SIO $ ReaderT $ \ref -> modifyIORef' ref f
+
+evalSIO :: SIO s a -> s -> IO a
+evalSIO (SIO (ReaderT f)) s = newIORef s >>= f
+
+execSIO :: SIO s () -> s -> IO s
+execSIO (SIO (ReaderT f)) s = do
+  ref <- newIORef s
+  f ref
+  readIORef ref
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index e49f2541..1c93f246 100644
--- a/yesod-test/yesod-test.cabal
+++ b/yesod-test/yesod-test.cabal
@@ -46,6 +46,7 @@ library
                      Yesod.Test.CssQuery
                      Yesod.Test.TransversingCSS
                      Yesod.Test.Internal
+                     Yesod.Test.Internal.SIO
     ghc-options:  -Wall
 
 test-suite test