{-# 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 1.6.13
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 (forall a b. a -> SIO s b -> SIO s a
forall a b. (a -> b) -> SIO s a -> SIO s b
forall s a b. a -> SIO s b -> SIO s a
forall s a b. (a -> b) -> SIO s a -> SIO s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SIO s b -> SIO s a
$c<$ :: forall s a b. a -> SIO s b -> SIO s a
fmap :: forall a b. (a -> b) -> SIO s a -> SIO s b
$cfmap :: forall s a b. (a -> b) -> SIO s a -> SIO s b
Functor, forall s. Functor (SIO s)
forall a. a -> SIO s a
forall s a. a -> SIO s a
forall a b. SIO s a -> SIO s b -> SIO s a
forall a b. SIO s a -> SIO s b -> SIO s b
forall a b. SIO s (a -> b) -> SIO s a -> SIO s b
forall s a b. SIO s a -> SIO s b -> SIO s a
forall s a b. SIO s a -> SIO s b -> SIO s b
forall s a b. SIO s (a -> b) -> SIO s a -> SIO s b
forall a b c. (a -> b -> c) -> SIO s a -> SIO s b -> SIO s c
forall s a b c. (a -> b -> c) -> SIO s a -> SIO s b -> SIO s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. SIO s a -> SIO s b -> SIO s a
$c<* :: forall s a b. SIO s a -> SIO s b -> SIO s a
*> :: forall a b. SIO s a -> SIO s b -> SIO s b
$c*> :: forall s a b. SIO s a -> SIO s b -> SIO s b
liftA2 :: forall a b c. (a -> b -> c) -> SIO s a -> SIO s b -> SIO s c
$cliftA2 :: forall s a b c. (a -> b -> c) -> SIO s a -> SIO s b -> SIO s c
<*> :: forall a b. SIO s (a -> b) -> SIO s a -> SIO s b
$c<*> :: forall s a b. SIO s (a -> b) -> SIO s a -> SIO s b
pure :: forall a. a -> SIO s a
$cpure :: forall s a. a -> SIO s a
Applicative, forall s. Applicative (SIO s)
forall a. a -> SIO s a
forall s a. a -> SIO s a
forall a b. SIO s a -> SIO s b -> SIO s b
forall a b. SIO s a -> (a -> SIO s b) -> SIO s b
forall s a b. SIO s a -> SIO s b -> SIO s b
forall s a b. SIO s a -> (a -> SIO s b) -> SIO s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> SIO s a
$creturn :: forall s a. a -> SIO s a
>> :: forall a b. SIO s a -> SIO s b -> SIO s b
$c>> :: forall s a b. SIO s a -> SIO s b -> SIO s b
>>= :: forall a b. SIO s a -> (a -> SIO s b) -> SIO s b
$c>>= :: forall s a b. SIO s a -> (a -> SIO s b) -> SIO s b
Monad, forall s. Monad (SIO s)
forall a. IO a -> SIO s a
forall s a. IO a -> SIO s a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> SIO s a
$cliftIO :: forall s a. IO a -> SIO s a
MonadIO, forall s. Monad (SIO s)
forall e a. Exception e => e -> SIO s a
forall s e a. Exception e => e -> SIO s a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> SIO s a
$cthrowM :: forall s e a. Exception e => e -> SIO s a
MonadThrow, forall s. MonadIO (SIO s)
forall b. ((forall a. SIO s a -> IO a) -> IO b) -> SIO s b
forall s b. ((forall a. SIO s a -> IO a) -> IO b) -> SIO s b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b. ((forall a. SIO s a -> IO a) -> IO b) -> SIO s b
$cwithRunInIO :: forall s b. ((forall a. SIO s a -> IO a) -> IO b) -> SIO s b
MonadUnliftIO)

instance MS.MonadState s (SIO s)
  where
  get :: SIO s s
get = forall s. SIO s s
getSIO
  put :: s -> SIO s ()
put = forall s. s -> SIO s ()
putSIO

-- | Retrieve the current state in the 'SIO' type.
--
-- Equivalent to 'MS.get'
--
-- @since 1.6.13
getSIO :: SIO s s
getSIO :: forall s. SIO s s
getSIO = forall s a. ReaderT (IORef s) IO a -> SIO s a
SIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a. IORef a -> IO a
readIORef

-- | Put the given @s@ into the 'SIO' state for later retrieval.
--
-- Equivalent to 'MS.put', but the value is evaluated to weak head normal
-- form.
--
-- @since 1.6.13
putSIO :: s -> SIO s ()
putSIO :: forall s. s -> SIO s ()
putSIO s
s = forall s a. ReaderT (IORef s) IO a -> SIO s a
SIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \IORef s
ref -> forall a. IORef a -> a -> IO ()
writeIORef IORef s
ref forall a b. (a -> b) -> a -> b
$! s
s

-- | Modify the underlying @s@ state.
--
-- This is strict in the function used, and is equivalent to 'MS.modify''.
--
-- @since 1.6.13
modifySIO :: (s -> s) -> SIO s ()
modifySIO :: forall s. (s -> s) -> SIO s ()
modifySIO s -> s
f = forall s a. ReaderT (IORef s) IO a -> SIO s a
SIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \IORef s
ref -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef s
ref s -> s
f

-- | Run an 'SIO' action with the intial state @s@ provided, returning the
-- result, and discard the final state.
--
-- @since 1.6.13
evalSIO :: SIO s a -> s -> IO a
evalSIO :: forall s a. SIO s a -> s -> IO a
evalSIO SIO s a
action =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. SIO s a -> s -> IO (s, a)
runSIO SIO s a
action

-- | Run an 'SIO' action with the initial state @s@ provided, returning the
-- final state, and discarding the result.
--
-- @since 1.6.13
execSIO :: SIO s () -> s -> IO s
execSIO :: forall s. SIO s () -> s -> IO s
execSIO SIO s ()
action =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. SIO s a -> s -> IO (s, a)
runSIO SIO s ()
action

-- | Run an 'SIO' action with the initial state provided, returning both
-- the result of the computation as well as the final state.
--
-- @since 1.6.13
runSIO :: SIO s a -> s -> IO (s, a)
runSIO :: forall s a. SIO s a -> s -> IO (s, a)
runSIO (SIO (ReaderT IORef s -> IO a
f)) s
s = do
    IORef s
ref <- forall a. a -> IO (IORef a)
newIORef s
s
    a
a <- IORef s -> IO a
f IORef s
ref
    s
s' <- forall a. IORef a -> IO a
readIORef IORef s
ref
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s', a
a)