module Network.Salvia.Handler.PathRouter ( hPath , hPathRouter , hPrefix , hPrefixRouter , hParameters ) where import Control.Monad.State import Data.List (isPrefixOf) import Data.Record.Label import Network.Protocol.Http import Network.Protocol.Uri (path, queryParams, Parameters) import Network.Salvia.Handler.Dispatching import Network.Salvia.Httpd {- | Request dispatcher based on the request path. -} hPath :: Dispatcher String a hPath p h = hDispatch (path % uri % request) (==) p (chop p h) {- | List dispatcher version of `hPath`. -} hPathRouter :: ListDispatcher String b hPathRouter = hListDispatch hPath {- | Request dispatcher based on a prefix of the request path. -} hPrefix :: Dispatcher String a hPrefix p h = hDispatch (path % uri % request) isPrefixOf p (chop p h) {- | List dispatcher version of `hPrefix`. -} hPrefixRouter :: ListDispatcher String b hPrefixRouter = hListDispatch hPrefix {- | Helper function to fetch the URI parameters from the request. -} hParameters :: Handler Parameters hParameters = getM (uri % request) >>= return . queryParams chop :: String -> Handler a -> Handler a chop a = withM (path % uri % request) (modify (drop $ length a))