From 2db05e205565721b251656c16e6f8bb38a7466c9 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 20 Jan 2011 23:55:05 +0200
Subject: [PATCH] Using wai-app-static (not sure if it will stick yet), does
 not fully work

---
 Yesod/Helpers/Static.hs | 85 +++++++++--------------------------------
 yesod-static.cabal      |  1 +
 2 files changed, 18 insertions(+), 68 deletions(-)

diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs
index dccb2a39..1d2fc449 100644
--- a/Yesod/Helpers/Static.hs
+++ b/Yesod/Helpers/Static.hs
@@ -29,10 +29,8 @@ module Yesod.Helpers.Static
       Static (..)
     , StaticRoute (..)
       -- * Lookup files in filesystem
-    , fileLookupDir
     , staticFiles
       -- * Embed files
-    , mkEmbedFiles
     , getStaticHandler
       -- * Hashing
     , base64md5
@@ -48,8 +46,10 @@ import Data.Maybe (fromMaybe)
 import Yesod.Handler
 import Yesod.Content
 import Yesod.Core
+import Yesod.Request
 
 import Control.Monad.IO.Class (liftIO)
+import qualified Control.Monad.Trans.Class as Trans
 
 import Data.List (intercalate)
 import Language.Haskell.TH
@@ -62,6 +62,9 @@ import qualified Data.ByteString.Base64
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.Serialize
 
+import Network.Wai.Application.Static
+    (defaultMimeTypeByExt, StaticSettings (..), staticApp, defaultListing)
+
 #if TEST
 import Test.Framework (testGroup, Test)
 import Test.Framework.Providers.HUnit
@@ -71,9 +74,8 @@ import Test.HUnit hiding (Test)
 -- | A function for looking up file contents. For serving from the file system,
 -- see 'fileLookupDir'.
 data Static = Static
-    { staticLookup :: FilePath -> IO (Maybe (Either FilePath Content))
-    -- | Mapping from file extension to content type. See 'typeByExt'.
-    , staticTypes :: [(String, ContentType)]
+    { staticPrefix :: FilePath
+    -- FIXME why not just put in a StaticSettings here?
     }
 
 -- | Manually construct a static route.
@@ -92,54 +94,21 @@ instance YesodSubSite Static master where
     getSubSite = Site
         { handleSite = \_ (StaticRoute ps _) m ->
                             case m of
-                                "GET" -> Just $ fmap chooseRep $ getStaticRoute ps
+                                "GET" -> Just $ do
+                                    Static prefix <- getYesodSub
+                                    req <- waiRequest
+                                    res <- Trans.lift $ staticApp StaticSettings
+                                            { ssFolder = prefix
+                                            , ssIndices = []
+                                            , ssListing = Just defaultListing
+                                            , ssGetMimeType = return . defaultMimeTypeByExt
+                                            } req
+                                    sendWaiResponse res
                                 _ -> Nothing
         , formatPathSegments = \(StaticRoute x y) -> (x, y)
         , parsePathSegments = \x -> Right $ StaticRoute x []
         }
 
--- | Lookup files in a specific directory.
---
--- If you are just using this in combination with the static subsite (you
--- probably are), the handler itself checks that no unsafe paths are being
--- requested. In particular, no path segments may begin with a single period,
--- so hidden files and parent directories are safe.
---
--- For the second argument to this function, you can just use 'typeByExt'.
-fileLookupDir :: FilePath -> [(String, ContentType)] -> Static
-fileLookupDir dir = Static $ \fp -> do
-    let fp' = dir ++ '/' : fp
-    exists <- doesFileExist fp'
-    if exists
-        then return $ Just $ Left fp'
-        else return Nothing
-
--- | Lookup files in a specific directory, and embed them into the haskell source.
---
--- A variation of fileLookupDir which allows subsites distributed via cabal to include
--- static content.  You can still use staticFiles to generate route identifiers.  See getStaticHandler
--- for dispatching static content for a subsite.
-mkEmbedFiles :: FilePath -> Q Exp
-mkEmbedFiles d = do
-    fs <- qRunIO $ getFileList d
-    clauses <- mapM (mkClause . intercalate "/") fs
-    defC <- defaultClause
-    return $ static $ clauses ++ [defC]
-  where static clauses = LetE [fun clauses] $ ConE 'Static `AppE` VarE f
-        f = mkName "f"
-        fun clauses = FunD f clauses
-        defaultClause = do
-          b <- [| return Nothing |]
-          return $ Clause [WildP] (NormalB b) []
-
-        mkClause p = do
-          content <- qRunIO $ readFile $ d ++ '/':p
-          let pat = LitP $ StringL p
-              foldAppE = foldl1 AppE
-              content' = return $ LitE $ StringL $ content
-          body <- normalB [| return $ Just $ Right $ toContent ($content' :: [Char]) |]
-          return $ Clause [pat] body []
-
 -- | Dispatch static route for a subsite
 --
 -- Subsites with static routes can't (yet) define Static routes the same way "master" sites can.
@@ -160,26 +129,6 @@ getStaticHandler static toSubR pieces = do
         staticSite = getSubSite :: Site (Route Static) (String -> Maybe (GHandler Static y ChooseRep))
         handler = fromMaybe notFound $ handleSite staticSite undefined route "GET"
 
-getStaticRoute :: [String]
-               -> GHandler Static master (ContentType, Content)
-getStaticRoute fp' = do
-    Static fl ctypes <- getYesodSub
-    when (any isUnsafe fp') notFound
-    let fp = intercalate "/" fp'
-    content <- liftIO $ fl fp
-    case content of
-        Nothing -> notFound
-        Just (Left fp'') -> do
-            let ctype = fromMaybe typeOctet $ lookup (ext fp'') ctypes
-            sendFile ctype fp''
-        Just (Right bs) -> do
-            let ctype = fromMaybe typeOctet $ lookup (ext fp) ctypes
-            return (ctype, bs)
-  where
-    isUnsafe [] = True
-    isUnsafe ('.':_) = True
-    isUnsafe _ = False
-
 notHidden :: FilePath -> Bool
 notHidden ('.':_) = False
 notHidden "tmp" = False
diff --git a/yesod-static.cabal b/yesod-static.cabal
index 0743f29d..70b3db8f 100644
--- a/yesod-static.cabal
+++ b/yesod-static.cabal
@@ -26,6 +26,7 @@ library
                    , template-haskell
                    , directory                 >= 1.0      && < 1.2
                    , transformers              >= 0.2      && < 0.3
+                   , wai-app-static            >= 0.0      && < 0.1
     exposed-modules: Yesod.Helpers.Static
     ghc-options:     -Wall