Configurable splitPath

Yesod/Dispatch.hs

@@ -37,7 +37,7 @@ import Web.Routes.Site
 import Language.Haskell.TH.Syntax
 
 import qualified Network.Wai as W
-import Network.Wai.Middleware.CleanPath
+import Network.Wai.Middleware.CleanPath (cleanPathFunc)
 import Network.Wai.Middleware.Jsonp
 import Network.Wai.Middleware.Gzip
 
@@ -208,7 +208,7 @@ toWaiApp :: (Yesod y, YesodSite y) => y -> IO W.Application
 toWaiApp a =
     return $ gzip
            $ jsonp
-           $ cleanPathRel (B.pack $ approot a)
+           $ cleanPathFunc (splitPath a) (B.pack $ approot a)
            $ toWaiApp' a
 
 toWaiApp' :: (Yesod y, YesodSite y)

Yesod/Yesod.hs

@@ -42,6 +42,8 @@ import Database.Persist
 import Web.Routes.Site (Site)
 import Control.Monad.Trans.Class (MonadTrans (..))
 import Control.Monad.Attempt (Failure)
+import qualified Data.ByteString as S
+import qualified Network.Wai.Middleware.CleanPath
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
@@ -134,6 +136,20 @@ class Eq (Route a) => Yesod a where
     authRoute :: a -> Maybe (Route a)
     authRoute _ = Nothing
 
+    -- | A function used to split a raw PATH_INFO value into path pieces. It
+    -- returns a 'Left' value when you should redirect to the given path, and a
+    -- 'Right' value on successful parse.
+    --
+    -- By default, it splits paths on slashes, and ensures the following are true:
+    --
+    -- * No double slashes
+    --
+    -- * If the last path segment has a period, there is no trailing slash.
+    --
+    -- * Otherwise, ensures there /is/ a trailing slash.
+    splitPath :: a -> S.ByteString -> Either S.ByteString [String]
+    splitPath _ = Network.Wai.Middleware.CleanPath.splitPath
+
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
     deriving (Eq, Show, Read)
 

yesod.cabal

@@ -23,7 +23,7 @@ library
     build-depends:   base >= 4 && < 5,
                      time >= 1.1.4 && < 1.3,
                      wai >= 0.2.0 && < 0.3,
-                     wai-extra >= 0.2.0 && < 0.3,
+                     wai-extra >= 0.2.2 && < 0.3,
                      authenticate >= 0.6.3 && < 0.7,
                      bytestring >= 0.9.1.4 && < 0.10,
                      directory >= 1 && < 1.1,