@@ -1,39 +1,33 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Network.Wai.Middleware.Rewrite
3− ( rewrite, autoHtmlRewrite
3+ ( rewrite, rewritePure
44 ) where
55
66import Network.Wai
7−import System.Directory (doesFileExist)
87import Control.Monad.IO.Class (liftIO)
9−import Data.Text (Text, unpack, pack)
8+import Data.Text (Text)
109import qualified Data.Text.Encoding as TE
1110import qualified Data.Text as T
1211import Network.HTTP.Types as H
1312
1413
1514-- | rewrite based on your own conversion rules
16−-- Example usage: rewrite (autoHtmlRewrite "static")
1715rewrite :: ([Text] -> H.RequestHeaders -> IO [Text]) -> Middleware
1816rewrite convert app req = do
1917 newPathInfo <- liftIO $ convert (pathInfo req) (requestHeaders req)
2018 let rawPInfo = TE.encodeUtf8 $ T.intercalate "/" newPathInfo
2119 app req { pathInfo = newPathInfo, rawPathInfo = rawPInfo }
2220
23−-- | example rewriter
24−-- We don't recommend normally checking the file system on every request - this is just an example.
25−-- Implements 2 rules for static html re-writes
26−-- 1) for a directory foo/, check for foo/index.html
27−-- 2) for a non-directory bar, check for bar.html
28−-- Do the rewrite only if the html file exists.
29−autoHtmlRewrite :: String -> [Text] -> H.RequestHeaders -> IO [Text]
30−autoHtmlRewrite staticDir pieces' _ = do
31− fe <- doesFileExist $ staticDir ++ "/" ++ reWritePath
32− return $ if fe then map pack reWritePieces else pieces'
33− where
34− pieces = map unpack pieces'
35− reWritePath = concat $ map ((:) '/') reWritePieces
36− reWritePieces =
37− if (null pieces) || (null $ last pieces)
38− then pieces ++ ["index.html"]
39− else (init pieces) ++ [(last pieces) ++ ".html"]
21+-- | rewrite based on your own conversion rules
22+-- Example convert function:
23+
24+-- staticConvert :: [Text] -> H.RequestHeaders -> [Text]
25+-- staticConvert pieces _ = piecesConvert pieces
26+-- where
27+-- piecesConvert [] = ["static", "html", "pages.html"]
28+-- piecesConvert route@("pages":_) = "static":"html":route
29+rewritePure :: ([Text] -> H.RequestHeaders -> [Text]) -> Middleware
30+rewritePure convert app req =
31+ let pInfo = convert (pathInfo req) (requestHeaders req)
32+ rawPInfo = TE.encodeUtf8 $ T.intercalate "/" pInfo
33+ in app req { pathInfo = pInfo, rawPathInfo = rawPInfo }