{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
module Test.Hspec.Wai.Internal (
WaiExpectation
, WaiSession(..)
, runWaiSession
, runWithState
, withApplication
, getApp
, getState
, formatHeader
) where
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Network.Wai (Application)
import Network.Wai.Test hiding (request)
import Test.Hspec.Core.Spec
import Test.Hspec.Wai.Util (formatHeader)
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail
#endif
type WaiExpectation st = WaiSession st ()
newtype WaiSession st a = WaiSession {unWaiSession :: ReaderT st Session a}
deriving (Functor, Applicative, Monad, MonadIO
#if MIN_VERSION_base(4,9,0)
, MonadFail
#endif
)
runWaiSession :: WaiSession () a -> Application -> IO a
runWaiSession action app = runWithState action ((), app)
runWithState :: WaiSession st a -> (st, Application) -> IO a
runWithState action (st, app) = runSession (flip runReaderT st $ unWaiSession action) app
withApplication :: Application -> WaiSession () a -> IO a
withApplication = flip runWaiSession
instance Example (WaiExpectation st) where
type Arg (WaiExpectation st) = (st, Application)
evaluateExample e p action = evaluateExample (action $ runWithState e) p ($ ())
getApp :: WaiSession st Application
getApp = WaiSession (lift ask)
getState :: WaiSession st st
getState = WaiSession ask