module Network.Salvia.Handler.Rewrite
( hLocalRequest
, hRewrite
, hRewritePath
, hRewriteHost
, hRewriteExt
, hWithDir
, hWithoutDir
)
where
import Control.Applicative
import Control.Category
import Data.List
import Data.Record.Label
import Network.Protocol.Http
import Network.Protocol.Uri
import Network.Salvia.Interface hiding (host)
import Prelude hiding ((.), id)
hLocalRequest :: HttpM Request m => (Http Request :-> b) -> (b -> b) -> m a -> m a
hLocalRequest p f m =
do u <- request (getM p) <* request (modM p f)
m <* request (p =: u)
hRewrite :: HttpM Request m => (Uri -> Uri) -> m a -> m a
hRewrite = hLocalRequest asUri
hRewriteHost :: HttpM Request m => (String -> String) -> m a -> m a
hRewriteHost = hLocalRequest (host . asUri)
hRewritePath :: HttpM Request m => (FilePath -> FilePath) -> m a -> m a
hRewritePath = hLocalRequest (path . asUri)
hRewriteExt :: HttpM Request m => (Maybe String -> Maybe String) -> m a -> m a
hRewriteExt = hLocalRequest (extension . path . asUri)
hWithDir :: HttpM Request m => String -> m a -> m a
hWithDir d = hRewritePath (d++)
hWithoutDir :: HttpM Request m => String -> m a -> m a
hWithoutDir d = hRewritePath $
\p -> if d `isPrefixOf` p then drop (length d) p else p