packages feed

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 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