From 51f816cb27843cca90df812b88d85d367e209bd5 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 16 May 2010 06:56:04 +0300
Subject: [PATCH] staticFiles

---
 Yesod.hs                |  3 +-
 Yesod/Helpers/Static.hs | 66 +++++++++++++++++++++++++++++++++++++++--
 runtests.hs             |  2 ++
 test/.ignored           |  0
 test/bar/baz            |  0
 test/foo                |  0
 yesod.cabal             |  2 +-
 7 files changed, 69 insertions(+), 4 deletions(-)
 create mode 100644 test/.ignored
 create mode 100644 test/bar/baz
 create mode 100644 test/foo

diff --git a/Yesod.hs b/Yesod.hs
index 73e5f2d2..0bbf0572 100644
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -19,13 +19,14 @@ module Yesod
 #if TEST
 import Yesod.Content hiding (testSuite)
 import Yesod.Json hiding (testSuite)
+import Yesod.Dispatch hiding (testSuite)
 #else
 import Yesod.Content
 import Yesod.Json
+import Yesod.Dispatch
 #endif
 
 import Yesod.Request
-import Yesod.Dispatch
 import Yesod.Form
 import Yesod.Yesod
 import Yesod.Handler hiding (runHandler)
diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs
index 117dc9e6..b588dc98 100644
--- a/Yesod/Helpers/Static.hs
+++ b/Yesod/Helpers/Static.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP #-}
 ---------------------------------------------------------
 --
 -- Module        : Yesod.Helpers.Static
@@ -28,20 +29,31 @@ module Yesod.Helpers.Static
     , siteStatic
       -- * Lookup files in filesystem
     , fileLookupDir
+    , staticFiles
+#if TEST
+    , testSuite
+#endif
     ) where
 
-import System.Directory (doesFileExist)
+import System.Directory
 import Control.Monad
 
 import Yesod
 import Data.List (intercalate)
+import Language.Haskell.TH.Syntax
+
+#if TEST
+import Test.Framework (testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test)
+#endif
 
 -- | A function for looking up file contents. For serving from the file system,
 -- see 'fileLookupDir'.
 data Static = Static (FilePath -> IO (Maybe (Either FilePath Content)))
 
 $(mkYesodSub "Static" [] [$parseRoutes|
-/* StaticRoute GET
+* StaticRoute GET
 |])
 
 -- | Lookup files in a specific directory.
@@ -73,3 +85,53 @@ getStaticRoute fp' = do
     isUnsafe [] = True
     isUnsafe ('.':_) = True
     isUnsafe _ = False
+
+notHidden :: FilePath -> Bool
+notHidden ('.':_) = False
+notHidden _ = True
+
+getFileList :: FilePath -> IO [[String]]
+getFileList = flip go id
+  where
+    go :: String -> ([String] -> [String]) -> IO [[String]]
+    go fp front = do
+        allContents <- filter notHidden `fmap` getDirectoryContents fp
+        let fullPath :: String -> String
+            fullPath f = fp ++ '/' : f
+        files <- filterM (doesFileExist . fullPath) allContents
+        let files' = map (front . return) files
+        dirs <- filterM (doesDirectoryExist . fullPath) allContents
+        dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs
+        return $ concat $ files' : dirs'
+
+staticFiles :: FilePath -> Q [Dec]
+staticFiles fp = do
+    fs <- qRunIO $ getFileList fp
+    concat `fmap` mapM go fs
+  where
+    replace '.' = '_'
+    replace c = c
+    go f = do
+        let name = mkName $ intercalate "/" $ map (map replace) f
+        f' <- lift f
+        let sr = ConE $ mkName "StaticRoute"
+        return
+            [ SigD name $ ConT ''StaticRoutes
+            , FunD name
+                [ Clause [] (NormalB $ sr `AppE` f') []
+                ]
+            ]
+
+#if TEST
+
+testSuite :: Test
+testSuite = testGroup "Yesod.Helpers.Static"
+    [ testCase "get file list" caseGetFileList
+    ]
+
+caseGetFileList :: Assertion
+caseGetFileList = do
+    x <- getFileList "test"
+    x @?= [["foo"], ["bar", "baz"]]
+
+#endif
diff --git a/runtests.hs b/runtests.hs
index de7ac4e1..208e38fe 100644
--- a/runtests.hs
+++ b/runtests.hs
@@ -3,10 +3,12 @@ import Test.Framework (defaultMain)
 import qualified Yesod.Content
 import qualified Yesod.Json
 import qualified Yesod.Dispatch
+import qualified Yesod.Helpers.Static
 
 main :: IO ()
 main = defaultMain
     [ Yesod.Content.testSuite
     , Yesod.Json.testSuite
     , Yesod.Dispatch.testSuite
+    , Yesod.Helpers.Static.testSuite
     ]
diff --git a/test/.ignored b/test/.ignored
new file mode 100644
index 00000000..e69de29b
diff --git a/test/bar/baz b/test/bar/baz
new file mode 100644
index 00000000..e69de29b
diff --git a/test/foo b/test/foo
new file mode 100644
index 00000000..e69de29b
diff --git a/yesod.cabal b/yesod.cabal
index 525fd4f3..d3f240e1 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -33,7 +33,7 @@ library
     build-depends:   base >= 4 && < 5,
                      time >= 1.1.3 && < 1.2,
                      wai >= 0.0.1 && < 0.3,
-                     wai-extra >= 0.1.0 && < 0.2,
+                     wai-extra >= 0.1.1 && < 0.2,
                      authenticate >= 0.6.2 && < 0.7,
                      bytestring >= 0.9.1.4 && < 0.10,
                      web-encodings >= 0.2.6 && < 0.3,