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 = forall a b. IO a -> IO b -> IO a
finally (FilePath -> IO ()
removeFileMayNotExist FilePath
f)
removeFileMayNotExist :: FilePath -> IO ()
removeFileMayNotExist :: FilePath -> IO ()
removeFileMayNotExist FilePath
f = 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 =
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch IO a
job forall a b. (a -> b) -> a -> b
$
\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then forall (m :: * -> *) a. Monad m => a -> m a
return a
nonexistval
else 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 <- 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) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
e
(Right (Snaplet b
a, InitializerState b
is)) -> 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 forall a b. (a -> b) -> a -> b
$ forall b a. Handler b b a -> Snaplet b -> Snap a
runPureBase Handler b b v
h Snaplet b
a
forall (m :: * -> *) b. MonadIO m => InitializerState b -> m ()
closeSnaplet InitializerState b
is
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = 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 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 = 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 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 = 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 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 = 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 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) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
MVar (Snaplet b)
mvar <- forall a. IO (MVar a)
newEmptyMVar
let resetter :: (Snaplet b -> Snaplet b) -> IO ()
resetter Snaplet b -> Snaplet b
f = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Snaplet b)
mvar (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snaplet b -> Snaplet b
f)
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 (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall b. InitializerState b -> IORef (IO ())
_cleanup InitializerState b
is)