nested routing in post

Handler/Post.hs

@@ -7,9 +7,11 @@ module Handler.Post (
     ) where
 
 import Data.Text ( Text )
+import Handler.NotFound ( notFound )
 import Logger ( noticeM )
 import Network.HTTP.Types ( statusOK )
 import Network.Wai ( Application, Request(..), Response(..) )
+import Network.Wai.Middleware.Route ( dispatch, (&~~) )
 import Text.Blaze ( Html, ToHtml(..) )
 import Text.Blaze.Html5 ( (!) )
 import qualified Text.Blaze.Html5 as H
@@ -22,7 +24,15 @@ post :: Application
 post req = do
   let (Just req') = stripPrefixReq "/post" req
   noticeM $ "Handling post " ^-^ (rawPathInfo req')
-  return (ResponseBuilder statusOK [] $ renderHtmlBuilder postPage)
+  dispatch [ ("*" &~~ "^/$", noPost)
+           , ("*" &~~ "^/[0-9]+", particularPost)
+           ] notFound req'
+
+noPost :: Application
+noPost _ = return (ResponseBuilder statusOK [] $ renderHtmlBuilder postPage)
+
+particularPost :: Application
+particularPost = undefined
 
 postPage :: Html
 postPage = do

Handler/Resource.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | The 'resource' handler just serves static files from the @.\/r\/@
--- directory.  It expects the 'pathInfo' part of the 'Request' to be
--- the path to the file under @.\/r\/@.  I.e. any other path prefix
--- should have been stripped already.
+-- directory.
 module Handler.Resource (
         resource
     ) where

Main.hs

@@ -8,7 +8,7 @@ import Handler.NotFound ( notFound )
 import Handler.Post ( post )
 import Handler.Resource ( resource )
 import Logger ( setupLogger, noticeM )
-import Network.Wai ( Application, Request(..) )
+import Network.Wai ( Application )
 import Network.Wai.Handler.Warp ( run )
 import Network.Wai.Middleware.Route ( dispatch, (&~~) )
 import Types ( Conf(..) )
@@ -26,7 +26,7 @@ main = do
 
 router :: Conf -> Application
 router conf =
-    dispatch [ ((=="/") . rawPathInfo, index conf)
+    dispatch [ ("*" &~~ "^/$", index conf)
              , ("*" &~~ "^/post", post)
              , ("GET" &~~ "^/r/", resource)
              ] notFound

Types.hs

@@ -9,6 +9,7 @@ module Types (
 import Database ( Database )
 import Data.String ( IsString(..) )
 import Data.Text ( stripPrefix, splitOn )
+import qualified Data.Text as T
 import Data.Text.Encoding ( decodeUtf8, encodeUtf8 )
 import Network.Wai ( Request(..) )
 
@@ -17,5 +18,6 @@ data Conf = Conf { getDatabase :: Database }
 stripPrefixReq :: String -> Request -> Maybe Request
 stripPrefixReq pre req = do
     path <- stripPrefix (fromString pre) (decodeUtf8 $ rawPathInfo req)
-    return $ req { rawPathInfo = encodeUtf8 path
-                 , pathInfo    = splitOn "/" path }
+    let path' = if T.null path then "/" else path
+    return $ req { rawPathInfo = encodeUtf8 path'
+                 , pathInfo    = splitOn "/" path' }