Rewrite.hs

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