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