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(..))

-- | a low-level function for convert a parser, printer, and routing function into an 'Application'
handleWaiError :: (url -> [(Text, Maybe Text)] -> Text) -- ^ function to convert a 'url' + params into path info + query string
               -> (S.ByteString -> Either String url)   -- ^ function to parse path info into 'url'
               -> S.ByteString                          -- ^ app root
               -> (String -> Application)               -- ^ function to call if there is a decoding error, argument is the parse error
               -> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)  -- ^ routing function
               -> Application
handleWaiError :: (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> (String -> Application)
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWaiError url -> [(Text, Maybe Text)] -> Text
fromUrl ByteString -> Either String url
toUrl ByteString
approot String -> Application
handleError (url -> [(Text, Maybe Text)] -> Text) -> url -> Application
handler =
  \Request
request Response -> IO ResponseReceived
respond ->
     do let fUrl :: Either String url
fUrl = ByteString -> Either String url
toUrl (ByteString -> Either String url)
-> ByteString -> Either String url
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
stripOverlapBS ByteString
approot (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
rawPathInfo Request
request
        case Either String url
fUrl of
          (Left String
parseError) -> String -> Application
handleError String
parseError Request
request Response -> IO ResponseReceived
respond
          (Right url
url)       -> (url -> [(Text, Maybe Text)] -> Text) -> url -> Application
handler (\url
url [(Text, Maybe Text)]
params -> (ByteString -> Text
Text.decodeUtf8 ByteString
approot) Text -> Text -> Text
`Text.append` (url -> [(Text, Maybe Text)] -> Text
fromUrl url
url [(Text, Maybe Text)]
params)) url
url Request
request Response -> IO ResponseReceived
respond

-- | a low-level function for convert a parser, printer, and routing function into an 'Application'
--
-- returns 404 if the url parse fails.
handleWai_ :: (url -> [(Text, Maybe Text)] -> Text) -- ^ function to convert a 'url' + params into path info + query string
           -> (S.ByteString -> Either String url)         -- ^ function to parse path info into 'url'
           -> S.ByteString                                -- ^ app root
           -> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application) -- ^ routing function
           -> Application
handleWai_ :: (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWai_ url -> [(Text, Maybe Text)] -> Text
fromUrl ByteString -> Either String url
toUrl ByteString
approot (url -> [(Text, Maybe Text)] -> Text) -> url -> Application
handler =
    (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> (String -> Application)
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
forall url.
(url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> (String -> Application)
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWaiError url -> [(Text, Maybe Text)] -> Text
fromUrl ByteString -> Either String url
toUrl ByteString
approot String -> Application
handleError (url -> [(Text, Maybe Text)] -> Text) -> url -> Application
handler
    where
      handleError :: String -> Application
      handleError :: String -> Application
handleError String
parseError Request
_request Response -> IO ResponseReceived
respond = Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status404 [] (String -> ByteString
L.pack String
parseError)

-- | function to convert a routing function into an Application by
-- leveraging 'PathInfo' to do the url conversion
handleWai :: (PathInfo url) =>
             S.ByteString -- ^ approot
          -> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application) -- ^ routing function
          -> Application
handleWai :: ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWai ByteString
approot (url -> [(Text, Maybe Text)] -> Text) -> url -> Application
handler = (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
forall url.
(url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWai_ url -> [(Text, Maybe Text)] -> Text
forall url. PathInfo url => url -> [(Text, Maybe Text)] -> Text
toPathInfoParams ByteString -> Either String url
forall url. PathInfo url => ByteString -> Either String url
fromPathInfo ByteString
approot (url -> [(Text, Maybe Text)] -> Text) -> url -> Application
handler

-- | a function to convert a parser, printer and routing function into an 'Application'.
--
-- This is similar to 'handleWai_' expect that it expects the routing function to use 'RouteT'.
handleWaiRouteT_ :: (url -> [(Text, Maybe Text)] -> Text)      -- ^ function to convert a 'url' + params into path info + query string
                 -> (S.ByteString -> Either String url)        -- ^ function to parse path info into 'url'
                 -> S.ByteString                               -- ^ app root
                 -> (url -> Request -> RouteT url IO Response) -- ^ routing function
                 -> Application
handleWaiRouteT_ :: (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> (url -> Request -> RouteT url IO Response)
-> Application
handleWaiRouteT_  url -> [(Text, Maybe Text)] -> Text
toPathInfo ByteString -> Either String url
fromPathInfo ByteString
approot url -> Request -> RouteT url IO Response
handler = \Request
request Response -> IO ResponseReceived
respond ->
   (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
forall url.
(url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWai_ url -> [(Text, Maybe Text)] -> Text
toPathInfo ByteString -> Either String url
fromPathInfo ByteString
approot (\url -> [(Text, Maybe Text)] -> Text
toPathInfo' url
url Request
request Response -> IO ResponseReceived
respond -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> IO Response -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RouteT url IO Response
-> (url -> [(Text, Maybe Text)] -> Text) -> IO Response
forall url (m :: * -> *) a.
RouteT url m a -> (url -> [(Text, Maybe Text)] -> Text) -> m a
unRouteT (url -> Request -> RouteT url IO Response
handler url
url Request
request) url -> [(Text, Maybe Text)] -> Text
toPathInfo') Request
request Response -> IO ResponseReceived
respond

-- | convert a 'RouteT' based routing function into an 'Application' using 'PathInfo' to do the url conversion
handleWaiRouteT :: (PathInfo url) =>
                   S.ByteString  -- ^ app root
                -> (url -> Request -> RouteT url IO Response) -- ^ routing function
                -> Application
handleWaiRouteT :: ByteString
-> (url -> Request -> RouteT url IO Response) -> Application
handleWaiRouteT ByteString
approot url -> Request -> RouteT url IO Response
handler = (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> (url -> Request -> RouteT url IO Response)
-> Application
forall url.
(url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> (url -> Request -> RouteT url IO Response)
-> Application
handleWaiRouteT_ url -> [(Text, Maybe Text)] -> Text
forall url. PathInfo url => url -> [(Text, Maybe Text)] -> Text
toPathInfoParams ByteString -> Either String url
forall url. PathInfo url => ByteString -> Either String url
fromPathInfo ByteString
approot url -> Request -> RouteT url IO Response
handler

-- |convert a 'Site url Application' into a plain-old 'Application'
waiSite :: Site url Application -- ^ Site
        -> S.ByteString               -- ^ approot, e.g. http://www.example.org/app
        -> Application
waiSite :: Site url Application -> ByteString -> Application
waiSite Site url Application
site ByteString
approot = (url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
forall url.
(url -> [(Text, Maybe Text)] -> Text)
-> (ByteString -> Either String url)
-> ByteString
-> ((url -> [(Text, Maybe Text)] -> Text) -> url -> Application)
-> Application
handleWai_ url -> [(Text, Maybe Text)] -> Text
formatURL (Site url Application -> [Text] -> Either String url
forall url a. Site url a -> [Text] -> Either String url
parsePathSegments Site url Application
site ([Text] -> Either String url)
-> (ByteString -> [Text]) -> ByteString -> Either String url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Text]
decodePathInfo) ByteString
approot (Site url Application
-> (url -> [(Text, Maybe Text)] -> Text) -> url -> Application
forall url a.
Site url a -> (url -> [(Text, Maybe Text)] -> Text) -> url -> a
handleSite Site url Application
site)
    where
      formatURL :: url -> [(Text, Maybe Text)] -> Text
formatURL url
url [(Text, Maybe Text)]
params =
          let ([Text]
paths, [(Text, Maybe Text)]
moreParams) = Site url Application -> url -> ([Text], [(Text, Maybe Text)])
forall url a. Site url a -> url -> ([Text], [(Text, Maybe Text)])
formatPathSegments Site url Application
site url
url
          in [Text] -> [(Text, Maybe Text)] -> Text
encodePathInfo [Text]
paths ([(Text, Maybe Text)]
params [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Maybe Text)]
moreParams)