PathRouter.hs

module Network.Salvia.Handlers.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.Handlers.Dispatching
import Network.Salvia.Httpd

chop :: String -> Handler a -> Handler a
chop a = withM (path % uri % request) (modify (drop $ length a))

hPath :: Dispatcher String a
hPath p h = hDispatch (path % uri % request) (==) p (chop p h)

hPathRouter :: ListDispatcher String b
hPathRouter = hListDispatch hPath

hPrefix :: Dispatcher String a
hPrefix p h = hDispatch (path % uri % request) isPrefixOf p (chop p h)

hPrefixRouter :: ListDispatcher String b
hPrefixRouter = hListDispatch hPrefix

-- Path related utilities.

hParameters :: Handler Parameters
hParameters = getM (uri % request) >>= return . queryParams