From 9fada88b6e205923e14d4dac3044ad78632c58b1 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 4 Aug 2010 21:35:03 +0300
Subject: [PATCH] Configurable splitPath

---
 Yesod/Dispatch.hs |  4 ++--
 Yesod/Yesod.hs    | 16 ++++++++++++++++
 yesod.cabal       |  2 +-
 3 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
index 33c31b0f..adbe0e56 100644
--- a/Yesod/Dispatch.hs
+++ b/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)
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 835ba722..2fcbd7ab 100644
--- a/Yesod/Yesod.hs
+++ b/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)
 
diff --git a/yesod.cabal b/yesod.cabal
index 27c6cc5a..0bdbfcb7 100644
--- a/yesod.cabal
+++ b/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,