Works with newest yesod-core

This commit is contained in:
Michael Snoyman 2011-01-30 19:49:18 +02:00
parent 2db05e2055
commit bb0f91e2ba
2 changed files with 26 additions and 34 deletions

View File

@ -28,10 +28,14 @@ module Yesod.Helpers.Static
( -- * Subsite
Static (..)
, StaticRoute (..)
-- * Lookup files in filesystem
-- * Smart constructor
, static
-- * Template Haskell helpers
, staticFiles
{-
-- * Embed files
, getStaticHandler
-}
-- * Hashing
, base64md5
#if TEST
@ -41,20 +45,13 @@ module Yesod.Helpers.Static
import System.Directory
import Control.Monad
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
import Language.Haskell.TH.Syntax
import Web.Routes
import qualified Data.ByteString.Lazy as L
import Data.Digest.Pure.MD5
@ -63,7 +60,9 @@ import qualified Data.ByteString.Char8 as S8
import qualified Data.Serialize
import Network.Wai.Application.Static
(defaultMimeTypeByExt, StaticSettings (..), staticApp, defaultListing)
( defaultMimeTypeByExt, StaticSettings (..), staticAppPieces
, defaultListing
)
#if TEST
import Test.Framework (testGroup, Test)
@ -71,12 +70,15 @@ 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
{ staticPrefix :: FilePath
-- FIXME why not just put in a StaticSettings here?
}
newtype Static = Static StaticSettings
-- | Default value of 'Static' for a given file folder.
--
-- Does not have index files, uses default directory listings and default mime
-- type list.
static :: FilePath -> Static
static fp = Static $ StaticSettings fp [] (Just defaultListing)
(return . defaultMimeTypeByExt)
-- | Manually construct a static route.
-- The first argument is a sub-path to the file being served whereas the second argument is the key value pairs in the query string.
@ -90,25 +92,14 @@ data StaticRoute = StaticRoute [String] [(String, String)]
type instance Route Static = StaticRoute
instance YesodSubSite Static master where
getSubSite = Site
{ handleSite = \_ (StaticRoute ps _) m ->
case m of
"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 []
}
instance RenderRoute StaticRoute where
renderRoute (StaticRoute x y) = (x, y)
instance Yesod master => YesodDispatch Static master where
yesodDispatch (Static set) _ pieces _ _ =
Just $ staticAppPieces set pieces
{- FIXME
-- | Dispatch static route for a subsite
--
-- Subsites with static routes can't (yet) define Static routes the same way "master" sites can.
@ -128,6 +119,7 @@ getStaticHandler static toSubR pieces = do
toSub _ = static
staticSite = getSubSite :: Site (Route Static) (String -> Maybe (GHandler Static y ChooseRep))
handler = fromMaybe notFound $ handleSite staticSite undefined route "GET"
-}
notHidden :: FilePath -> Bool
notHidden ('.':_) = False

View File

@ -26,7 +26,7 @@ library
, template-haskell
, directory >= 1.0 && < 1.2
, transformers >= 0.2 && < 0.3
, wai-app-static >= 0.0 && < 0.1
, wai-app-static >= 0.0.1 && < 0.1
exposed-modules: Yesod.Helpers.Static
ghc-options: -Wall