Rewrite.hs

module Network.Salvia.Handler.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

{- |
Run an handler in a modified context in which the request `URI` has been
changed by the specified modifier function. After the handler completes the `URI`
remains untouched.
-}

hRewrite :: (URI -> URI) -> Handler a -> Handler a
hRewrite f = withM (uri % request) (modify f)

-- express these below in terms of the above?

{- | Run handler in a context with a modified host. -}

hRewriteHost :: (String -> String) -> Handler a -> Handler a
hRewriteHost f = withM (host % uri % request) (modify f)

{- | Run handler in a context with a modified path. -}

hRewritePath :: (String -> String) -> Handler a -> Handler a
hRewritePath f = withM (path % uri % request) (modify f)

{- | Run handler in a context with a modified file extension. -}

hRewriteExt :: (Maybe String -> Maybe String) -> Handler a -> Handler a
hRewriteExt f = withM (extension % path % uri % request) (modify f)

{- |
Run handler in a context with a modified path. The specified prefix will be
prepended to the path.
-}

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

{- |
Run handler in a context with a modified path. The specified prefix will be
stripped form the path.
-}

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