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 f :: 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 f :: 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 :: IO a -> a -> IO a
catchNonExistence job :: IO a
job nonexistval :: 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
$
\e :: IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then 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 :: (RequestBuilder m () -> Snap v -> m a)
-> Maybe FilePath
-> RequestBuilder m ()
-> Handler b b v
-> SnapletInit b b
-> m (Either Text a)
execHandlerComputation f :: RequestBuilder m () -> Snap v -> m a
f env :: Maybe FilePath
env rq :: RequestBuilder m ()
rq h :: Handler b b v
h s :: 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 e :: Text
e) -> Either Text a -> m (Either Text 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 (a :: Snaplet b
a, is :: 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 :: Snaplet b
-> InitializerState b
-> (RequestBuilder m () -> Snap v -> m a)
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text a)
execHandlerSnaplet a :: Snaplet b
a is :: InitializerState b
is f :: RequestBuilder m () -> Snap v -> m a
f rq :: RequestBuilder m ()
rq h :: 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 (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 :: 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' :: Snaplet b
-> InitializerState b
-> RequestBuilder m ()
-> Handler b b v
-> m (Either Text Response)
runHandler' a :: Snaplet b
a is :: 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 :: 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' :: Snaplet b
-> InitializerState b
-> RequestBuilder m ()
-> Handler b b a
-> m (Either Text a)
evalHandler' a :: Snaplet b
a is :: 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 :: Maybe FilePath
-> SnapletInit b b
-> m (Either Text (Snaplet b, InitializerState b))
getSnaplet env :: Maybe FilePath
env (SnapletInit initializer :: Initializer b b (Snaplet b)
initializer) = IO (Either Text (Snaplet b, InitializerState b))
-> m (Either Text (Snaplet b, InitializerState b))
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 f :: 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 (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 "devel" Maybe FilePath
env) Initializer b b (Snaplet b)
initializer
closeSnaplet :: MonadIO m
=> InitializerState b
-> m ()
closeSnaplet :: InitializerState b -> m ()
closeSnaplet is :: InitializerState b
is = IO () -> m ()
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)