module Factis.Haskoon.HttpSpec.SpecHandler
( matchBySpec, matchByReqSpec, rawSendBySpec, sendBySpec, rawSendToUrl, sendToUrl
, rhSendReq, rhParseResIn, rhGenReqOut, rhParseUrl
) where
import Control.Monad.Error (MonadError(..))
import Data.HttpSpec (HasReqSpec(..),HasResSpec(..),ResSpec,ReqSpec,WebExc(..)
,webExcSetResIn, webExcSetReqOut
,parseReqIn,genResOut,parseResIn,genReqOut)
import Data.HttpSpec.HttpTypes (HttpUrl,ReqIn(..),ReqOut(..),ResIn(..),ResOut(..))
import qualified Network.URI as Uri
import Factis.Haskoon.HttpSpec.WebHandler (ReqHandler(..))
matchBySpec :: (MonadError WebExc m, HasReqSpec a, HasResSpec b) =>
(a -> m b)
-> ReqIn
-> m ResOut
matchBySpec fun reqIn = parseReqIn reqSpec reqIn >>= fun >>= genResOut resSpec
matchByReqSpec :: (MonadError WebExc m, HasReqSpec a) =>
(a -> m ResOut)
-> ReqIn
-> m ResOut
matchByReqSpec fun reqIn = parseReqIn reqSpec reqIn >>= fun
rhParseResIn :: ReqHandler m => ResSpec a -> ResIn -> m a
rhParseResIn resInSpec resIn =
catchError (parseResIn resInSpec resIn) (throwError . webExcSetResIn resIn)
rhGenReqOut :: ReqHandler m => HttpUrl -> ReqSpec a -> a -> m ReqOut
rhGenReqOut baseUrl reqOutSpec a = genReqOut reqOutSpec baseUrl a
rhSendReq :: ReqHandler m => ReqOut -> m ResIn
rhSendReq reqOut =
catchError (sendReq reqOut) (throwError . webExcSetReqOut reqOut)
rhParseUrl :: ReqHandler m => String -> m HttpUrl
rhParseUrl baseUrlStr =
case Uri.parseURI baseUrlStr of
Just uri -> return uri
Nothing -> fail msg
where msg = ("SpecHandler: Invalid base URI: `" ++ baseUrlStr ++ "'")
sendBySpec :: (HasReqSpec a, HasResSpec b, ReqHandler m) => HttpUrl -> a -> m b
sendBySpec baseUrl a =
do resIn <- rawSendBySpec baseUrl a
rhParseResIn resSpec resIn
rawSendBySpec :: (HasReqSpec a, ReqHandler m) => HttpUrl -> a -> m ResIn
rawSendBySpec baseUrl a =
do reqOut <- rhGenReqOut baseUrl reqSpec a
rhSendReq reqOut
rawSendToUrl :: (HasReqSpec a, ReqHandler m) => String -> a -> m ResIn
rawSendToUrl baseUrlStr a =
do baseUrl <- rhParseUrl baseUrlStr
rawSendBySpec baseUrl a
sendToUrl :: (HasReqSpec a, HasResSpec b, ReqHandler m) => String -> a -> m b
sendToUrl baseUrlStr a =
do resIn <- rawSendToUrl baseUrlStr a
rhParseResIn resSpec resIn