@@ -0,0 +1,38 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.Middleware.Rewrite
3+ ( rewrite, autoHtmlRewrite
4+ ) where
5+
6+import Network.Wai
7+import qualified Data.ByteString.Char8 as B
8+import System.Directory (doesFileExist)
9+import Control.Monad.IO.Class (liftIO)
10+import Web.Routes.Base (decodePathInfo)
11+
12+-- | rewrite based on your own conversion rules
13+-- Example usage: rewrite (autoHtmlRewrite "static")
14+rewrite :: (B.ByteString -> IO B.ByteString) -> Middleware
15+rewrite convert app req = do
16+ newPathInfo <- liftIO $ convert $ pathInfo req
17+ app req { pathInfo = newPathInfo }
18+
19+-- | example rewriter
20+-- implements 2 rules for static html re-writes
21+-- 1) for a directory foo/, check for foo/index.html
22+-- 2) for a non-directory bar, check for bar.html
23+-- if the file exists, do the rewrite
24+autoHtmlRewrite :: String -> B.ByteString -> IO B.ByteString
25+autoHtmlRewrite staticDir pInfo =
26+ let pieces = decodePathInfo $ B.unpack $ pInfo
27+ in if null pieces then return pInfo
28+ else
29+ let fp = concat $ map ((:) '/') (reWritePieces pieces)
30+ in do fe <- doesFileExist $ staticDir ++ "/" ++ fp
31+ return $ if fe then B.pack fp else pInfo
32+ where
33+ reWritePieces :: [String] -> [String]
34+ reWritePieces pieces =
35+ let end = last pieces
36+ in if null end
37+ then pieces ++ ["index.html"]
38+ else (init pieces) ++ [end ++ ".html"]