salvia-0.0.5: src/Network/Salvia/Handlers/Dispatching.hs

module Network.Salvia.Handlers.Dispatching (
    Dispatcher
  , ListDispatcher
  , hDispatch
  , hListDispatch
  ) where

import Data.Record.Label
import Network.Salvia.Httpd

type Dispatcher     a b = a -> Handler b   -> Handler b -> Handler b
type ListDispatcher a b = [(a, Handler b)] -> Handler b -> Handler b

hDispatch :: (Show a, Show c) => Label Context c -> (a -> c -> Bool) -> Dispatcher a b
hDispatch f match a handler _default = do
  ctx <- getM f
  if a `match` ctx
    then handler
    else _default

hListDispatch :: Dispatcher a b -> ListDispatcher a b
hListDispatch disp = flip $ foldr $ uncurry disp