{-# 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 (a -> SIO s b -> SIO s a
(a -> b) -> SIO s a -> SIO s b
(forall a b. (a -> b) -> SIO s a -> SIO s b)
-> (forall a b. a -> SIO s b -> SIO s a) -> Functor (SIO s)
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
<$ :: a -> SIO s b -> SIO s a
$c<$ :: forall s a b. a -> SIO s b -> SIO s a
fmap :: (a -> b) -> SIO s a -> SIO s b
$cfmap :: forall s a b. (a -> b) -> SIO s a -> SIO s b
Functor, Functor (SIO s)
a -> SIO s a
Functor (SIO s)
-> (forall a. a -> SIO s a)
-> (forall 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 a b. SIO s a -> SIO s b -> SIO s b)
-> (forall a b. SIO s a -> SIO s b -> SIO s a)
-> Applicative (SIO s)
SIO s a -> SIO s b -> SIO s b
SIO s a -> SIO s b -> SIO s a
SIO s (a -> b) -> SIO s a -> SIO s b
(a -> b -> c) -> SIO s a -> SIO s b -> SIO s c
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
<* :: SIO s a -> SIO s b -> SIO s a
$c<* :: forall s a b. SIO s a -> SIO s b -> SIO s a
*> :: SIO s a -> SIO s b -> SIO s b
$c*> :: forall s a b. SIO s a -> SIO s b -> SIO s b
liftA2 :: (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
<*> :: 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 :: a -> SIO s a
$cpure :: forall s a. a -> SIO s a
$cp1Applicative :: forall s. Functor (SIO s)
Applicative, Applicative (SIO s)
a -> SIO s a
Applicative (SIO s)
-> (forall a b. SIO s a -> (a -> SIO s b) -> SIO s b)
-> (forall a b. SIO s a -> SIO s b -> SIO s b)
-> (forall a. a -> SIO s a)
-> Monad (SIO s)
SIO s a -> (a -> SIO s b) -> SIO s b
SIO s a -> SIO s b -> SIO s b
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 :: a -> SIO s a
$creturn :: forall s a. a -> SIO s a
>> :: SIO s a -> SIO s b -> SIO s b
$c>> :: forall s a b. SIO s a -> SIO s b -> SIO s 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
$cp1Monad :: forall s. Applicative (SIO s)
Monad, Monad (SIO s)
Monad (SIO s) -> (forall a. IO a -> SIO s a) -> MonadIO (SIO s)
IO a -> SIO s a
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 :: IO a -> SIO s a
$cliftIO :: forall s a. IO a -> SIO s a
$cp1MonadIO :: forall s. Monad (SIO s)
MonadIO, Monad (SIO s)
e -> SIO s a
Monad (SIO s)
-> (forall e a. Exception e => e -> SIO s a) -> MonadThrow (SIO s)
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 :: e -> SIO s a
$cthrowM :: forall s e a. Exception e => e -> SIO s a
$cp1MonadThrow :: forall s. Monad (SIO s)
MonadThrow, MonadIO (SIO s)
MonadIO (SIO s)
-> (forall b. ((forall a. SIO s a -> IO a) -> IO b) -> SIO s b)
-> MonadUnliftIO (SIO s)
((forall a. SIO s a -> IO a) -> IO b) -> SIO s b
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 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
$cp1MonadUnliftIO :: forall s. MonadIO (SIO s)
MonadUnliftIO)

instance MS.MonadState s (SIO s)
  where
  get :: SIO s s
get = SIO s s
forall s. SIO s s
getSIO
  put :: s -> SIO s ()
put = s -> SIO s ()
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 :: SIO s s
getSIO = ReaderT (IORef s) IO s -> SIO s s
forall s a. ReaderT (IORef s) IO a -> SIO s a
SIO (ReaderT (IORef s) IO s -> SIO s s)
-> ReaderT (IORef s) IO s -> SIO s s
forall a b. (a -> b) -> a -> b
$ (IORef s -> IO s) -> ReaderT (IORef s) IO s
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT IORef s -> IO s
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 :: s -> SIO s ()
putSIO s
s = ReaderT (IORef s) IO () -> SIO s ()
forall s a. ReaderT (IORef s) IO a -> SIO s a
SIO (ReaderT (IORef s) IO () -> SIO s ())
-> ReaderT (IORef s) IO () -> SIO s ()
forall a b. (a -> b) -> a -> b
$ (IORef s -> IO ()) -> ReaderT (IORef s) IO ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef s -> IO ()) -> ReaderT (IORef s) IO ())
-> (IORef s -> IO ()) -> ReaderT (IORef s) IO ()
forall a b. (a -> b) -> a -> b
$ \IORef s
ref -> IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef s
ref (s -> IO ()) -> s -> IO ()
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 :: (s -> s) -> SIO s ()
modifySIO s -> s
f = ReaderT (IORef s) IO () -> SIO s ()
forall s a. ReaderT (IORef s) IO a -> SIO s a
SIO (ReaderT (IORef s) IO () -> SIO s ())
-> ReaderT (IORef s) IO () -> SIO s ()
forall a b. (a -> b) -> a -> b
$ (IORef s -> IO ()) -> ReaderT (IORef s) IO ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef s -> IO ()) -> ReaderT (IORef s) IO ())
-> (IORef s -> IO ()) -> ReaderT (IORef s) IO ()
forall a b. (a -> b) -> a -> b
$ \IORef s
ref -> IORef s -> (s -> s) -> IO ()
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 :: SIO s a -> s -> IO a
evalSIO SIO s a
action =
    ((s, a) -> a) -> IO (s, a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s, a) -> a
forall a b. (a, b) -> b
snd (IO (s, a) -> IO a) -> (s -> IO (s, a)) -> s -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SIO s a -> s -> IO (s, a)
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 :: SIO s () -> s -> IO s
execSIO SIO s ()
action =
    ((s, ()) -> s) -> IO (s, ()) -> IO s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s, ()) -> s
forall a b. (a, b) -> a
fst (IO (s, ()) -> IO s) -> (s -> IO (s, ())) -> s -> IO s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SIO s () -> s -> IO (s, ())
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 :: SIO s a -> s -> IO (s, a)
runSIO (SIO (ReaderT IORef s -> IO a
f)) s
s = do
    IORef s
ref <- s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s
    a
a <- IORef s -> IO a
f IORef s
ref
    s
s' <- IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
    (s, a) -> IO (s, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s', a
a)