module WebGear.Server.Handler (
ServerHandler (..),
RoutePath (..),
runServerHandler,
toApplication,
transform,
) where
import Control.Arrow (
Arrow (..),
ArrowChoice (..),
ArrowPlus (..),
ArrowZero (..),
Kleisli (..),
)
import Control.Arrow.Operations (ArrowError (..))
import qualified Control.Category as Cat
import Control.Monad.Except (
ExceptT (..),
MonadError (..),
mapExceptT,
runExceptT,
)
import Control.Monad.State.Strict (
MonadState (..),
StateT (..),
evalStateT,
mapStateT,
)
import Control.Monad.Trans (lift)
import Data.ByteString (ByteString)
import Data.Either (fromRight)
import Data.String (fromString)
import Data.Version (showVersion)
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import Paths_webgear_server (version)
import WebGear.Core.Handler (
Description,
Handler (..),
RouteMismatch (..),
RoutePath (..),
Summary,
)
import WebGear.Core.Request (Request (..))
import WebGear.Core.Response (Response (..), ResponseBody (..))
import WebGear.Core.Trait (With, wzero)
newtype ServerHandler m a b = ServerHandler
{ forall (m :: * -> *) a b.
ServerHandler m a b
-> a -> StateT RoutePath (ExceptT RouteMismatch m) b
unServerHandler :: a -> StateT RoutePath (ExceptT RouteMismatch m) b
}
deriving
( (forall a. ServerHandler m a a)
-> (forall b c a.
ServerHandler m b c -> ServerHandler m a b -> ServerHandler m a c)
-> Category (ServerHandler m)
forall a. ServerHandler m a a
forall b c a.
ServerHandler m b c -> ServerHandler m a b -> ServerHandler m a c
forall {k} (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
cat b c -> cat a b -> cat a c)
-> Category cat
forall (m :: * -> *) a. Monad m => ServerHandler m a a
forall (m :: * -> *) b c a.
Monad m =>
ServerHandler m b c -> ServerHandler m a b -> ServerHandler m a c
$cid :: forall (m :: * -> *) a. Monad m => ServerHandler m a a
id :: forall a. ServerHandler m a a
$c. :: forall (m :: * -> *) b c a.
Monad m =>
ServerHandler m b c -> ServerHandler m a b -> ServerHandler m a c
. :: forall b c a.
ServerHandler m b c -> ServerHandler m a b -> ServerHandler m a c
Cat.Category
, Category (ServerHandler m)
Category (ServerHandler m) =>
(forall b c. (b -> c) -> ServerHandler m b c)
-> (forall b c d.
ServerHandler m b c -> ServerHandler m (b, d) (c, d))
-> (forall b c d.
ServerHandler m b c -> ServerHandler m (d, b) (d, c))
-> (forall b c b' c'.
ServerHandler m b c
-> ServerHandler m b' c' -> ServerHandler m (b, b') (c, c'))
-> (forall b c c'.
ServerHandler m b c
-> ServerHandler m b c' -> ServerHandler m b (c, c'))
-> Arrow (ServerHandler m)
forall b c. (b -> c) -> ServerHandler m b c
forall b c d. ServerHandler m b c -> ServerHandler m (b, d) (c, d)
forall b c d. ServerHandler m b c -> ServerHandler m (d, b) (d, c)
forall b c c'.
ServerHandler m b c
-> ServerHandler m b c' -> ServerHandler m b (c, c')
forall b c b' c'.
ServerHandler m b c
-> ServerHandler m b' c' -> ServerHandler m (b, b') (c, c')
forall (m :: * -> *). Monad m => Category (ServerHandler m)
forall (m :: * -> *) b c.
Monad m =>
(b -> c) -> ServerHandler m b c
forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (b, d) (c, d)
forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (d, b) (d, c)
forall (m :: * -> *) b c c'.
Monad m =>
ServerHandler m b c
-> ServerHandler m b c' -> ServerHandler m b (c, c')
forall (m :: * -> *) b c b' c'.
Monad m =>
ServerHandler m b c
-> ServerHandler m b' c' -> ServerHandler m (b, b') (c, c')
forall (a :: * -> * -> *).
Category a =>
(forall b c. (b -> c) -> a b c)
-> (forall b c d. a b c -> a (b, d) (c, d))
-> (forall b c d. a b c -> a (d, b) (d, c))
-> (forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c'))
-> (forall b c c'. a b c -> a b c' -> a b (c, c'))
-> Arrow a
$carr :: forall (m :: * -> *) b c.
Monad m =>
(b -> c) -> ServerHandler m b c
arr :: forall b c. (b -> c) -> ServerHandler m b c
$cfirst :: forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (b, d) (c, d)
first :: forall b c d. ServerHandler m b c -> ServerHandler m (b, d) (c, d)
$csecond :: forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (d, b) (d, c)
second :: forall b c d. ServerHandler m b c -> ServerHandler m (d, b) (d, c)
$c*** :: forall (m :: * -> *) b c b' c'.
Monad m =>
ServerHandler m b c
-> ServerHandler m b' c' -> ServerHandler m (b, b') (c, c')
*** :: forall b c b' c'.
ServerHandler m b c
-> ServerHandler m b' c' -> ServerHandler m (b, b') (c, c')
$c&&& :: forall (m :: * -> *) b c c'.
Monad m =>
ServerHandler m b c
-> ServerHandler m b c' -> ServerHandler m b (c, c')
&&& :: forall b c c'.
ServerHandler m b c
-> ServerHandler m b c' -> ServerHandler m b (c, c')
Arrow
, Arrow (ServerHandler m)
Arrow (ServerHandler m) =>
(forall b c. ServerHandler m b c) -> ArrowZero (ServerHandler m)
forall b c. ServerHandler m b c
forall (m :: * -> *). Monad m => Arrow (ServerHandler m)
forall (m :: * -> *) b c. Monad m => ServerHandler m b c
forall (a :: * -> * -> *).
Arrow a =>
(forall b c. a b c) -> ArrowZero a
$czeroArrow :: forall (m :: * -> *) b c. Monad m => ServerHandler m b c
zeroArrow :: forall b c. ServerHandler m b c
ArrowZero
, ArrowZero (ServerHandler m)
ArrowZero (ServerHandler m) =>
(forall b c.
ServerHandler m b c -> ServerHandler m b c -> ServerHandler m b c)
-> ArrowPlus (ServerHandler m)
forall b c.
ServerHandler m b c -> ServerHandler m b c -> ServerHandler m b c
forall (m :: * -> *). Monad m => ArrowZero (ServerHandler m)
forall (m :: * -> *) b c.
Monad m =>
ServerHandler m b c -> ServerHandler m b c -> ServerHandler m b c
forall (a :: * -> * -> *).
ArrowZero a =>
(forall b c. a b c -> a b c -> a b c) -> ArrowPlus a
$c<+> :: forall (m :: * -> *) b c.
Monad m =>
ServerHandler m b c -> ServerHandler m b c -> ServerHandler m b c
<+> :: forall b c.
ServerHandler m b c -> ServerHandler m b c -> ServerHandler m b c
ArrowPlus
, Arrow (ServerHandler m)
Arrow (ServerHandler m) =>
(forall b c d.
ServerHandler m b c -> ServerHandler m (Either b d) (Either c d))
-> (forall b c d.
ServerHandler m b c -> ServerHandler m (Either d b) (Either d c))
-> (forall b c b' c'.
ServerHandler m b c
-> ServerHandler m b' c'
-> ServerHandler m (Either b b') (Either c c'))
-> (forall b d c.
ServerHandler m b d
-> ServerHandler m c d -> ServerHandler m (Either b c) d)
-> ArrowChoice (ServerHandler m)
forall b c d.
ServerHandler m b c -> ServerHandler m (Either b d) (Either c d)
forall b c d.
ServerHandler m b c -> ServerHandler m (Either d b) (Either d c)
forall b d c.
ServerHandler m b d
-> ServerHandler m c d -> ServerHandler m (Either b c) d
forall b c b' c'.
ServerHandler m b c
-> ServerHandler m b' c'
-> ServerHandler m (Either b b') (Either c c')
forall (m :: * -> *). Monad m => Arrow (ServerHandler m)
forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (Either b d) (Either c d)
forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (Either d b) (Either d c)
forall (m :: * -> *) b d c.
Monad m =>
ServerHandler m b d
-> ServerHandler m c d -> ServerHandler m (Either b c) d
forall (m :: * -> *) b c b' c'.
Monad m =>
ServerHandler m b c
-> ServerHandler m b' c'
-> ServerHandler m (Either b b') (Either c c')
forall (a :: * -> * -> *).
Arrow a =>
(forall b c d. a b c -> a (Either b d) (Either c d))
-> (forall b c d. a b c -> a (Either d b) (Either d c))
-> (forall b c b' c'.
a b c -> a b' c' -> a (Either b b') (Either c c'))
-> (forall b d c. a b d -> a c d -> a (Either b c) d)
-> ArrowChoice a
$cleft :: forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (Either b d) (Either c d)
left :: forall b c d.
ServerHandler m b c -> ServerHandler m (Either b d) (Either c d)
$cright :: forall (m :: * -> *) b c d.
Monad m =>
ServerHandler m b c -> ServerHandler m (Either d b) (Either d c)
right :: forall b c d.
ServerHandler m b c -> ServerHandler m (Either d b) (Either d c)
$c+++ :: forall (m :: * -> *) b c b' c'.
Monad m =>
ServerHandler m b c
-> ServerHandler m b' c'
-> ServerHandler m (Either b b') (Either c c')
+++ :: forall b c b' c'.
ServerHandler m b c
-> ServerHandler m b' c'
-> ServerHandler m (Either b b') (Either c c')
$c||| :: forall (m :: * -> *) b d c.
Monad m =>
ServerHandler m b d
-> ServerHandler m c d -> ServerHandler m (Either b c) d
||| :: forall b d c.
ServerHandler m b d
-> ServerHandler m c d -> ServerHandler m (Either b c) d
ArrowChoice
)
via Kleisli (StateT RoutePath (ExceptT RouteMismatch m))
instance (Monad m) => ArrowError RouteMismatch (ServerHandler m) where
{-# INLINE raise #-}
raise :: ServerHandler m RouteMismatch b
raise :: forall b. ServerHandler m RouteMismatch b
raise = (RouteMismatch -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m RouteMismatch b
forall (m :: * -> *) a b.
(a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
ServerHandler RouteMismatch -> StateT RoutePath (ExceptT RouteMismatch m) b
forall a.
RouteMismatch -> StateT RoutePath (ExceptT RouteMismatch m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
{-# INLINE handle #-}
handle ::
ServerHandler m a b ->
ServerHandler m (a, RouteMismatch) b ->
ServerHandler m a b
(ServerHandler a -> StateT RoutePath (ExceptT RouteMismatch m) b
action) handle :: forall e b.
ServerHandler m e b
-> ServerHandler m (e, RouteMismatch) b -> ServerHandler m e b
`handle` (ServerHandler (a, RouteMismatch) -> StateT RoutePath (ExceptT RouteMismatch m) b
errHandler) =
(a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
forall (m :: * -> *) a b.
(a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
ServerHandler ((a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b)
-> (a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
forall a b. (a -> b) -> a -> b
$ \a
a ->
a -> StateT RoutePath (ExceptT RouteMismatch m) b
action a
a StateT RoutePath (ExceptT RouteMismatch m) b
-> (RouteMismatch -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> StateT RoutePath (ExceptT RouteMismatch m) b
forall a.
StateT RoutePath (ExceptT RouteMismatch m) a
-> (RouteMismatch -> StateT RoutePath (ExceptT RouteMismatch m) a)
-> StateT RoutePath (ExceptT RouteMismatch m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \RouteMismatch
e -> (a, RouteMismatch) -> StateT RoutePath (ExceptT RouteMismatch m) b
errHandler (a
a, RouteMismatch
e)
{-# INLINE tryInUnless #-}
tryInUnless ::
ServerHandler m a b ->
ServerHandler m (a, b) c ->
ServerHandler m (a, RouteMismatch) c ->
ServerHandler m a c
tryInUnless :: forall e b c.
ServerHandler m e b
-> ServerHandler m (e, b) c
-> ServerHandler m (e, RouteMismatch) c
-> ServerHandler m e c
tryInUnless (ServerHandler a -> StateT RoutePath (ExceptT RouteMismatch m) b
action) (ServerHandler (a, b) -> StateT RoutePath (ExceptT RouteMismatch m) c
resHandler) (ServerHandler (a, RouteMismatch) -> StateT RoutePath (ExceptT RouteMismatch m) c
errHandler) =
(a -> StateT RoutePath (ExceptT RouteMismatch m) c)
-> ServerHandler m a c
forall (m :: * -> *) a b.
(a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
ServerHandler ((a -> StateT RoutePath (ExceptT RouteMismatch m) c)
-> ServerHandler m a c)
-> (a -> StateT RoutePath (ExceptT RouteMismatch m) c)
-> ServerHandler m a c
forall a b. (a -> b) -> a -> b
$ \a
a ->
a -> StateT RoutePath (ExceptT RouteMismatch m) c
f a
a StateT RoutePath (ExceptT RouteMismatch m) c
-> (RouteMismatch -> StateT RoutePath (ExceptT RouteMismatch m) c)
-> StateT RoutePath (ExceptT RouteMismatch m) c
forall a.
StateT RoutePath (ExceptT RouteMismatch m) a
-> (RouteMismatch -> StateT RoutePath (ExceptT RouteMismatch m) a)
-> StateT RoutePath (ExceptT RouteMismatch m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \RouteMismatch
e -> (a, RouteMismatch) -> StateT RoutePath (ExceptT RouteMismatch m) c
errHandler (a
a, RouteMismatch
e)
where
f :: a -> StateT RoutePath (ExceptT RouteMismatch m) c
f a
a = do
b
b <- a -> StateT RoutePath (ExceptT RouteMismatch m) b
action a
a
(a, b) -> StateT RoutePath (ExceptT RouteMismatch m) c
resHandler (a
a, b
b)
instance (Monad m) => Handler (ServerHandler m) m where
{-# INLINE arrM #-}
arrM :: (a -> m b) -> ServerHandler m a b
arrM :: forall a b. (a -> m b) -> ServerHandler m a b
arrM a -> m b
f = (a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
forall (m :: * -> *) a b.
(a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
ServerHandler ((a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b)
-> (a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
forall a b. (a -> b) -> a -> b
$ ExceptT RouteMismatch m b
-> StateT RoutePath (ExceptT RouteMismatch m) b
forall (m :: * -> *) a. Monad m => m a -> StateT RoutePath m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RouteMismatch m b
-> StateT RoutePath (ExceptT RouteMismatch m) b)
-> (a -> ExceptT RouteMismatch m b)
-> a
-> StateT RoutePath (ExceptT RouteMismatch m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> ExceptT RouteMismatch m b
forall (m :: * -> *) a. Monad m => m a -> ExceptT RouteMismatch m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> ExceptT RouteMismatch m b)
-> (a -> m b) -> a -> ExceptT RouteMismatch m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f
{-# INLINE consumeRoute #-}
consumeRoute :: ServerHandler m RoutePath a -> ServerHandler m () a
consumeRoute :: forall a. ServerHandler m RoutePath a -> ServerHandler m () a
consumeRoute (ServerHandler RoutePath -> StateT RoutePath (ExceptT RouteMismatch m) a
h) =
(() -> StateT RoutePath (ExceptT RouteMismatch m) a)
-> ServerHandler m () a
forall (m :: * -> *) a b.
(a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
ServerHandler ((() -> StateT RoutePath (ExceptT RouteMismatch m) a)
-> ServerHandler m () a)
-> (() -> StateT RoutePath (ExceptT RouteMismatch m) a)
-> ServerHandler m () a
forall a b. (a -> b) -> a -> b
$
\() -> do
a
a <- StateT RoutePath (ExceptT RouteMismatch m) RoutePath
forall s (m :: * -> *). MonadState s m => m s
get StateT RoutePath (ExceptT RouteMismatch m) RoutePath
-> (RoutePath -> StateT RoutePath (ExceptT RouteMismatch m) a)
-> StateT RoutePath (ExceptT RouteMismatch m) a
forall a b.
StateT RoutePath (ExceptT RouteMismatch m) a
-> (a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> StateT RoutePath (ExceptT RouteMismatch m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RoutePath -> StateT RoutePath (ExceptT RouteMismatch m) a
h
RoutePath -> StateT RoutePath (ExceptT RouteMismatch m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Text] -> RoutePath
RoutePath [])
a -> StateT RoutePath (ExceptT RouteMismatch m) a
forall a. a -> StateT RoutePath (ExceptT RouteMismatch m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE setDescription #-}
setDescription :: Description -> ServerHandler m a a
setDescription :: forall a. Description -> ServerHandler m a a
setDescription Description
_ = ServerHandler m a a
forall a. ServerHandler m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id
{-# INLINE setSummary #-}
setSummary :: Summary -> ServerHandler m a a
setSummary :: forall a. Summary -> ServerHandler m a a
setSummary Summary
_ = ServerHandler m a a
forall a. ServerHandler m a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id
runServerHandler ::
(Monad m) =>
ServerHandler m a b ->
RoutePath ->
a ->
m (Either RouteMismatch b)
runServerHandler :: forall (m :: * -> *) a b.
Monad m =>
ServerHandler m a b -> RoutePath -> a -> m (Either RouteMismatch b)
runServerHandler (ServerHandler a -> StateT RoutePath (ExceptT RouteMismatch m) b
h) RoutePath
path a
a =
ExceptT RouteMismatch m b -> m (Either RouteMismatch b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT RouteMismatch m b -> m (Either RouteMismatch b))
-> ExceptT RouteMismatch m b -> m (Either RouteMismatch b)
forall a b. (a -> b) -> a -> b
$ StateT RoutePath (ExceptT RouteMismatch m) b
-> RoutePath -> ExceptT RouteMismatch m b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (a -> StateT RoutePath (ExceptT RouteMismatch m) b
h a
a) RoutePath
path
{-# INLINE runServerHandler #-}
toApplication :: ServerHandler IO (Request `With` '[]) Response -> Wai.Application
toApplication :: ServerHandler IO (With Request '[]) Response -> Application
toApplication ServerHandler IO (With Request '[]) Response
h Request
rqt Response -> IO ResponseReceived
cont =
ServerHandler IO (With Request '[]) Response
-> RoutePath
-> With Request '[]
-> IO (Either RouteMismatch Response)
forall (m :: * -> *) a b.
Monad m =>
ServerHandler m a b -> RoutePath -> a -> m (Either RouteMismatch b)
runServerHandler ServerHandler IO (With Request '[]) Response
h RoutePath
path With Request '[]
request
IO (Either RouteMismatch Response)
-> (Either RouteMismatch Response -> IO ResponseReceived)
-> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
processResponse
(Response -> IO ResponseReceived)
-> (Either RouteMismatch Response -> Response)
-> Either RouteMismatch Response
-> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Response
addServerHeader
(Response -> Response)
-> (Either RouteMismatch Response -> Response)
-> Either RouteMismatch Response
-> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RouteMismatch Response -> Response
mkWebGearResponse
where
request :: Request `With` '[]
request :: With Request '[]
request = Request -> With Request '[]
forall a. a -> With a '[]
wzero (Request -> With Request '[]) -> Request -> With Request '[]
forall a b. (a -> b) -> a -> b
$ Request -> Request
Request Request
rqt
path :: RoutePath
path :: RoutePath
path = [Text] -> RoutePath
RoutePath ([Text] -> RoutePath) -> [Text] -> RoutePath
forall a b. (a -> b) -> a -> b
$ Request -> [Text]
Wai.pathInfo Request
rqt
mkWebGearResponse :: Either RouteMismatch Response -> Response
mkWebGearResponse :: Either RouteMismatch Response -> Response
mkWebGearResponse = Response -> Either RouteMismatch Response -> Response
forall b a. b -> Either a b -> b
fromRight (Response -> Either RouteMismatch Response -> Response)
-> Response -> Either RouteMismatch Response -> Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
HTTP.notFound404 [] (ResponseBody -> Response) -> ResponseBody -> Response
forall a b. (a -> b) -> a -> b
$ Builder -> ResponseBody
ResponseBodyBuilder Builder
forall a. Monoid a => a
mempty
addServerHeader :: Response -> Response
addServerHeader :: Response -> Response
addServerHeader = \case
Response Status
status ResponseHeaders
hdrs ResponseBody
body -> Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
status ((Header -> ResponseHeaders -> ResponseHeaders)
-> ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Header -> ResponseHeaders -> ResponseHeaders
insertServerHeader [] ResponseHeaders
hdrs) ResponseBody
body
Response
resp -> Response
resp
insertServerHeader :: HTTP.Header -> HTTP.ResponseHeaders -> HTTP.ResponseHeaders
insertServerHeader :: Header -> ResponseHeaders -> ResponseHeaders
insertServerHeader hdr :: Header
hdr@(HeaderName
name, ByteString
_) ResponseHeaders
hdrs
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
HTTP.hServer = (HeaderName
HTTP.hServer, ByteString
webGearServerHeader) Header -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
hdrs
| Bool
otherwise = Header
hdr Header -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
hdrs
webGearServerHeader :: ByteString
webGearServerHeader :: ByteString
webGearServerHeader = [Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"WebGear/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
showVersion Version
version
processResponse :: Response -> IO Wai.ResponseReceived
processResponse :: Response -> IO ResponseReceived
processResponse Response
resp =
case Response
resp of
ResponseCont (Response -> IO ResponseReceived) -> IO ResponseReceived
f -> (Response -> IO ResponseReceived) -> IO ResponseReceived
f Response -> IO ResponseReceived
cont
ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
raw Response
fallback -> Response -> IO ResponseReceived
cont (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ (IO ByteString -> (ByteString -> IO ()) -> IO ())
-> Response -> Response
Wai.responseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
raw Response
fallback
Response Status
status ResponseHeaders
hdrs ResponseBody
body ->
Response -> IO ResponseReceived
cont (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$
case ResponseBody
body of
ResponseBodyFile [Char]
fpath Maybe FilePart
fpart -> Status -> ResponseHeaders -> [Char] -> Maybe FilePart -> Response
Wai.responseFile Status
status ResponseHeaders
hdrs [Char]
fpath Maybe FilePart
fpart
ResponseBodyBuilder Builder
b -> Status -> ResponseHeaders -> Builder -> Response
Wai.responseBuilder Status
status ResponseHeaders
hdrs Builder
b
ResponseBodyStream StreamingBody
sb -> Status -> ResponseHeaders -> StreamingBody -> Response
Wai.responseStream Status
status ResponseHeaders
hdrs StreamingBody
sb
{-# INLINE toApplication #-}
transform ::
(forall x. m x -> n x) ->
ServerHandler m a b ->
ServerHandler n a b
transform :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x)
-> ServerHandler m a b -> ServerHandler n a b
transform forall x. m x -> n x
f (ServerHandler a -> StateT RoutePath (ExceptT RouteMismatch m) b
g) =
(a -> StateT RoutePath (ExceptT RouteMismatch n) b)
-> ServerHandler n a b
forall (m :: * -> *) a b.
(a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> ServerHandler m a b
ServerHandler ((a -> StateT RoutePath (ExceptT RouteMismatch n) b)
-> ServerHandler n a b)
-> (a -> StateT RoutePath (ExceptT RouteMismatch n) b)
-> ServerHandler n a b
forall a b. (a -> b) -> a -> b
$ (ExceptT RouteMismatch m (b, RoutePath)
-> ExceptT RouteMismatch n (b, RoutePath))
-> StateT RoutePath (ExceptT RouteMismatch m) b
-> StateT RoutePath (ExceptT RouteMismatch n) b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((m (Either RouteMismatch (b, RoutePath))
-> n (Either RouteMismatch (b, RoutePath)))
-> ExceptT RouteMismatch m (b, RoutePath)
-> ExceptT RouteMismatch n (b, RoutePath)
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either RouteMismatch (b, RoutePath))
-> n (Either RouteMismatch (b, RoutePath))
forall x. m x -> n x
f) (StateT RoutePath (ExceptT RouteMismatch m) b
-> StateT RoutePath (ExceptT RouteMismatch n) b)
-> (a -> StateT RoutePath (ExceptT RouteMismatch m) b)
-> a
-> StateT RoutePath (ExceptT RouteMismatch n) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT RoutePath (ExceptT RouteMismatch m) b
g
{-# INLINE transform #-}