Works with newest yesod-core
This commit is contained in:
parent
2db05e2055
commit
bb0f91e2ba
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user