Merge branch '1286-yesod-static-apply-middleware'

This commit is contained in:
Michael Snoyman 2016-11-06 06:40:01 +02:00
commit 036b020c8c
2 changed files with 11 additions and 2 deletions

View File

@ -6,6 +6,7 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
--------------------------------------------------------- ---------------------------------------------------------
-- --
-- | Serve static files from a Yesod app. -- | Serve static files from a Yesod app.
@ -74,6 +75,7 @@ import Language.Haskell.TH.Syntax as TH
import Crypto.Hash.Conduit (hashFile, sinkHash) import Crypto.Hash.Conduit (hashFile, sinkHash)
import Crypto.Hash (MD5, Digest) import Crypto.Hash (MD5, Digest)
import Control.Monad.Catch (MonadThrow)
import Control.Monad.Trans.State import Control.Monad.Trans.State
import qualified Data.Byteable as Byteable import qualified Data.Byteable as Byteable
@ -102,6 +104,7 @@ import qualified Data.Text.Lazy.Encoding as TLE
import Data.Default import Data.Default
--import Text.Lucius (luciusRTMinified) --import Text.Lucius (luciusRTMinified)
import Network.Wai (pathInfo)
import Network.Wai.Application.Static import Network.Wai.Application.Static
( StaticSettings (..) ( StaticSettings (..)
, staticApp , staticApp
@ -170,11 +173,16 @@ instance RenderRoute Static where
instance ParseRoute Static where instance ParseRoute Static where
parseRoute (x, y) = Just $ StaticRoute x y parseRoute (x, y) = Just $ StaticRoute x y
instance YesodSubDispatch Static m where instance (MonadThrow m, MonadIO m, MonadBaseControl IO m)
=> YesodSubDispatch Static (HandlerT master m) where
yesodSubDispatch YesodSubRunnerEnv {..} req = yesodSubDispatch YesodSubRunnerEnv {..} req =
staticApp set req ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
where where
base = stripHandlerT handlert ysreGetSub ysreToParentRoute route
route = Just $ StaticRoute (pathInfo req) []
Static set = ysreGetSub $ yreSite $ ysreParentEnv Static set = ysreGetSub $ yreSite $ ysreParentEnv
handlert = sendWaiApplication $ staticApp set
notHidden :: FilePath -> Bool notHidden :: FilePath -> Bool
notHidden "tmp" = False notHidden "tmp" = False

View File

@ -59,6 +59,7 @@ library
, blaze-builder >= 0.3 , blaze-builder >= 0.3
, css-text >= 0.1.2 , css-text >= 0.1.2
, hashable >= 1.1 , hashable >= 1.1
, exceptions
exposed-modules: Yesod.Static exposed-modules: Yesod.Static
Yesod.EmbeddedStatic Yesod.EmbeddedStatic