-- | The Snap.Snaplet.Test module contains primitives and combinators for
-- testing Snaplets.
module Snap.Snaplet.Test
  (
    -- ** Testing handlers
    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


------------------------------------------------------------------------------
-- | Remove the given file after running an IO computation. Obviously it
-- can be used with 'Assertion'.
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)


------------------------------------------------------------------------------
-- | Utility function taken from Darcs
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


------------------------------------------------------------------------------
-- | Helper to keep "runHandler" and "evalHandler" DRY.
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


------------------------------------------------------------------------------
-- | Helper to allow multiple calls to "runHandler" or "evalHandler" without
-- multiple initializations.
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

------------------------------------------------------------------------------
-- | Given a Snaplet Handler and a 'RequestBuilder' defining
-- a test request, runs the Handler, producing an HTTP 'Response'.
--
-- Note that the output of this function is slightly different from
-- 'runHandler' defined in Snap.Test, because due to the fact running
-- the initializer inside 'SnapletInit' can throw an exception.
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

------------------------------------------------------------------------------
-- | A variant of runHandler that takes the Snaplet and InitializerState as
-- produced by getSnaplet, so those can be re-used across requests. It does not
-- run cleanup actions, so closeSnaplet should be used when finished.
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


------------------------------------------------------------------------------
-- | Given a Snaplet Handler, a 'SnapletInit' specifying the initial state,
--  and a 'RequestBuilder' defining a test request, runs the handler,
--  returning the monadic value it produces.
--
-- Throws an exception if the 'Snap' handler early-terminates with 'finishWith'
-- or 'mzero'.
--
-- Note that the output of this function is slightly different from
-- 'evalHandler defined in Snap.Test, because due to the fact running
-- the initializer inside 'SnapletInit' can throw an exception.
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


------------------------------------------------------------------------------
-- | A variant of evalHandler that takes the Snaplet and InitializerState as
-- produced by getSnaplet, so those can be re-used across requests. It does not
-- run cleanup actions, so closeSnaplet should be used when finished.
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

------------------------------------------------------------------------------
-- | Run the given initializer, yielding a tuple where the first element is
-- a @Snaplet b@, or an error message whether the initializer threw an
-- exception. This is only needed for runHandler'/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

------------------------------------------------------------------------------
-- | Run cleanup for an initializer. Should be run after finished using the
-- state that getSnaplet returned. Only needed if using getSnaplet and
-- evalHandler'/runHandler'.
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)