wai-middleware-content-type 0.5.0 → 0.5.0.1
raw patch · 4 files changed
+43/−35 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Network.Wai.Middleware.ContentType.Types: allFileExts :: [FileExt]
- Network.Wai.Middleware.ContentType.Types: possibleFileExts :: AcceptHeader -> [FileExt]
+ Network.Wai.Middleware.ContentType.Types: possibleFileExts :: [FileExt] -> AcceptHeader -> [FileExt]
Files
- src/Network/Wai/Middleware/ContentType.hs +4/−2
- src/Network/Wai/Middleware/ContentType/Types.hs +30/−32
- test/Network/Wai/Middleware/ContentTypeSpec.hs +8/−0
- wai-middleware-content-type.cabal +1/−1
src/Network/Wai/Middleware/ContentType.hs view
@@ -46,6 +46,7 @@ import Network.Wai.Trans (Response, MiddlewareT, requestHeaders, pathInfo) import qualified Data.HashMap.Lazy as HM+import qualified Data.HashSet as HS import Data.Monoid import Control.Monad @@ -61,13 +62,14 @@ getFirst . foldMap (\fe -> First $ runResponseVia <$> HM.lookup fe m) . findFE- $ maybe (HM.keys m) possibleFileExts mAcceptBS+ $ maybe (HM.keys m) (possibleFileExts $ HM.keys m) mAcceptBS where findFE :: [FileExt] -> [FileExt] findFE xs = case mFe of Nothing -> xs- Just fe -> fe <$ guard (fe `elem` xs)+ Just fe | fe `elem` xs -> [fe]+ | otherwise -> [] fileExtsToMiddleware :: Monad m => FileExtListenerT m a -> MiddlewareT m
src/Network/Wai/Middleware/ContentType/Types.hs view
@@ -25,7 +25,6 @@ module Network.Wai.Middleware.ContentType.Types ( -- * Types FileExt (..)- , allFileExts , getFileExt , toExt , ResponseVia (..)@@ -48,7 +47,7 @@ import Data.HashMap.Lazy hiding (null) import qualified Data.HashMap.Lazy as HM import Data.Monoid-import Data.Maybe (fromMaybe, catMaybes)+import Data.Maybe (fromMaybe) import Data.Url import Data.Hashable import qualified Data.ByteString as BS@@ -90,12 +89,7 @@ instance Hashable FileExt --- | All file extensions, in the order of likeliness-allFileExts :: [FileExt]-allFileExts = [Html,Text,Json,JavaScript,Css,Markdown] -{-# INLINEABLE allFileExts #-}- -- | Gets the known file extension from a Request's 'Network.Wai.pathInfo'. getFileExt :: [T.Text] -> Maybe FileExt getFileExt chunks = case chunks of@@ -108,7 +102,7 @@ -- to a known one. toExt :: (T.Text, T.Text) -> Maybe FileExt toExt (y,x)- | x == ""+ | x == "" || T.length y == 0 || T.last y /= '.' = Nothing | x `elem` htmls = Just Html@@ -215,33 +209,37 @@ -- | Takes an @Accept@ header and returns the other -- file types handleable, in order of prescedence.-possibleFileExts :: AcceptHeader -> [FileExt]-possibleFileExts accept = if not (null wildcard) then wildcard else computed+possibleFileExts :: [FileExt] -> AcceptHeader -> [FileExt]+possibleFileExts allFileExts accept = if not (null wildcard) then wildcard else computed where computed :: [FileExt]- computed = concat $- catMaybes [ mapAccept [ ( "application/json" :: BS.ByteString- , [Json])- , ( "application/javascript" :: BS.ByteString- , [JavaScript,Json])- ] accept- , mapAccept [ ( "text/html" :: BS.ByteString- , [Html])- ] accept- , mapAccept [ ( "text/plain" :: BS.ByteString- , [Text, Markdown])- ] accept- , mapAccept [ ( "text/markdown" :: BS.ByteString- , [Markdown])- ] accept- , mapAccept [ ( "text/css" :: BS.ByteString- , [Css])- ] accept- ]+ computed = fromMaybe [] $+ mapAccept [ ( "application/json" :: BS.ByteString+ , [Json]+ )+ , ( "application/javascript" :: BS.ByteString+ , [JavaScript,Json]+ )+ , ( "text/html" :: BS.ByteString+ , [Html]+ )+ , ( "text/css" :: BS.ByteString+ , [Css]+ )+ , ( "text/markdown" :: BS.ByteString+ , [Markdown]+ )+ , ( "text/plain" :: BS.ByteString+ , [Text, Markdown]+ )+ ] accept wildcard :: [FileExt]- wildcard = fromMaybe [] $ mapAccept [ ("*/*" :: BS.ByteString, allFileExts)- ] accept+ wildcard = fromMaybe [] $+ mapAccept [ ("*/*" :: BS.ByteString+ , allFileExts+ )+ ] accept {-# INLINEABLE possibleFileExts #-} @@ -251,6 +249,6 @@ -- > text "foo" -- > invalidEncoding myErrorHandler -- handles all except text/plain invalidEncoding :: Monad m => ResponseVia -> FileExtListenerT m ()-invalidEncoding r = mapM_ (\t -> tell' $ HM.singleton t r) allFileExts+invalidEncoding r = mapM_ (\t -> tell' $ HM.singleton t r) [Html,Css,JavaScript,Json,Text,Markdown] {-# INLINEABLE invalidEncoding #-}
test/Network/Wai/Middleware/ContentTypeSpec.hs view
@@ -11,6 +11,7 @@ import Network.HTTP.Types import qualified Data.Text as T import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT import qualified Lucid as L import qualified Text.Lucius as SL import qualified Text.Julius as SJ@@ -98,6 +99,12 @@ "" { matchStatus = 200 , matchBody = Just "*Pandoc*!" }+ describe "Foo" $+ it "should respond with 200" $+ HW.get "/index.foo" `shouldRespondWith`+ "" { matchStatus = 200+ , matchBody = Just "Foo"+ } describe "All Requests Respond to Both" $ with (return app) $ do describe "Text" $@@ -173,3 +180,4 @@ case P.readMarkdown P.def "*Pandoc*!" of Left e -> error $ show e Right p -> p+ bytestring (Other "foo") (LT.encodeUtf8 "Foo")
wai-middleware-content-type.cabal view
@@ -1,5 +1,5 @@ Name: wai-middleware-content-type-Version: 0.5.0+Version: 0.5.0.1 Author: Athan Clark <athan.clark@gmail.com> Maintainer: Athan Clark <athan.clark@gmail.com> License: BSD3