PathRouter.hs

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