module Network.Salvia.Handlers.Rewrite ( hRewrite , hRewritePath , hRewriteHost , hRewriteExt , hWithDir , hWithoutDir ) where import Control.Monad.State import Data.List (isPrefixOf) import Data.Record.Label import Network.Protocol.Http import Network.Protocol.Uri (URI, host, path, extension) import Network.Salvia.Httpd hRewrite :: (URI -> URI) -> Handler a -> Handler a hRewrite f = withM (uri % request) (modify f) -- express these below in terms of the above? hRewriteHost :: (String -> String) -> Handler a -> Handler a hRewriteHost f = withM (host % uri % request) (modify f) hRewritePath :: (String -> String) -> Handler a -> Handler a hRewritePath f = withM (path % uri % request) (modify f) hRewriteExt :: (Maybe String -> Maybe String) -> Handler a -> Handler a hRewriteExt f = withM (extension % path % uri % request) (modify f) hWithDir :: String -> Handler a -> Handler a hWithDir d = hRewritePath (d++) hWithoutDir :: String -> Handler a -> Handler a hWithoutDir d h = do p <- getM (path % uri % request) (if d `isPrefixOf` p then hRewritePath (drop $ length d) else id) h