Rewrite.hs

module Network.Salvia.Handlers.Rewrite (
    hRewrite
  , hRewritePath
  , hRewriteHost
  , hRewriteExt
  , hWithDir
  , hWithoutDir
  ) where

import Data.List (isPrefixOf)
import Control.Monad.State

import Network.Salvia.Httpd
import Network.Protocol.Http
import Network.Protocol.Uri (URI, modPath, modHost, path, modExtension)

hRewrite :: (URI -> URI) -> Handler a -> Handler a
hRewrite f h = withRequest (modUri f) h

hRewriteHost :: (String -> String) -> Handler a -> Handler a
hRewriteHost f h = withRequest (modUri $ modHost f) h

hRewritePath :: (String -> String) -> Handler a -> Handler a
hRewritePath f h = withRequest (modUri $ modPath f) h

hRewriteExt :: (String -> String) -> Handler a -> Handler a
hRewriteExt f = hRewrite (modExtension f)

hWithDir :: String -> Handler a -> Handler a
hWithDir d = hRewritePath (d++)

hWithoutDir :: String -> Handler a -> Handler a
hWithoutDir d h = do
  req <- gets request
  if (d `isPrefixOf` (path $ uri $ req))
    then hRewritePath (drop (length d)) h
    else h