module Web.Routes.Wai where
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Network.Wai ( Application, Request, Response, rawPathInfo
, responseLBS)
import Network.HTTP.Types (status404)
import Web.Routes.Base (decodePathInfo, encodePathInfo)
import Web.Routes.PathInfo (PathInfo(..), fromPathInfo, stripOverlapBS
, toPathInfoParams)
import Web.Routes.RouteT (RouteT, unRouteT)
import Web.Routes.Site (Site(..))
handleWaiError :: (url -> [(Text, Maybe Text)] -> Text)
-> (S.ByteString -> Either String url)
-> S.ByteString
-> (String -> Application)
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWaiError fromUrl toUrl approot handleError handler =
\request respond ->
do let fUrl = toUrl $ stripOverlapBS approot $ rawPathInfo request
case fUrl of
(Left parseError) -> handleError parseError request respond
(Right url) -> handler (\url params -> (Text.decodeUtf8 approot) `Text.append` (fromUrl url params)) url request respond
handleWai_ :: (url -> [(Text, Maybe Text)] -> Text)
-> (S.ByteString -> Either String url)
-> S.ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWai_ fromUrl toUrl approot handler =
handleWaiError fromUrl toUrl approot handleError handler
where
handleError :: String -> Application
handleError parseError _request respond = respond $ responseLBS status404 [] (L.pack parseError)
handleWai :: (PathInfo url) =>
S.ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWai approot handler = handleWai_ toPathInfoParams fromPathInfo approot handler
handleWaiRouteT_ :: (url -> [(Text, Maybe Text)] -> Text)
-> (S.ByteString -> Either String url)
-> S.ByteString
-> (url -> Request -> RouteT url IO Response)
-> Application
handleWaiRouteT_ toPathInfo fromPathInfo approot handler = \request respond ->
handleWai_ toPathInfo fromPathInfo approot (\toPathInfo' url request respond -> respond =<< unRouteT (handler url request) toPathInfo') request respond
handleWaiRouteT :: (PathInfo url) =>
S.ByteString
-> (url -> Request -> RouteT url IO Response)
-> Application
handleWaiRouteT approot handler = handleWaiRouteT_ toPathInfoParams fromPathInfo approot handler
waiSite :: Site url Application
-> S.ByteString
-> Application
waiSite site approot = handleWai_ formatURL (parsePathSegments site . decodePathInfo) approot (handleSite site)
where
formatURL url params =
let (paths, moreParams) = formatPathSegments site url
in encodePathInfo paths (params ++ moreParams)