wai-middleware-content-type 0.1.0.1 → 0.1.1

raw patch · 16 files changed

+240/−84 lines, 16 filesdep +hashabledep +unordered-containersdep −containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hashable, unordered-containers

Dependencies removed: containers

API changes (from Hackage documentation)

Files

• src/Network/Wai/Middleware/ContentType.hs +8/−10
• src/Network/Wai/Middleware/ContentType/Blaze.hs +29/−7
• src/Network/Wai/Middleware/ContentType/Builder.hs +14/−2
• src/Network/Wai/Middleware/ContentType/ByteString.hs +14/−1
• src/Network/Wai/Middleware/ContentType/Cassius.hs +4/−4
• src/Network/Wai/Middleware/ContentType/Clay.hs +27/−4
• src/Network/Wai/Middleware/ContentType/Json.hs +39/−4
• src/Network/Wai/Middleware/ContentType/Julius.hs +4/−4
• src/Network/Wai/Middleware/ContentType/Lucid.hs +28/−4
• src/Network/Wai/Middleware/ContentType/Lucius.hs +4/−4
• src/Network/Wai/Middleware/ContentType/Middleware.hs +4/−2
• src/Network/Wai/Middleware/ContentType/Pandoc.hs +4/−4
• src/Network/Wai/Middleware/ContentType/Text.hs +27/−4
• src/Network/Wai/Middleware/ContentType/Types.hs +27/−22
• test/Network/Wai/Middleware/ContentTypeSpec.hs +0/−4
• wai-middleware-content-type.cabal +7/−4

@@ -78,8 +78,8 @@  import Network.Wai.Middleware.ContentType.Middleware (middleware) -import qualified Data.ByteString as BS-import qualified Data.Map as Map+import qualified Data.ByteString   as BS+import qualified Data.HashMap.Lazy as HM import Data.Maybe (fromMaybe, catMaybes) import Data.Monoid import Control.Monad.Trans@@ -94,7 +94,7 @@                           -> MiddlewareT m fileExtsToMiddleware contentRoutes app req respond = do   let mAcceptBS = Prelude.lookup ("Accept" :: HeaderName) $ requestHeaders req-      mFe       = getFileExt req+      mFe       = getFileExt (pathInfo req)   mMiddleware <- lookupResponse mAcceptBS mFe contentRoutes   fromMaybe (app req respond) $ do     mid <- mMiddleware@@ -107,20 +107,18 @@                     -> Maybe FileExt                     -> FileExtListenerT (MiddlewareT m) m ()                     -> m (Maybe (MiddlewareT m))-lookupResponse mAcceptBS mFe fexts = do-  femap <- execFileExtListenerT fexts-  return $ lookupFileExt femap+lookupResponse mAcceptBS mFe fexts =+  lookupFileExt <$> execFileExtListenerT fexts   where     lookupFileExt xs =       let attempts = findFE $ maybe allFileExts possibleFileExts mAcceptBS-      in  getFirst $ foldMap (First . flip Map.lookup xs) attempts+      in  getFirst $ foldMap (First . flip HM.lookup xs) attempts      findFE :: [FileExt] -> [FileExt]     findFE xs =       case mFe of-        Nothing -> []-        Just fe | fe == None -> xs-                | otherwise  -> fe <$ guard (fe `elem` xs)+        Nothing -> xs+        Just fe -> fe <$ guard (fe `elem` xs)   -- | Takes an @Accept@ header and returns the other

@@ -3,14 +3,13 @@ module Network.Wai.Middleware.ContentType.Blaze where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder -import qualified Data.Text.Lazy.Encoding                 as LT import           Network.HTTP.Types                      (RequestHeaders,                                                           Status, status200) import           Network.Wai.Trans import qualified Text.Blaze.Html                         as H-import qualified Text.Blaze.Html.Renderer.Text           as H+import qualified Text.Blaze.Html.Renderer.Utf8           as H import           Control.Monad.IO.Class                  (MonadIO)  @@ -21,54 +20,77 @@          H.Html -> FileExtListenerT (MiddlewareT m) m () blaze = blazeStatusHeaders status200 [("Content-Type", "text/html")] +{-# INLINEABLE blaze #-}+ blazeWith :: MonadIO m =>              (Response -> Response) -> H.Html           -> FileExtListenerT (MiddlewareT m) m () blazeWith f = blazeStatusHeadersWith f status200 [("Content-Type", "text/html")] +{-# INLINEABLE blazeWith #-}+ blazeStatus :: MonadIO m =>                Status -> H.Html             -> FileExtListenerT (MiddlewareT m) m () blazeStatus s = blazeStatusHeaders s [("Content-Type", "text/html")] +{-# INLINEABLE blazeStatus #-}+ blazeStatusWith :: MonadIO m =>                    (Response -> Response) -> Status -> H.Html                 -> FileExtListenerT (MiddlewareT m) m () blazeStatusWith f s = blazeStatusHeadersWith f s [("Content-Type", "text/html")] +{-# INLINEABLE blazeStatusWith #-}+ blazeHeaders :: MonadIO m =>                 RequestHeaders -> H.Html              -> FileExtListenerT (MiddlewareT m) m () blazeHeaders = blazeStatusHeaders status200 +{-# INLINEABLE blazeHeaders #-}+ blazeHeadersWith :: MonadIO m =>                     (Response -> Response) -> RequestHeaders -> H.Html                  -> FileExtListenerT (MiddlewareT m) m () blazeHeadersWith f = blazeStatusHeadersWith f status200 +{-# INLINEABLE blazeHeadersWith #-}+ blazeStatusHeaders :: MonadIO m =>                       Status -> RequestHeaders -> H.Html                    -> FileExtListenerT (MiddlewareT m) m () blazeStatusHeaders = blazeStatusHeadersWith id +{-# INLINEABLE blazeStatusHeaders #-}+ blazeStatusHeadersWith :: MonadIO m =>                           (Response -> Response) -> Status -> RequestHeaders -> H.Html                        -> FileExtListenerT (MiddlewareT m) m ()-blazeStatusHeadersWith f s hs i =-  bytestringStatusWith f Html s hs $ LT.encodeUtf8 $ H.renderHtml i+blazeStatusHeadersWith f s hs =+  builderStatusWith f Html s hs . H.renderHtmlBuilder +{-# INLINEABLE blazeStatusHeadersWith #-}  -- * 'Network.Wai.Response' Only  blazeOnly :: H.Html -> Response blazeOnly = blazeOnlyStatusHeaders status200 [("Content-Type", "text/html")] +{-# INLINEABLE blazeOnly #-}+ blazeOnlyHeaders :: RequestHeaders -> H.Html -> Response blazeOnlyHeaders = blazeOnlyStatusHeaders status200 +{-# INLINEABLE blazeOnlyHeaders #-}+ blazeOnlyStatus :: Status -> H.Html -> Response blazeOnlyStatus s = blazeOnlyStatusHeaders s [("Content-Type", "text/html")] +{-# INLINEABLE blazeOnlyStatus #-}+ blazeOnlyStatusHeaders :: Status -> RequestHeaders -> H.Html -> Response-blazeOnlyStatusHeaders s hs i =-  bytestringOnlyStatus s hs $ LT.encodeUtf8 $ H.renderHtml i+blazeOnlyStatusHeaders s hs =+  builderOnlyStatus s hs . H.renderHtmlBuilder++{-# INLINEABLE blazeOnlyStatusHeaders #-}

@@ -7,7 +7,7 @@ import           Network.Wai.Trans  import qualified Data.ByteString.Builder                 as BU-import qualified Data.Map                                as Map+import qualified Data.HashMap.Lazy                       as HM import           Control.Monad.IO.Class  @@ -20,30 +20,42 @@         -> FileExtListenerT (MiddlewareT m) m () builder e  = builderStatus e status200 +{-# INLINEABLE builder #-}+ builderWith :: MonadIO m =>                (Response -> Response) -> FileExt -> RequestHeaders -> BU.Builder             -> FileExtListenerT (MiddlewareT m) m () builderWith f e = builderStatusWith f e status200 +{-# INLINEABLE builderWith #-}+ builderStatus :: MonadIO m =>                  FileExt -> Status -> RequestHeaders -> BU.Builder               -> FileExtListenerT (MiddlewareT m) m () builderStatus = builderStatusWith id +{-# INLINEABLE builderStatus #-}+ builderStatusWith :: MonadIO m =>                      (Response -> Response) -> FileExt -> Status -> RequestHeaders -> BU.Builder                   -> FileExtListenerT (MiddlewareT m) m () builderStatusWith f e s hs i =   let r = builderOnlyStatus s hs i in   FileExtListenerT $ tell' $-    Map.singleton e $ \_ _ respond -> respond (f r)+    HM.singleton e (\_ _ respond -> respond $! f r) +{-# INLINEABLE builderStatusWith #-} + -- * 'Network.Wai.Response' Only  builderOnly :: RequestHeaders -> BU.Builder -> Response builderOnly = builderOnlyStatus status200 +{-# INLINEABLE builderOnly #-}+ -- | The exact same thing as @Network.Wai.responseBuilder@. builderOnlyStatus :: Status -> RequestHeaders -> BU.Builder -> Response builderOnlyStatus = responseBuilder++{-# INLINEABLE builderOnlyStatus #-}

@@ -20,14 +20,21 @@            -> FileExtListenerT (MiddlewareT m) m () bytestring e = bytestringStatus e status200 +{-# INLINEABLE bytestring #-}+ bytestringWith :: MonadIO m => (Response -> Response) -> FileExt -> RequestHeaders -> B.ByteString                -> FileExtListenerT (MiddlewareT m) m () bytestringWith f e = bytestringStatusWith f e status200 +{-# INLINEABLE bytestringWith #-}+ bytestringStatus :: MonadIO m => FileExt -> Status -> RequestHeaders -> B.ByteString                  -> FileExtListenerT (MiddlewareT m) m () bytestringStatus = bytestringStatusWith id +{-# INLINEABLE bytestringStatus #-}++ bytestringStatusWith :: MonadIO m =>                         (Response -> Response)                      -> FileExt@@ -37,14 +44,20 @@                      -> FileExtListenerT (MiddlewareT m) m () bytestringStatusWith f fe s hs i = do   r <- lift $ U.bytestring s hs i-  middleware fe $ \_ _ respond -> respond (f r)+  middleware fe (\_ _ respond -> respond (f r)) +{-# INLINEABLE bytestringStatusWith #-} + -- * 'Network.Wai.Response' Only  bytestringOnly :: RequestHeaders -> B.ByteString -> Response bytestringOnly = bytestringOnlyStatus status200 +{-# INLINEABLE bytestringOnly #-}+ -- | The exact same thing as @Network.Wai.responseLBS@. bytestringOnlyStatus :: Status -> RequestHeaders -> B.ByteString -> Response bytestringOnlyStatus = responseLBS++{-# INLINEABLE bytestringOnlyStatus #-}

@@ -3,7 +3,7 @@ module Network.Wai.Middleware.ContentType.Cassius where  import           Network.Wai.Middleware.ContentType.Types as FE-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder import           Network.HTTP.Types                      (RequestHeaders, Status, status200) import           Network.Wai.Trans @@ -51,8 +51,8 @@ cassiusStatusHeadersWith :: MonadIO m =>                             (Response -> Response) -> Status -> RequestHeaders -> Css                          -> FileExtListenerT (MiddlewareT m) m ()-cassiusStatusHeadersWith f s hs i =-  bytestringStatusWith f Css s hs $ LT.encodeUtf8 $ renderCss i+cassiusStatusHeadersWith f s hs =+  builderStatusWith f Css s hs . LT.encodeUtf8Builder . renderCss   -- * 'Network.Wai.Response' Only@@ -67,4 +67,4 @@ cassiusOnlyHeaders = cassiusOnlyStatusHeaders status200  cassiusOnlyStatusHeaders :: Status -> RequestHeaders -> Css -> Response-cassiusOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderCss i+cassiusOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderCss

@@ -3,7 +3,7 @@ module Network.Wai.Middleware.ContentType.Clay where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder import           Network.HTTP.Types                      (RequestHeaders, Status, status200) import           Network.Wai.Trans @@ -21,42 +21,57 @@      -> FileExtListenerT (MiddlewareT m) m () clay c as = clayStatusHeaders c as status200 [("Content-Type", "text/css")] +{-# INLINEABLE clay #-}+ clayWith :: MonadIO m =>             (Response -> Response) -> Config -> [App] -> Css          -> FileExtListenerT (MiddlewareT m) m () clayWith f c as = clayStatusHeadersWith f c as status200 [("Content-Type", "text/css")] +{-# INLINEABLE clayWith #-}+ clayStatus :: MonadIO m =>               Config -> [App] -> Status -> Css            -> FileExtListenerT (MiddlewareT m) m () clayStatus c as s = clayStatusHeaders c as s [("Content-Type", "text/css")] +{-# INLINEABLE clayStatus #-}+ clayStatusWith :: MonadIO m =>                   (Response -> Response) -> Config -> [App] -> Status -> Css                -> FileExtListenerT (MiddlewareT m) m () clayStatusWith f c as s = clayStatusHeadersWith f c as s [("Content-Type", "text/css")] +{-# INLINEABLE clayStatusWith #-}+ clayHeaders :: MonadIO m =>                Config -> [App] -> RequestHeaders -> Css             -> FileExtListenerT (MiddlewareT m) m () clayHeaders c as = clayStatusHeaders c as status200 +{-# INLINEABLE clayHeaders #-}+ clayHeadersWith :: MonadIO m =>                    (Response -> Response) -> Config -> [App] -> RequestHeaders -> Css                 -> FileExtListenerT (MiddlewareT m) m () clayHeadersWith f c as = clayStatusHeadersWith f c as status200 +{-# INLINEABLE clayHeadersWith #-}+ clayStatusHeaders :: MonadIO m =>                      Config -> [App] -> Status -> RequestHeaders -> Css                   -> FileExtListenerT (MiddlewareT m) m () clayStatusHeaders = clayStatusHeadersWith id +{-# INLINEABLE clayStatusHeaders #-}+ clayStatusHeadersWith :: MonadIO m =>                          (Response -> Response) -> Config -> [App] -> Status -> RequestHeaders -> Css                       -> FileExtListenerT (MiddlewareT m) m ()-clayStatusHeadersWith f c as s hs i =-  bytestringStatusWith f Css s hs $ LT.encodeUtf8 $ renderWith c as i+clayStatusHeadersWith f c as s hs =+  builderStatusWith f Css s hs . LT.encodeUtf8Builder . renderWith c as +{-# INLINEABLE clayStatusHeadersWith #-}   -- * 'Network.Wai.Response' Only@@ -64,11 +79,19 @@ clayOnly :: Config -> [App] -> Css -> Response clayOnly c as = clayOnlyStatusHeaders c as status200 [("Content-Type", "text/css")] +{-# INLINEABLE clayOnly #-}+ clayOnlyStatus :: Config -> [App] -> Status -> Css -> Response clayOnlyStatus c as s = clayOnlyStatusHeaders c as s [("Content-Type", "text/css")] +{-# INLINEABLE clayOnlyStatus #-}+ clayOnlyHeaders :: Config -> [App] -> RequestHeaders -> Css -> Response clayOnlyHeaders c as = clayOnlyStatusHeaders c as status200 +{-# INLINEABLE clayOnlyHeaders #-}+ clayOnlyStatusHeaders :: Config -> [App] -> Status -> RequestHeaders -> Css -> Response-clayOnlyStatusHeaders c as s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderWith c as i+clayOnlyStatusHeaders c as s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderWith c as++{-# INLINEABLE clayOnlyStatusHeaders #-}

@@ -20,69 +20,92 @@         ) => j -> FileExtListenerT (MiddlewareT m) m () json = jsonStatusHeaders status200 [("Content-Type", "application/json")] +{-# INLINEABLE json #-}+ jsonWith :: ( A.ToJSON j             , MonadIO m             ) => (Response -> Response) -> j -> FileExtListenerT (MiddlewareT m) m () jsonWith f = jsonStatusHeadersWith f status200 [("Content-Type", "application/json")] +{-# INLINEABLE jsonWith #-}+ jsonStatus :: ( A.ToJSON j               , MonadIO m               ) => Status -> j -> FileExtListenerT (MiddlewareT m) m () jsonStatus s = jsonStatusHeaders s [("Content-Type", "application/json")] +{-# INLINEABLE jsonStatus #-}+ jsonStatusWith :: ( A.ToJSON j                   , MonadIO m                   ) => (Response -> Response) -> Status -> j                     -> FileExtListenerT (MiddlewareT m) m () jsonStatusWith f s = jsonStatusHeadersWith f s [("Content-Type", "application/json")] +{-# INLINEABLE jsonStatusWith #-}+ -- | Uses @Json@ as the key in the map, and @"application/javascript"@ as the content type. jsonp :: ( A.ToJSON j          , MonadIO m          ) => j -> FileExtListenerT (MiddlewareT m) m () jsonp = jsonStatusHeaders status200 [("Content-Type", "application/javascript")] +{-# INLINEABLE jsonp #-}+ jsonpWith :: ( A.ToJSON j              , MonadIO m              ) => (Response -> Response) -> j -> FileExtListenerT (MiddlewareT m) m () jsonpWith f = jsonStatusHeadersWith f status200 [("Content-Type", "application/javascript")] +{-# INLINEABLE jsonpWith #-}+ jsonpStatus :: ( A.ToJSON j                , MonadIO m                ) => Status -> j -> FileExtListenerT (MiddlewareT m) m () jsonpStatus s = jsonStatusHeaders s [("Content-Type", "application/javascript")] +{-# INLINEABLE jsonpStatus #-}+ jsonpStatusWith :: ( A.ToJSON j                    , MonadIO m                    ) => (Response -> Response) -> Status -> j                      -> FileExtListenerT (MiddlewareT m) m () jsonpStatusWith f s = jsonStatusHeadersWith f s [("Content-Type", "application/javascript")] +{-# INLINEABLE jsonpStatusWith #-}+ jsonHeaders :: ( A.ToJSON j                , MonadIO m                ) => RequestHeaders -> j                  -> FileExtListenerT (MiddlewareT m) m () jsonHeaders = jsonStatusHeaders status200 +{-# INLINEABLE jsonHeaders #-}+ jsonHeadersWith :: ( A.ToJSON j                    , MonadIO m                    ) => (Response -> Response) -> RequestHeaders -> j                      -> FileExtListenerT (MiddlewareT m) m () jsonHeadersWith f = jsonStatusHeadersWith f status200 +{-# INLINEABLE jsonHeadersWith #-}+ jsonStatusHeaders :: ( A.ToJSON j                      , MonadIO m                      ) => Status -> RequestHeaders -> j                        -> FileExtListenerT (MiddlewareT m) m () jsonStatusHeaders = jsonStatusHeadersWith id +{-# INLINEABLE jsonStatusHeaders #-}+ jsonStatusHeadersWith :: ( A.ToJSON j                          , MonadIO m                          ) => (Response -> Response) -> Status -> RequestHeaders -> j                            -> FileExtListenerT (MiddlewareT m) m ()-jsonStatusHeadersWith f s hs i =-  bytestringStatusWith f Json s hs $ A.encode i+jsonStatusHeadersWith f s hs =+  bytestringStatusWith f Json s hs . A.encode +{-# INLINEABLE jsonStatusHeadersWith #-}   -- * 'Network.Wai.Response' Only@@ -91,23 +114,35 @@             j -> Response jsonOnly = jsonOnlyStatusHeaders status200 [("Content-Type", "application/json")] +{-# INLINEABLE jsonOnly #-}+ jsonOnlyStatus :: A.ToJSON j =>             Status -> j -> Response jsonOnlyStatus s = jsonOnlyStatusHeaders s [("Content-Type", "application/json")] +{-# INLINEABLE jsonOnlyStatus #-}+ jsonpOnly :: A.ToJSON j =>             j -> Response jsonpOnly = jsonOnlyStatusHeaders status200 [("Content-Type", "application/javascript")] +{-# INLINEABLE jsonpOnly #-}+ jsonpOnlyStatus :: A.ToJSON j =>             Status -> j -> Response jsonpOnlyStatus s = jsonOnlyStatusHeaders s [("Content-Type", "application/javascript")] +{-# INLINEABLE jsonpOnlyStatus #-}+ jsonOnlyHeaders :: A.ToJSON j =>             RequestHeaders -> j -> Response jsonOnlyHeaders = jsonOnlyStatusHeaders status200 +{-# INLINEABLE jsonOnlyHeaders #-}+ jsonOnlyStatusHeaders :: A.ToJSON j =>             Status -> RequestHeaders -> j -> Response-jsonOnlyStatusHeaders s hs i =-  bytestringOnlyStatus s hs $ A.encode i+jsonOnlyStatusHeaders s hs =+  bytestringOnlyStatus s hs . A.encode++{-# INLINEABLE jsonOnlyStatusHeaders #-}

@@ -4,7 +4,7 @@  import           Network.Wai.Middleware.ContentType.Types import qualified Network.Wai.Middleware.ContentType.Types as CT-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder import           Network.HTTP.Types                      (RequestHeaders, Status, status200) import           Network.Wai.Trans @@ -53,8 +53,8 @@ juliusStatusHeadersWith :: MonadIO m =>                            (Response -> Response) -> Status -> RequestHeaders -> Javascript                         -> FileExtListenerT (MiddlewareT m) m ()-juliusStatusHeadersWith f s hs i =-  bytestringStatusWith f CT.JavaScript s hs $ LT.encodeUtf8 $ renderJavascript i+juliusStatusHeadersWith f s hs =+  builderStatusWith f CT.JavaScript s hs . LT.encodeUtf8Builder . renderJavascript   -- * 'Network.Wai.Response' Only@@ -69,4 +69,4 @@ juliusOnlyHeaders = juliusOnlyStatusHeaders status200  juliusOnlyStatusHeaders :: Status -> RequestHeaders -> Javascript -> Response-juliusOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderJavascript i+juliusOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderJavascript

@@ -3,7 +3,7 @@ module Network.Wai.Middleware.ContentType.Lucid where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder import           Network.HTTP.Types                      (RequestHeaders, Status, status200) import           Network.Wai.Trans @@ -17,59 +17,83 @@ lucid :: MonadIO m => L.HtmlT m () -> FileExtListenerT (MiddlewareT m) m () lucid = lucidStatusHeaders status200 [("Content-Type", "text/html")] +{-# INLINEABLE lucid #-}+ lucidWith :: MonadIO m =>              (Response -> Response) -> L.HtmlT m ()           -> FileExtListenerT (MiddlewareT m) m () lucidWith f = lucidStatusHeadersWith f status200 [("Content-Type", "text/html")] +{-# INLINEABLE lucidWith #-}+ lucidStatus :: MonadIO m =>                Status -> L.HtmlT m ()             -> FileExtListenerT (MiddlewareT m) m () lucidStatus s = lucidStatusHeaders s [("Content-Type", "text/html")] +{-# INLINEABLE lucidStatus #-}+ lucidStatusWith :: MonadIO m =>                    (Response -> Response) -> Status -> L.HtmlT m ()                 -> FileExtListenerT (MiddlewareT m) m () lucidStatusWith f s = lucidStatusHeadersWith f s [("Content-Type", "text/html")] +{-# INLINEABLE lucidStatusWith #-}+ lucidHeaders :: MonadIO m =>                 RequestHeaders -> L.HtmlT m ()              -> FileExtListenerT (MiddlewareT m) m () lucidHeaders = lucidStatusHeaders status200 +{-# INLINEABLE lucidHeaders #-}+ lucidHeadersWith :: MonadIO m =>                     (Response -> Response) -> RequestHeaders -> L.HtmlT m ()                  -> FileExtListenerT (MiddlewareT m) m () lucidHeadersWith f = lucidStatusHeadersWith f status200 +{-# INLINEABLE lucidHeadersWith #-}+ lucidStatusHeaders :: MonadIO m =>                       Status -> RequestHeaders -> L.HtmlT m ()                    -> FileExtListenerT (MiddlewareT m) m () lucidStatusHeaders = lucidStatusHeadersWith id +{-# INLINEABLE lucidStatusHeaders #-}+ lucidStatusHeadersWith :: MonadIO m =>                           (Response -> Response) -> Status -> RequestHeaders -> L.HtmlT m ()                        -> FileExtListenerT (MiddlewareT m) m () lucidStatusHeadersWith f s hs i = do-  i' <- lift $ L.renderBST i-  bytestringStatusWith f Html s hs i'+  i' <- lift $ L.execHtmlT i+  builderStatusWith f Html s hs i' +{-# INLINEABLE lucidStatusHeadersWith #-}  + -- * 'Network.Wai.Response' Only  lucidOnly :: Monad m =>              L.HtmlT m () -> m Response lucidOnly = lucidOnlyStatusHeaders status200 [("Content-Type", "text/html")] +{-# INLINEABLE lucidOnly #-}+ lucidOnlyStatus :: Monad m =>              Status -> L.HtmlT m () -> m Response lucidOnlyStatus s = lucidOnlyStatusHeaders s [("Content-Type", "text/html")] +{-# INLINEABLE lucidOnlyStatus #-}+ lucidOnlyHeaders :: Monad m =>              RequestHeaders -> L.HtmlT m () -> m Response lucidOnlyHeaders = lucidOnlyStatusHeaders status200 +{-# INLINEABLE lucidOnlyHeaders #-}+ lucidOnlyStatusHeaders :: Monad m =>              Status -> RequestHeaders -> L.HtmlT m () -> m Response-lucidOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs <$> L.renderBST i+lucidOnlyStatusHeaders s hs i = builderOnlyStatus s hs <$> L.execHtmlT i++{-# INLINEABLE lucidOnlyStatusHeaders #-}

@@ -3,7 +3,7 @@ module Network.Wai.Middleware.ContentType.Lucius where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder import           Network.HTTP.Types                      (RequestHeaders, Status, status200) import           Network.Wai.Trans @@ -51,8 +51,8 @@ luciusStatusHeadersWith :: MonadIO m =>                            (Response -> Response) -> Status -> RequestHeaders -> Css                         -> FileExtListenerT (MiddlewareT m) m ()-luciusStatusHeadersWith f s hs i =-  bytestringStatusWith f Css s hs $ LT.encodeUtf8 $ renderCss i+luciusStatusHeadersWith f s hs =+  builderStatusWith f Css s hs . LT.encodeUtf8Builder . renderCss   -- * 'Network.Wai.Response' Only@@ -67,4 +67,4 @@ luciusOnlyHeaders = luciusOnlyStatusHeaders status200  luciusOnlyStatusHeaders :: Status -> RequestHeaders -> Css -> Response-luciusOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderCss i+luciusOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderCss

@@ -2,7 +2,7 @@  import Network.Wai.Middleware.ContentType.Types import Network.Wai.Trans-import qualified Data.Map as Map+import qualified Data.HashMap.Lazy as HM   -- | Lifts a @MiddlewareT@ directly as a response to a file extension.@@ -10,4 +10,6 @@               FileExt            -> MiddlewareT m            -> FileExtListenerT (MiddlewareT m) m ()-middleware f m = tell' $ Map.singleton f m+middleware f m = tell' (HM.singleton f m)++{-# INLINEABLE middleware #-}

@@ -3,7 +3,7 @@ module Network.Wai.Middleware.ContentType.Pandoc where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder import           Network.HTTP.Types                      (RequestHeaders, Status, status200) import           Network.Wai.Trans @@ -52,8 +52,8 @@ markdownStatusHeadersWith :: MonadIO m =>                           (Response -> Response) -> Status -> RequestHeaders -> P.Pandoc                        -> FileExtListenerT (MiddlewareT m) m ()-markdownStatusHeadersWith f s hs i =-  bytestringStatusWith f Markdown s hs . LT.encodeUtf8 . LT.pack $ P.writeMarkdown P.def i+markdownStatusHeadersWith f s hs =+  builderStatusWith f Markdown s hs . LT.encodeUtf8Builder . LT.pack . P.writeMarkdown P.def   -- * 'Network.Wai.Response' Only@@ -68,4 +68,4 @@ markdownOnlyHeaders = markdownOnlyStatusHeaders status200  markdownOnlyStatusHeaders :: Status -> RequestHeaders -> P.Pandoc -> Response-markdownOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs . LT.encodeUtf8 . LT.pack $ P.writeMarkdown P.def i+markdownOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . LT.pack . P.writeMarkdown P.def

@@ -3,7 +3,7 @@ module Network.Wai.Middleware.ContentType.Text where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.ByteString+import           Network.Wai.Middleware.ContentType.Builder import           Network.HTTP.Types                      (RequestHeaders, Status, status200) import           Network.Wai.Trans @@ -18,42 +18,57 @@ text :: MonadIO m => LT.Text -> FileExtListenerT (MiddlewareT m) m () text = textStatusHeaders status200 [("Content-Type", "text/plain")] +{-# INLINEABLE text #-}+ textWith :: MonadIO m =>             (Response -> Response) -> LT.Text          -> FileExtListenerT (MiddlewareT m) m () textWith f = textStatusHeadersWith f status200 [("Content-Type", "text/plain")] +{-# INLINEABLE textWith #-}+ textStatus :: MonadIO m =>               Status -> LT.Text            -> FileExtListenerT (MiddlewareT m) m () textStatus s = textStatusHeaders s [("Content-Type", "text/plain")] +{-# INLINEABLE textStatus #-}+ textStatusWith :: MonadIO m =>                   (Response -> Response) -> Status -> LT.Text                -> FileExtListenerT (MiddlewareT m) m () textStatusWith f s = textStatusHeadersWith f s [("Content-Type", "text/plain")] +{-# INLINEABLE textStatusWith #-}+ textHeaders :: MonadIO m =>                RequestHeaders -> LT.Text             -> FileExtListenerT (MiddlewareT m) m () textHeaders = textStatusHeaders status200 +{-# INLINEABLE textHeaders #-}+ textHeadersWith :: MonadIO m =>                    (Response -> Response) -> RequestHeaders -> LT.Text                 -> FileExtListenerT (MiddlewareT m) m () textHeadersWith f = textStatusHeadersWith f status200 +{-# INLINEABLE textHeadersWith #-}+ textStatusHeaders :: MonadIO m =>                      Status -> RequestHeaders -> LT.Text                   -> FileExtListenerT (MiddlewareT m) m () textStatusHeaders = textStatusHeadersWith id +{-# INLINEABLE textStatusHeaders #-}+ textStatusHeadersWith :: MonadIO m =>                          (Response -> Response) -> Status -> RequestHeaders -> LT.Text                       -> FileExtListenerT (MiddlewareT m) m ()-textStatusHeadersWith f s hs i =-  bytestringStatusWith f Text s hs $ LT.encodeUtf8 i+textStatusHeadersWith f s hs =+  builderStatusWith f Text s hs . LT.encodeUtf8Builder +{-# INLINEABLE textStatusHeadersWith #-}   -- * 'Network.Wai.Response' Only@@ -61,11 +76,19 @@ textOnly :: LT.Text -> Response textOnly = textOnlyStatusHeaders status200 [("Content-Type", "text/plain")] +{-# INLINEABLE textOnly #-}+ textOnlyStatus :: Status -> LT.Text -> Response textOnlyStatus s = textOnlyStatusHeaders s [("Content-Type", "text/plain")] +{-# INLINEABLE textOnlyStatus #-}+ textOnlyHeaders :: RequestHeaders -> LT.Text -> Response textOnlyHeaders = textOnlyStatusHeaders status200 +{-# INLINEABLE textOnlyHeaders #-}+ textOnlyStatusHeaders :: Status -> RequestHeaders -> LT.Text -> Response-textOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 i+textOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder++{-# INLINEABLE textOnlyStatusHeaders #-}

@@ -1,6 +1,7 @@ {-# LANGUAGE     TypeFamilies   , DeriveFunctor+  , DeriveGeneric   , FlexibleContexts   , OverloadedStrings   , FlexibleInstances@@ -35,9 +36,10 @@  import           Network.Wai.Trans import qualified Data.Text              as T-import           Data.Map+import           Data.HashMap.Lazy import           Data.Monoid import           Data.Url+import           Data.Hashable import           Control.Applicative import           Control.Monad.Base import           Control.Monad.Catch@@ -51,39 +53,42 @@ import           Control.Monad.Logger import           Control.Monad.Morph +import           GHC.Generics + -- | Version of 'Control.Monad.Writer.tell' for 'Control.Monad.State.StateT' tell' :: (Monoid w, MonadState w m) => w -> m ()-tell' x = do-  xs <- get-  put $ xs <> x+tell' x = modify' (<> x) +{-# INLINEABLE tell' #-}+ -- | Supported file extensions-data FileExt = Html-             | Css-             | JavaScript-             | Json-             | Text-             | Markdown-             | None-  deriving (Show, Eq, Ord)+data FileExt+  = Html+  | Css+  | JavaScript+  | Json+  | Text+  | Markdown+  deriving (Show, Eq, Ord, Generic) +instance Hashable FileExt+ -- | All file extensions, in the order of likeliness allFileExts :: [FileExt] allFileExts = [Html,Text,Json,JavaScript,Css,Markdown]   -- | Gets the known file extension from a Request's 'Network.Wai.pathInfo'.-getFileExt :: Request -> Maybe FileExt-getFileExt req = case pathInfo req of-  [] -> Just None-  xs -> toExt $ snd $ T.breakOn "." $ last xs+getFileExt :: [T.Text] -> Maybe FileExt+getFileExt chunks = case chunks of+  [] -> Nothing+  xs -> toExt . snd . T.breakOn "." $ last xs  -- | matches a file extension (__including__ it's prefix dot - @.html@ for example) --   to a known one. toExt :: T.Text -> Maybe FileExt-toExt x | x == ""              = Just None-        | x `elem` htmls       = Just Html+toExt x | x `elem` htmls       = Just Html         | x `elem` csss        = Just Css         | x `elem` javascripts = Just JavaScript         | x `elem` jsons       = Just Json@@ -98,7 +103,7 @@     texts       = [".txt"]     markdowns   = [".md", ".markdown"] -type FileExtMap a = Map FileExt a+type FileExtMap a = HashMap FileExt a  -- | The monad for our DSL - when using the combinators, our result will be this --   type:@@ -107,9 +112,9 @@ --   > myListener = do --   >   text "Text!" --   >   json ("Json!" :: T.Text)-newtype FileExtListenerT r m a =-  FileExtListenerT { runFileExtListenerT :: StateT (FileExtMap r) m a }-    deriving ( Functor, Applicative, Alternative, Monad, MonadFix, MonadPlus, MonadIO+newtype FileExtListenerT r m a = FileExtListenerT+  { runFileExtListenerT :: StateT (FileExtMap r) m a+  } deriving ( Functor, Applicative, Alternative, Monad, MonadFix, MonadPlus, MonadIO              , MonadTrans, MonadReader r', MonadWriter w, MonadState (FileExtMap r)              , MonadCont, MonadError e, MonadBase b, MonadThrow, MonadCatch              , MonadMask, MonadLogger, MonadUrl b f, MFunctor

@@ -155,10 +155,6 @@         it "should respond with 406" $         HW.request "GET" "/index.txt" [("Accept", "foo/bar")] "" `shouldRespondWith`         406-      describe "Json with non-file extension" $-        it "should respond with 406" $-        HW.request "GET" "/index.asdf" [("Accept", "application/json")] "" `shouldRespondWith`-        406  app :: Application app = fileExtsToMiddleware allExamples $ \_ resp ->

@@ -1,5 +1,5 @@ Name:                   wai-middleware-content-type-Version:                0.1.0.1+Version:                0.1.1 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -40,8 +40,8 @@                       , blaze-html                       , bytestring                       , clay-                      , containers                       , exceptions+                      , hashable                       , http-media                       , http-types                       , lucid@@ -55,6 +55,7 @@                       , text                       , transformers                       , transformers-base+                      , unordered-containers                       , urlpath >= 5.0.0.1                       , wai                       , wai-transformers >= 0.0.4@@ -88,8 +89,8 @@                       , blaze-html                       , bytestring                       , clay-                      , containers                       , exceptions+                      , hashable                       , hspec                       , hspec-wai                       , http-media@@ -109,6 +110,7 @@                       , transformers                       , transformers-base                       , urlpath+                      , unordered-containers                       , wai                       , wai-transformers                       , wai-util@@ -144,8 +146,8 @@                       , blaze-html                       , bytestring                       , clay-                      , containers                       , exceptions+                      , hashable                       , http-media                       , http-types                       , lucid@@ -160,6 +162,7 @@                       , transformers                       , transformers-base                       , urlpath+                      , unordered-containers                       , wai                       , wai-transformers                       , wai-util