-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Route
    ( Handler
    , route
    ) where

import Data.ByteString (ByteString)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Route.Tree
import Prelude hiding (lookup)

import qualified Data.ByteString.Lazy as L

-- | A 'Handler' is a generalized 'Application' that receives the captured
-- path parameters as its first argument.
type Handler m = [(ByteString, ByteString)]        -- ^ The captured path parameters.
               -> Request                          -- ^ The matched 'Request'.
               -> (Response -> m ResponseReceived) -- ^ The continuation.
               -> m ResponseReceived

-- | Routes requests to 'Handler's according to a routing table.
route :: Monad m
      => [(ByteString, Handler m)]
      -> Request
      -> (Response -> m ResponseReceived)
      -> m ResponseReceived
route :: forall (m :: * -> *).
Monad m =>
[(ByteString, Handler m)]
-> Request
-> (Response -> m ResponseReceived)
-> m ResponseReceived
route [(ByteString, Handler m)]
rs Request
rq Response -> m ResponseReceived
k = case Tree (Handler m) -> [ByteString] -> Maybe (Payload (Handler m))
forall a. Tree a -> [ByteString] -> Maybe (Payload a)
lookup ([(ByteString, Handler m)] -> Tree (Handler m)
forall a. [(ByteString, a)] -> Tree a
fromList [(ByteString, Handler m)]
rs) [ByteString]
segs of
    Just  Payload (Handler m)
e -> Payload (Handler m) -> Handler m
forall a. Payload a -> a
value Payload (Handler m)
e (Captures -> [(ByteString, ByteString)]
captured (Captures -> [(ByteString, ByteString)])
-> Captures -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Payload (Handler m) -> Captures
forall a. Payload a -> Captures
captures Payload (Handler m)
e) Request
rq Response -> m ResponseReceived
k
    Maybe (Payload (Handler m))
Nothing -> Response -> m ResponseReceived
k Response
notFound
  where
    segs :: [ByteString]
segs     = ByteString -> [ByteString]
segments (Request -> ByteString
rawPathInfo Request
rq)
    notFound :: Response
notFound = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status404 [] ByteString
L.empty