module Factis.Haskoon.WebTrans (WebTrans(..), liftWebRec) where
import Control.Monad.Trans (MonadTrans)
import Factis.Haskoon.Web (Web(..), WebRec(..))
class MonadTrans t => WebTrans t where
liftWeb :: Web m => m a -> t m a
liftWebFun :: Web m => (forall a. m a -> m a) -> t m b -> t m b
liftWebRec :: (Web m, WebTrans t) => (m (WebRes m) -> m (WebRes (t m))) -> WebRec m -> WebRec (t m)
liftWebRec liftRes wr =
WebRec
{ web_documentRoot = lift0 (web_documentRoot wr)
, web_containerUri = lift0 (web_containerUri wr)
, web_requestUri = lift0 (web_requestUri wr)
, web_pathInfo = lift0 (web_pathInfo wr)
, web_method = lift0 (web_method wr)
, web_getBody = lift0 (web_getBody wr)
, web_getParams = lift0 (web_getParams wr)
, web_getHeaders = lift0 (web_getHeaders wr)
, web_getCookies = lift0 (web_getCookies wr)
, web_setStatus = lift2 (web_setStatus wr)
, web_sendBSL = \x -> lift0 (liftRes $ web_sendBSL wr x)
, web_setHeader = lift2 (web_setHeader wr)
, web_setCookie = lift1 (web_setCookie wr)
, web_unsetCookie = lift1 (web_unsetCookie wr)
, web_log = lift3 (web_log wr)
, web_getRepls = lift0 (web_getRepls wr)
, web_withRepls = \rs cont -> liftWebFun (web_withRepls wr rs) cont
, web_fail = lift1 (web_fail wr)
}
where
lift0 = liftWeb
lift1 f x = lift0 (f x)
lift2 f x y = lift0 (f x y)
lift3 f x y z = lift0 (f x y z)