@@ -7,21 +7,27 @@ import Network.Wai
7import System.Directory (doesFileExist)
7import System.Directory (doesFileExist)
8import Control.Monad.IO.Class (liftIO)
8import Control.Monad.IO.Class (liftIO)
9import Data.Text (Text, unpack, pack)
9import Data.Text (Text, unpack, pack)
10+import qualified Data.Text.Encoding as TE
11+import qualified Data.Text as T
12+import Network.HTTP.Types as H
11-- | rewrite based on your own conversion rules
15-- | rewrite based on your own conversion rules
12-- Example usage: rewrite (autoHtmlRewrite "static")
16-- Example usage: rewrite (autoHtmlRewrite "static")
13−rewrite :: ([Text] -> IO [Text]) -> Middleware
17+rewrite :: ([Text] -> H.RequestHeaders -> IO [Text]) -> Middleware
14rewrite convert app req = do
18rewrite convert app req = do
15− newPathInfo <- liftIO $ convert $ pathInfo req
19+ newPathInfo <- liftIO $ convert (pathInfo req) (requestHeaders req)
20+ let rawPInfo = TE.encodeUtf8 $ T.intercalate "/" newPathInfo
16− app req { pathInfo = newPathInfo }
21+ app req { pathInfo = newPathInfo, rawPathInfo = rawPInfo }
18-- | example rewriter
23-- | example rewriter
24+-- We don't recommend normally checking the file system on every request - this is just an example.
19−-- implements 2 rules for static html re-writes
25+-- Implements 2 rules for static html re-writes
20-- 1) for a directory foo/, check for foo/index.html
26-- 1) for a directory foo/, check for foo/index.html
21-- 2) for a non-directory bar, check for bar.html
27-- 2) for a non-directory bar, check for bar.html
22−-- if the file exists, do the rewrite
28+-- Do the rewrite only if the html file exists.
23−autoHtmlRewrite :: String -> [Text] -> IO [Text]
29+autoHtmlRewrite :: String -> [Text] -> H.RequestHeaders -> IO [Text]
24−autoHtmlRewrite staticDir pieces' = do
30+autoHtmlRewrite staticDir pieces' _ = do
25 fe <- doesFileExist $ staticDir ++ "/" ++ reWritePath
31 fe <- doesFileExist $ staticDir ++ "/" ++ reWritePath
26 return $ if fe then map pack reWritePieces else pieces'
32 return $ if fe then map pack reWritePieces else pieces'