module Snap.Snaplet.Test
(
evalHandler
, evalHandler'
, runHandler
, runHandler'
, getSnaplet
, closeSnaplet
, InitializerState
, withTemporaryFile
)
where
import Control.Concurrent.MVar
import Control.Exception.Base (finally)
import qualified Control.Exception as E
import Control.Monad.IO.Class
import Control.Monad (join)
import Data.Maybe (fromMaybe)
import Data.IORef
import Data.Text
import System.Directory
import System.IO.Error
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Internal.Types
import Snap.Test hiding (evalHandler, runHandler)
import qualified Snap.Test as ST
import Snap.Snaplet.Internal.Initializer
withTemporaryFile :: FilePath -> IO () -> IO ()
withTemporaryFile :: FilePath -> IO () -> IO ()
withTemporaryFile FilePath
f = IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally (FilePath -> IO ()
removeFileMayNotExist FilePath
f)
removeFileMayNotExist :: FilePath -> IO ()
removeFileMayNotExist :: FilePath -> IO ()
removeFileMayNotExist FilePath
f = IO () -> () -> IO ()
forall a. IO a -> a -> IO a
catchNonExistence (FilePath -> IO ()
removeFile FilePath
f) ()
where
catchNonExistence :: IO a -> a -> IO a
catchNonExistence :: forall a. IO a -> a -> IO a
catchNonExistence IO a
job a
nonexistval =
IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch IO a
job ((IOError -> IO a) -> IO a) -> (IOError -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
nonexistval
else IOError -> IO a
forall a. IOError -> IO a
ioError IOError
e
execHandlerComputation :: MonadIO m
=> (RequestBuilder m () -> Snap v -> m a)
-> Maybe String
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text a)
execHandlerComputation :: forall (m :: * -> *) v a b.
MonadIO m =>
(RequestBuilder m () -> Snap v -> m a)
-> Maybe FilePath
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text a)
execHandlerComputation RequestBuilder m () -> Snap v -> m a
f Maybe FilePath
env RequestBuilder m ()
rq Handler b b v
h SnapletInit b b
s = do
Either Text (Snaplet b, InitializerState b)
app <- Maybe FilePath
-> SnapletInit b b
-> m (Either Text (Snaplet b, InitializerState b))
forall (m :: * -> *) b.
MonadIO m =>
Maybe FilePath
-> SnapletInit b b
-> m (Either Text (Snaplet b, InitializerState b))
getSnaplet Maybe FilePath
env SnapletInit b b
s
case Either Text (Snaplet b, InitializerState b)
app of
(Left Text
e) -> Either Text a -> m (Either Text a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> m (Either Text a))
-> Either Text a -> m (Either Text a)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left Text
e
(Right (Snaplet b
a, InitializerState b
is)) -> Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m a)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text a)
forall (m :: * -> *) b v a.
MonadIO m =>
Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m a)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text a)
execHandlerSnaplet Snaplet b
a InitializerState b
is RequestBuilder m () -> Snap v -> m a
f RequestBuilder m ()
rq Handler b b v
h
execHandlerSnaplet :: MonadIO m
=> Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m a)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text a)
execHandlerSnaplet :: forall (m :: * -> *) b v a.
MonadIO m =>
Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m a)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text a)
execHandlerSnaplet Snaplet b
a InitializerState b
is RequestBuilder m () -> Snap v -> m a
f RequestBuilder m ()
rq Handler b b v
h = do
a
res <- RequestBuilder m () -> Snap v -> m a
f RequestBuilder m ()
rq (Snap v -> m a) -> Snap v -> m a
forall a b. (a -> b) -> a -> b
$ Handler b b v -> Snaplet b -> Snap v
forall b a. Handler b b a -> Snaplet b -> Snap a
runPureBase Handler b b v
h Snaplet b
a
InitializerState b -> m ()
forall (m :: * -> *) b. MonadIO m => InitializerState b -> m ()
closeSnaplet InitializerState b
is
Either Text a -> m (Either Text a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> m (Either Text a))
-> Either Text a -> m (Either Text a)
forall a b. (a -> b) -> a -> b
$ a -> Either Text a
forall a b. b -> Either a b
Right a
res
runHandler :: MonadIO m
=> Maybe String
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text Response)
runHandler :: forall (m :: * -> *) b v.
MonadIO m =>
Maybe FilePath
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text Response)
runHandler = (RequestBuilder m () -> Snap v -> m Response)
-> Maybe FilePath
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text Response)
forall (m :: * -> *) v a b.
MonadIO m =>
(RequestBuilder m () -> Snap v -> m a)
-> Maybe FilePath
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text a)
execHandlerComputation RequestBuilder m () -> Snap v -> m Response
forall (m :: * -> *) a.
MonadIO m =>
RequestBuilder m () -> Snap a -> m Response
ST.runHandler
runHandler' :: MonadIO m
=> Snaplet b
-> InitializerState b
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text Response)
runHandler' :: forall (m :: * -> *) b v.
MonadIO m =>
Snaplet b
-> InitializerState b
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text Response)
runHandler' Snaplet b
a InitializerState b
is = Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m Response)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text Response)
forall (m :: * -> *) b v a.
MonadIO m =>
Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m a)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text a)
execHandlerSnaplet Snaplet b
a InitializerState b
is RequestBuilder m () -> Snap v -> m Response
forall (m :: * -> *) a.
MonadIO m =>
RequestBuilder m () -> Snap a -> m Response
ST.runHandler
evalHandler :: MonadIO m
=> Maybe String
-> RequestBuilder m ()
-> Handler b b a
-> SnapletInit b b
-> m (Either Text a)
evalHandler :: forall (m :: * -> *) b a.
MonadIO m =>
Maybe FilePath
-> RequestBuilder m ()
-> Handler b b a
-> SnapletInit b b
-> m (Either Text a)
evalHandler = (RequestBuilder m () -> Snap a -> m a)
-> Maybe FilePath
-> RequestBuilder m ()
-> Handler b b a
-> SnapletInit b b
-> m (Either Text a)
forall (m :: * -> *) v a b.
MonadIO m =>
(RequestBuilder m () -> Snap v -> m a)
-> Maybe FilePath
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text a)
execHandlerComputation RequestBuilder m () -> Snap a -> m a
forall (m :: * -> *) a.
MonadIO m =>
RequestBuilder m () -> Snap a -> m a
ST.evalHandler
evalHandler' :: MonadIO m
=> Snaplet b
-> InitializerState b
-> RequestBuilder m ()
-> Handler b b a
-> m (Either Text a)
evalHandler' :: forall (m :: * -> *) b a.
MonadIO m =>
Snaplet b
-> InitializerState b
-> RequestBuilder m ()
-> Handler b b a
-> m (Either Text a)
evalHandler' Snaplet b
a InitializerState b
is = Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap a -> m a)
-> RequestBuilder m ()
-> Handler b b a
-> m (Either Text a)
forall (m :: * -> *) b v a.
MonadIO m =>
Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m a)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text a)
execHandlerSnaplet Snaplet b
a InitializerState b
is RequestBuilder m () -> Snap a -> m a
forall (m :: * -> *) a.
MonadIO m =>
RequestBuilder m () -> Snap a -> m a
ST.evalHandler
getSnaplet :: MonadIO m
=> Maybe String
-> SnapletInit b b
-> m (Either Text (Snaplet b, InitializerState b))
getSnaplet :: forall (m :: * -> *) b.
MonadIO m =>
Maybe FilePath
-> SnapletInit b b
-> m (Either Text (Snaplet b, InitializerState b))
getSnaplet Maybe FilePath
env (SnapletInit Initializer b b (Snaplet b)
initializer) = IO (Either Text (Snaplet b, InitializerState b))
-> m (Either Text (Snaplet b, InitializerState b))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text (Snaplet b, InitializerState b))
-> m (Either Text (Snaplet b, InitializerState b)))
-> IO (Either Text (Snaplet b, InitializerState b))
-> m (Either Text (Snaplet b, InitializerState b))
forall a b. (a -> b) -> a -> b
$ do
MVar (Snaplet b)
mvar <- IO (MVar (Snaplet b))
forall a. IO (MVar a)
newEmptyMVar
let resetter :: (Snaplet b -> Snaplet b) -> IO ()
resetter Snaplet b -> Snaplet b
f = MVar (Snaplet b) -> (Snaplet b -> IO (Snaplet b)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Snaplet b)
mvar (Snaplet b -> IO (Snaplet b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Snaplet b -> IO (Snaplet b))
-> (Snaplet b -> Snaplet b) -> Snaplet b -> IO (Snaplet b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snaplet b -> Snaplet b
f)
((Snaplet b -> Snaplet b) -> IO ())
-> FilePath
-> Initializer b b (Snaplet b)
-> IO (Either Text (Snaplet b, InitializerState b))
forall b.
((Snaplet b -> Snaplet b) -> IO ())
-> FilePath
-> Initializer b b (Snaplet b)
-> IO (Either Text (Snaplet b, InitializerState b))
runInitializer (Snaplet b -> Snaplet b) -> IO ()
resetter (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"devel" Maybe FilePath
env) Initializer b b (Snaplet b)
initializer
closeSnaplet :: MonadIO m
=> InitializerState b
-> m ()
closeSnaplet :: forall (m :: * -> *) b. MonadIO m => InitializerState b -> m ()
closeSnaplet InitializerState b
is = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IORef (IO ()) -> IO (IO ())
forall a. IORef a -> IO a
readIORef (IORef (IO ()) -> IO (IO ())) -> IORef (IO ()) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ InitializerState b -> IORef (IO ())
forall b. InitializerState b -> IORef (IO ())
_cleanup InitializerState b
is)