From 27d62db253df70112f064eafe621e3a9780277dd Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 20 Jan 2011 23:56:09 +0200
Subject: [PATCH] sendWaiResponse, changes to accomodate wai-app-static

---
 Yesod/Content.hs  | 52 -----------------------------------------------
 Yesod/Core.hs     |  9 +++++++-
 Yesod/Dispatch.hs |  2 +-
 Yesod/Handler.hs  | 18 ++++++++--------
 4 files changed, 18 insertions(+), 63 deletions(-)

diff --git a/Yesod/Content.hs b/Yesod/Content.hs
index 9b026de7..cd28f5ca 100644
--- a/Yesod/Content.hs
+++ b/Yesod/Content.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE CPP #-}
 
 module Yesod.Content
     ( -- * Content
@@ -28,9 +27,6 @@ module Yesod.Content
     , typeFlv
     , typeOgv
     , typeOctet
-      -- ** File extensions
-    , typeByExt
-    , ext
       -- * Utilities
     , simpleContentType
       -- * Representations
@@ -47,9 +43,6 @@ module Yesod.Content
     , formatW3
     , formatRFC1123
     , formatRFC822
-#if TEST
-    , contentTestSuite
-#endif
     ) where
 
 import Data.Maybe (mapMaybe)
@@ -64,13 +57,6 @@ import System.Locale
 import qualified Data.Text.Encoding
 import qualified Data.Text.Lazy.Encoding
 
-#if TEST
-import Test.Framework (testGroup, Test)
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit hiding (Test)
-#endif
-
 import Data.Enumerator (Enumerator)
 import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
 import Data.Monoid (mempty)
@@ -231,44 +217,6 @@ typeOctet = "application/octet-stream"
 simpleContentType :: String -> String
 simpleContentType = fst . span (/= ';')
 
--- | A default extension to mime-type dictionary.
-typeByExt :: [(String, ContentType)] -- FIXME move to yesod-static
-typeByExt =
-    [ ("jpg", typeJpeg)
-    , ("jpeg", typeJpeg)
-    , ("js", typeJavascript)
-    , ("css", typeCss)
-    , ("html", typeHtml)
-    , ("png", typePng)
-    , ("gif", typeGif)
-    , ("txt", typePlain)
-    , ("flv", typeFlv)
-    , ("ogv", typeOgv)
-    ]
-
--- | Get a file extension (everything after last period).
-ext :: String -> String
-ext = reverse . fst . break (== '.') . reverse
-
-#if TEST
----- Testing
-contentTestSuite :: Test
-contentTestSuite = testGroup "Yesod.Resource"
-    [ testProperty "ext" propExt
-    , testCase "typeByExt" caseTypeByExt
-    ]
-
-propExt :: String -> Bool
-propExt s =
-    let s' = filter (/= '.') s
-     in s' == ext ("foobarbaz." ++ s')
-
-caseTypeByExt :: Assertion
-caseTypeByExt = do
-    Just typeJavascript @=? lookup (ext "foo.js") typeByExt
-    Just typeHtml @=? lookup (ext "foo.html") typeByExt
-#endif
-
 -- | Format a 'UTCTime' in W3 format.
 formatW3 :: UTCTime -> String
 formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
index 2dc122e8..da4f2d20 100644
--- a/Yesod/Core.hs
+++ b/Yesod/Core.hs
@@ -180,6 +180,11 @@ class Eq (Route a) => Yesod a where
     -- * If the last path segment has a period, there is no trailing slash.
     --
     -- * Otherwise, ensures there /is/ a trailing slash.
+    --
+    -- Note: As a special rule, any paths beginning with static are left alone
+    -- so that the static subsite, if available, can deal with proper
+    -- directory/folder naming. If you do not wish this behavior, you will need
+    -- to override this method.
     splitPath :: a -> S.ByteString -> Either S.ByteString [String]
     splitPath _ s =
         if corrected == s
@@ -188,7 +193,9 @@ class Eq (Route a) => Yesod a where
                        $ S8.unpack s
             else Left corrected
       where
-        corrected = S8.pack $ rts $ ats $ rds $ S8.unpack s
+        corrected
+            | s == "/static" || "/static/" `S.isPrefixOf` s = s
+            | otherwise = S8.pack $ rts $ ats $ rds $ S8.unpack s
 
         -- | Remove double slashes
         rds :: String -> String
diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
index 695abe99..f1e47ff7 100644
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -338,7 +338,7 @@ toWaiApp' y key' segments env = do
                     ContentFile fp -> W.ResponseFile s hs''' fp
                     ContentEnum e -> W.ResponseEnumerator $ \iter ->
                         run_ $ e $$ iter s hs'''
-        YAREnum e -> return $ W.ResponseEnumerator e
+        YARWai r -> return r
 
 httpAccept :: W.Request -> [ContentType]
 httpAccept = map B.unpack
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
index b05a2a4a..6581c614 100644
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -52,7 +52,7 @@ module Yesod.Handler
     , sendResponse
     , sendResponseStatus
     , sendResponseCreated
-    , sendResponseEnumerator
+    , sendWaiResponse
       -- * Setting headers
     , setCookie
     , deleteCookie
@@ -244,7 +244,7 @@ newtype YesodApp = YesodApp
     }
 
 data YesodAppResult
-    = YAREnum (forall a. W.ResponseEnumerator a)
+    = YARWai W.Response
     | YARPlain W.Status [Header] ContentType Content SessionMap
 
 data HandlerContents =
@@ -253,7 +253,7 @@ data HandlerContents =
     | HCSendFile ContentType FilePath
     | HCRedirect RedirectType String
     | HCCreated String
-    | HCEnum (forall a. W.ResponseEnumerator a)
+    | HCWai W.Response
 
 instance Error HandlerContents where
     strMsg = HCError . InternalError
@@ -333,7 +333,7 @@ runHandler handler mrender sroute tomr ma tosa =
                 YARPlain _ hs ct c sess ->
                     let hs' = headers hs
                      in return $ YARPlain (getStatus e) hs' ct c sess
-                YAREnum _ -> return yar
+                YARWai _ -> return yar
     let sendFile' ct fp =
             return $ YARPlain W.status200 (headers []) ct (ContentFile fp) finalSession
     case contents of
@@ -357,7 +357,7 @@ runHandler handler mrender sroute tomr ma tosa =
                 typePlain
                 emptyContent
                 finalSession
-        HCEnum e -> return $ YAREnum e
+        HCWai r -> return $ YARWai r
 
 catchIter :: Exception e
           => Iteratee ByteString IO a
@@ -478,13 +478,13 @@ sendResponseCreated url = do
     r <- getUrlRender
     GHandler $ lift $ throwError $ HCCreated $ r url
 
--- | Send a 'W.ResponseEnumerator'. Please note: this function is rarely
+-- | Send a 'W.Response'. Please note: this function is rarely
 -- necessary, and will /disregard/ any changes to response headers and session
 -- that you have already specified. This function short-circuits. It should be
--- considered only for they specific needs. If you are not sure if you need it,
+-- considered only for very specific needs. If you are not sure if you need it,
 -- you don't.
-sendResponseEnumerator :: (forall a. W.ResponseEnumerator a) -> GHandler s m b
-sendResponseEnumerator = GHandler . lift . throwError . HCEnum
+sendWaiResponse :: W.Response -> GHandler s m b
+sendWaiResponse = GHandler . lift . throwError . HCWai
 
 -- | Return a 404 not found page. Also denotes no handler available.
 notFound :: Failure ErrorResponse m => m a