MethodRouter.hs

module Network.Salvia.Handler.MethodRouter (
    hMethod
  , hMethodRouter

  , hOPTIONS
  , hGET
  , hHEAD
  , hPOST
  , hPUT
  , hDELETE
  , hTRACE
  , hCONNECT
  ) where

import Data.Record.Label
import Network.Protocol.Http
import Network.Salvia.Handler.Dispatching
import Network.Salvia.Handler.Error
import Network.Salvia.Httpd

{- |
Request dispatcher based on the HTTP request `Method`. When the method does not
match an HTTP `NotFound` will be created and `Nothing` will be returned.
-}

hMethod :: Method -> Handler a -> Handler (Maybe a)
hMethod m h = hMethod' m
  (Just `fmap` h)
  (const Nothing `fmap` hError NotFound)

{- | Request list dispatcher based on the `hMethod` dispatcher. -}

hMethodRouter :: ListDispatcher Method ()
hMethodRouter = hListDispatch hMethod'

{- | Only invoke a handler on an `OPTIONS` request. -}

hOPTIONS :: Handler a -> Handler (Maybe a)
hOPTIONS = hMethod OPTIONS

{- | Only invoke a handler on a `GET` request. -}

hGET :: Handler a -> Handler (Maybe a)
hGET = hMethod GET

{- | Only invoke a handler on a `HEAD` request. -}

hHEAD :: Handler a -> Handler (Maybe a)
hHEAD = hMethod HEAD

{- | Only invoke a handler on a `POST` request. -}

hPOST :: Handler a -> Handler (Maybe a)
hPOST = hMethod POST

{- | Only invoke a handler on a `PUT` request. -}

hPUT :: Handler a -> Handler (Maybe a)
hPUT = hMethod PUT

{- | Only invoke a handler on a `DELETE` request. -}

hDELETE :: Handler a -> Handler (Maybe a)
hDELETE = hMethod DELETE

{- | Only invoke a handler on a `TRACE` request. -}

hTRACE :: Handler a -> Handler (Maybe a)
hTRACE = hMethod TRACE

{- | Only invoke a handler on a `CONNECT` request. -}

hCONNECT :: Handler a -> Handler (Maybe a)
hCONNECT = hMethod CONNECT

hMethod' :: Dispatcher Method a
hMethod' = hDispatch (method % request) (==)