wai-middleware-content-type 0.1.1.1 → 0.2.0

raw patch · 17 files changed

+313/−998 lines, 17 filesdep −wai-utildep ~urlpathdep ~waidep ~wai-transformersPVP ok

version bump matches the API change (PVP)

Dependencies removed: wai-util

Dependency ranges changed: urlpath, wai, wai-transformers

API changes (from Hackage documentation)

Files

• examples/Example.hs +0/−32
• src/Network/Wai/Middleware/ContentType.hs +10/−105
• src/Network/Wai/Middleware/ContentType/Blaze.hs +21/−80
• src/Network/Wai/Middleware/ContentType/Builder.hs +0/−61
• src/Network/Wai/Middleware/ContentType/ByteString.hs +25/−47
• src/Network/Wai/Middleware/ContentType/Cassius.hs +25/−55
• src/Network/Wai/Middleware/ContentType/Clay.hs +24/−81
• src/Network/Wai/Middleware/ContentType/Json.hs +25/−128
• src/Network/Wai/Middleware/ContentType/Julius.hs +24/−57
• src/Network/Wai/Middleware/ContentType/Lucid.hs +27/−79
• src/Network/Wai/Middleware/ContentType/Lucius.hs +20/−53
• src/Network/Wai/Middleware/ContentType/Middleware.hs +0/−15
• src/Network/Wai/Middleware/ContentType/Pandoc.hs +19/−53
• src/Network/Wai/Middleware/ContentType/Text.hs +21/−78
• src/Network/Wai/Middleware/ContentType/Types.hs +51/−2
• test/Network/Wai/Middleware/ContentTypeSpec.hs +20/−11
• wai-middleware-content-type.cabal +1/−61

@@ -1,32 +0,0 @@-{-# LANGUAGE-    OverloadedStrings-  #-}--module Main where--import Network.Wai.Handler.Warp-import Network.Wai.Trans-import Network.Wai.Middleware.ContentType-import Network.HTTP.Types-import qualified Data.Text as T-import qualified Lucid     as L-import Control.Monad.IO.Class---data AppError = AppError--myListener :: MonadIO m => FileExtListenerT (MiddlewareT m) m ()-myListener = do-  text "Text!"-  json ("Json!" :: T.Text)-  lucid (L.toHtmlRaw ("Html!" :: T.Text))--myApp :: MonadIO m => MiddlewareT m-myApp = fileExtsToMiddleware myListener--main :: IO ()-main = run 3000 (myApp defApp)-  where-    defApp :: Application-    defApp _ respond =-      respond $ textOnlyStatus status404 "404"

@@ -11,44 +11,14 @@ Stability   : experimental Portability : GHC -Import this module to use all the application end-point combinators:--> {-# LANGUAGE->     OverloadedStrings->   #-}->-> import Network.Wai.Middleware.ContentType-> import qualified Data.Text as T-> import qualified Lucid as L->-> myApp :: MonadIO m => MiddlewareT-> myApp = fileExtsToMiddleware $ do->   text "Text!"->   json ("Json!" :: T.Text)->   lucid (L.toHtmlRaw ("Html!" :: T.Text))--If you would like to embed a 'Network.Wai.Trans.MiddlewareT' as a response to-a particular supported file extension / content type, import-"Network.Wai.Middleware.ContentType.Middleware":--> import Network.Wai.Middleware.ContentType-> import Network.Wai.Middleware.ContentType.Middleware->-> myApp = fileExtsToMiddleware $->   middleware Css myMiddleware -}  module Network.Wai.Middleware.ContentType-  ( -- * Utilities-    fileExtsToMiddleware-  , lookupResponse-  , possibleFileExts-  , invalidEncoding-  , AcceptHeader+  ( lookupFileExt+   , -- * Re-Exports     module Network.Wai.Middleware.ContentType.Types   , module Network.Wai.Middleware.ContentType.Blaze-  , module Network.Wai.Middleware.ContentType.Builder   , module Network.Wai.Middleware.ContentType.ByteString   , module Network.Wai.Middleware.ContentType.Cassius   , module Network.Wai.Middleware.ContentType.Clay@@ -60,12 +30,8 @@   , module Network.Wai.Middleware.ContentType.Pandoc   ) where -import Network.Wai.Trans-import Network.HTTP.Types (HeaderName)-import Network.HTTP.Media (mapAccept) import Network.Wai.Middleware.ContentType.Types hiding (tell') import Network.Wai.Middleware.ContentType.Blaze-import Network.Wai.Middleware.ContentType.Builder import Network.Wai.Middleware.ContentType.ByteString import Network.Wai.Middleware.ContentType.Cassius import Network.Wai.Middleware.ContentType.Clay@@ -76,86 +42,25 @@ import Network.Wai.Middleware.ContentType.Text import Network.Wai.Middleware.ContentType.Pandoc -import Network.Wai.Middleware.ContentType.Middleware (middleware)+import qualified Network.Wai.Middleware.ContentType.Types as CT -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 import Control.Monad --type AcceptHeader = BS.ByteString---- | Turn a map of content types to middlewares, into a middleware.-fileExtsToMiddleware :: ( MonadIO m-                        ) => FileExtListenerT (MiddlewareT m) m ()-                          -> MiddlewareT m-fileExtsToMiddleware contentRoutes app req respond = do-  let mAcceptBS = Prelude.lookup ("Accept" :: HeaderName) $ requestHeaders req-      mFe       = getFileExt (pathInfo req)-  mMiddleware <- lookupResponse mAcceptBS mFe contentRoutes-  fromMaybe (app req respond) $ do-    mid <- mMiddleware-    pure (mid app req respond)--{-# INLINEABLE fileExtsToMiddleware #-}- -- | Given an HTTP @Accept@ header and a content type to base lookups off of, and -- a map of responses, find a response.-lookupResponse :: ( MonadIO m-                  ) => Maybe AcceptHeader-                    -> Maybe FileExt-                    -> FileExtListenerT (MiddlewareT m) m ()-                    -> m (Maybe (MiddlewareT m))-lookupResponse mAcceptBS mFe fexts =-  lookupFileExt <$> execFileExtListenerT fexts+lookupFileExt :: Maybe AcceptHeader+              -> Maybe FileExt+              -> FileExtMap r+              -> Maybe r+lookupFileExt mAcceptBS mFe fexts =+  getFirst . foldMap (First . flip HM.lookup fexts) . findFE $+    maybe allFileExts possibleFileExts mAcceptBS   where-    lookupFileExt xs =-      let attempts = findFE $ maybe allFileExts possibleFileExts mAcceptBS-      in  getFirst $ foldMap (First . flip HM.lookup xs) attempts-     findFE :: [FileExt] -> [FileExt]     findFE xs =       case mFe of         Nothing -> xs         Just fe -> fe <$ guard (fe `elem` xs) -{-# INLINEABLE lookupResponse #-}---- | 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-  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-                ]--    wildcard :: [FileExt]-    wildcard = fromMaybe [] $ mapAccept [ ("*/*" :: BS.ByteString, allFileExts)-                                        ] accept--{-# INLINEABLE possibleFileExts #-}---- | Use this combinator as the last one, as a "catch-all":------   > myApp = do---   >   text "foo"---   >   invalidEncoding myErrorHandler-invalidEncoding :: MonadIO m => MiddlewareT m -> FileExtListenerT (MiddlewareT m) m ()-invalidEncoding mid = mapM_ (`middleware` mid) allFileExts--{-# INLINEABLE invalidEncoding #-}

@@ -1,96 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Blaze where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.Builder+import           Network.HTTP.Types                      (status200)+import           Network.Wai                             (Response, responseBuilder)+import           Network.Wai.HTTP2                       (Body, streamBuilder) -import           Network.HTTP.Types                      (RequestHeaders,-                                                          Status, status200)-import           Network.Wai.Trans import qualified Text.Blaze.Html                         as H import qualified Text.Blaze.Html.Renderer.Utf8           as H-import           Control.Monad.IO.Class                  (MonadIO)+import qualified Data.HashMap.Lazy                       as HM   -- * Lifted Combinators --- | Uses @Html@ as the key in the map, and @"text/html"@ as the content type.-blaze :: MonadIO m =>-         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 =-  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 #-}+blazeResponse :: Monad m =>+                 H.Html+              -> FileExtListenerT Response m ()+blazeResponse i =+  tell' $ HM.singleton Html (blazeOnlyResponse i) -blazeOnlyHeaders :: RequestHeaders -> H.Html -> Response-blazeOnlyHeaders = blazeOnlyStatusHeaders status200+{-# INLINEABLE blazeResponse #-} -{-# INLINEABLE blazeOnlyHeaders #-}+blazeBody :: Monad m =>+             H.Html+          -> FileExtListenerT Body m ()+blazeBody i =+  tell' $ HM.singleton Html (blazeOnlyBody i) -blazeOnlyStatus :: Status -> H.Html -> Response-blazeOnlyStatus s = blazeOnlyStatusHeaders s [("Content-Type", "text/html")]+{-# INLINEABLE blazeBody #-} -{-# INLINEABLE blazeOnlyStatus #-}+-- * Data Only -blazeOnlyStatusHeaders :: Status -> RequestHeaders -> H.Html -> Response-blazeOnlyStatusHeaders s hs =-  builderOnlyStatus s hs . H.renderHtmlBuilder+blazeOnlyResponse :: H.Html -> Response+blazeOnlyResponse = responseBuilder status200 [] . H.renderHtmlBuilder -{-# INLINEABLE blazeOnlyStatusHeaders #-}+blazeOnlyBody :: H.Html -> Body+blazeOnlyBody = streamBuilder . H.renderHtmlBuilder

@@ -1,61 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Wai.Middleware.ContentType.Builder where--import           Network.Wai.Middleware.ContentType.Types-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans--import qualified Data.ByteString.Builder                 as BU-import qualified Data.HashMap.Lazy                       as HM-import           Control.Monad.IO.Class----- * Lifted Combinators---- | A builder is ambiguous, therefore we require @RequestHeaders@ and a @FileExt@ to be explicitly--- supplied.-builder :: MonadIO m =>-           FileExt -> RequestHeaders -> BU.Builder-        -> 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' $-    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 #-}

@@ -1,63 +1,41 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.ByteString where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.Middleware-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans-import qualified Network.Wai.Util                        as U+import           Network.HTTP.Types                      (status200)+import           Network.Wai                             (Response, responseLBS)+import           Network.Wai.HTTP2                       (Body, streamBuilder) -import qualified Data.ByteString.Lazy                    as B-import           Control.Monad.Trans (lift)-import           Control.Monad.IO.Class+import qualified Data.ByteString.Lazy                    as LBS+import qualified Blaze.ByteString.Builder.ByteString     as BU+import qualified Data.HashMap.Lazy                       as HM   -- * Lifted Combinators --- | @ByteString@ is ambiguous - we need to know what @RequestHeaders@ and @FileExt@ should be associated.-bytestring :: MonadIO m => FileExt -> RequestHeaders -> B.ByteString-           -> 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 #-}+bytestringResponse :: Monad m =>+                      FileExt+                   -> LBS.ByteString+                   -> FileExtListenerT Response m ()+bytestringResponse fe i =+  tell' $ HM.singleton fe (bytestringOnlyResponse i) +{-# INLINEABLE bytestringResponse #-} -bytestringStatusWith :: MonadIO m =>-                        (Response -> Response)-                     -> FileExt-                     -> Status-                     -> RequestHeaders-                     -> B.ByteString-                     -> FileExtListenerT (MiddlewareT m) m ()-bytestringStatusWith f fe s hs i = do-  r <- lift $ U.bytestring s hs i-  middleware fe (\_ _ respond -> respond (f r))+bytestringBody :: Monad m =>+                  FileExt+               -> LBS.ByteString+               -> FileExtListenerT Body m ()+bytestringBody fe i =+  tell' $ HM.singleton fe (bytestringOnlyBody i) -{-# INLINEABLE bytestringStatusWith #-}+{-# INLINEABLE bytestringBody #-}  --- * 'Network.Wai.Response' Only--bytestringOnly :: RequestHeaders -> B.ByteString -> Response-bytestringOnly = bytestringOnlyStatus status200--{-# INLINEABLE bytestringOnly #-}+-- * Data Only  -- | The exact same thing as @Network.Wai.responseLBS@.-bytestringOnlyStatus :: Status -> RequestHeaders -> B.ByteString -> Response-bytestringOnlyStatus = responseLBS+bytestringOnlyResponse :: LBS.ByteString -> Response+bytestringOnlyResponse = responseLBS status200 [] -{-# INLINEABLE bytestringOnlyStatus #-}+bytestringOnlyBody :: LBS.ByteString -> Body+bytestringOnlyBody = streamBuilder . BU.fromLazyByteString

@@ -1,70 +1,40 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Cassius where -import           Network.Wai.Middleware.ContentType.Types as FE-import           Network.Wai.Middleware.ContentType.Builder-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.Wai.Middleware.ContentType.Types as CT+import           Network.Wai.Middleware.ContentType.Text+import           Network.Wai                              (Response)+import           Network.Wai.HTTP2                        (Body)  import           Text.Cassius-import qualified Data.Text.Lazy.Encoding                 as LT-import           Control.Monad.IO.Class                  (MonadIO)+import qualified Data.Text.Lazy.Encoding                  as LT+import qualified Data.HashMap.Lazy                        as HM   -- * Lifted Combinators --- | Uses @cassius@ as the key in the map, and @"cassius/plain"@ as the content type.-cassius :: MonadIO m => Css -> FileExtListenerT (MiddlewareT m) m ()-cassius = cassiusStatusHeaders status200 [("Content-Type", "text/css")]--cassiusWith :: MonadIO m =>-               (Response -> Response) -> Css-            -> FileExtListenerT (MiddlewareT m) m ()-cassiusWith f = cassiusStatusHeadersWith f status200 [("Content-Type", "text/css")]--cassiusStatus :: MonadIO m =>-                 Status -> Css-              -> FileExtListenerT (MiddlewareT m) m ()-cassiusStatus s = cassiusStatusHeaders s [("Content-Type", "text/css")]--cassiusStatusWith :: MonadIO m =>-                     (Response -> Response) -> Status -> Css-                  -> FileExtListenerT (MiddlewareT m) m ()-cassiusStatusWith f s = cassiusStatusHeadersWith f s [("Content-Type", "text/css")]--cassiusHeaders :: MonadIO m =>-                  RequestHeaders -> Css-               -> FileExtListenerT (MiddlewareT m) m ()-cassiusHeaders = cassiusStatusHeaders status200+cassiusResponse :: Monad m =>+                   Css+                -> FileExtListenerT Response m ()+cassiusResponse i =+  tell' $ HM.singleton CT.Css (cassiusOnlyResponse i) -cassiusHeadersWith :: MonadIO m =>-                      (Response -> Response) -> RequestHeaders -> Css-                   -> FileExtListenerT (MiddlewareT m) m ()-cassiusHeadersWith f = cassiusStatusHeadersWith f status200+{-# INLINEABLE cassiusResponse #-} -cassiusStatusHeaders :: MonadIO m =>-                        Status -> RequestHeaders -> Css-                     -> FileExtListenerT (MiddlewareT m) m ()-cassiusStatusHeaders = cassiusStatusHeadersWith id+cassiusBody :: Monad m =>+               Css+            -> FileExtListenerT Body m ()+cassiusBody i =+  tell' $ HM.singleton CT.Css (cassiusOnlyBody i) -cassiusStatusHeadersWith :: MonadIO m =>-                            (Response -> Response) -> Status -> RequestHeaders -> Css-                         -> FileExtListenerT (MiddlewareT m) m ()-cassiusStatusHeadersWith f s hs =-  builderStatusWith f Css s hs . LT.encodeUtf8Builder . renderCss+{-# INLINEABLE cassiusBody #-}  --- * 'Network.Wai.Response' Only--cassiusOnly :: Css -> Response-cassiusOnly = cassiusOnlyStatusHeaders status200 [("Content-Type", "text/css")]--cassiusOnlyStatus :: Status -> Css -> Response-cassiusOnlyStatus s = cassiusOnlyStatusHeaders s [("Content-Type", "text/css")]+-- * Data Only -cassiusOnlyHeaders :: RequestHeaders -> Css -> Response-cassiusOnlyHeaders = cassiusOnlyStatusHeaders status200+cassiusOnlyResponse :: Css -> Response+cassiusOnlyResponse =+  textOnlyResponse . renderCss -cassiusOnlyStatusHeaders :: Status -> RequestHeaders -> Css -> Response-cassiusOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderCss+cassiusOnlyBody :: Css -> Body+cassiusOnlyBody =+  textOnlyBody . renderCss

@@ -1,97 +1,40 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Clay where -import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.Builder-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.Wai.Middleware.ContentType.Types as CT+import           Network.Wai.Middleware.ContentType.Text+import           Network.Wai                              (Response)+import           Network.Wai.HTTP2                        (Body)  import           Clay.Render import           Clay.Stylesheet-import qualified Data.Text.Lazy.Encoding                 as LT-import           Control.Monad.IO.Class                  (MonadIO)+import qualified Data.HashMap.Lazy                        as HM   -- * Lifted Combinators --- | Uses @Text@ as the key in the map, and @"text/css"@ as the content type.-clay :: MonadIO m =>-        Config -> [App] -> Css-     -> 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+clayResponse :: Monad m =>+                Config -> [App] -> Css+             -> FileExtListenerT Response m ()+clayResponse c as i =+  tell' $ HM.singleton CT.Css (clayOnlyResponse c as i) -{-# INLINEABLE clayStatusHeaders #-}+{-# INLINEABLE clayResponse #-} -clayStatusHeadersWith :: MonadIO m =>-                         (Response -> Response) -> Config -> [App] -> Status -> RequestHeaders -> Css-                      -> FileExtListenerT (MiddlewareT m) m ()-clayStatusHeadersWith f c as s hs =-  builderStatusWith f Css s hs . LT.encodeUtf8Builder . renderWith c as+clayBody :: Monad m =>+            Config -> [App] -> Css+         -> FileExtListenerT Body m ()+clayBody c as i =+  tell' $ HM.singleton CT.Css (clayOnlyBody c as i) -{-# INLINEABLE clayStatusHeadersWith #-}+{-# INLINEABLE clayBody #-}  --- * 'Network.Wai.Response' Only--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 #-}+-- * Data Only -clayOnlyStatusHeaders :: Config -> [App] -> Status -> RequestHeaders -> Css -> Response-clayOnlyStatusHeaders c as s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderWith c as+clayOnlyResponse :: Config -> [App] -> Css -> Response+clayOnlyResponse c as =+  textOnlyResponse . renderWith c as -{-# INLINEABLE clayOnlyStatusHeaders #-}+clayOnlyBody :: Config -> [App] -> Css -> Body+clayOnlyBody c as =+  textOnlyBody . renderWith c as

@@ -1,148 +1,45 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Json where  import           Network.Wai.Middleware.ContentType.Types import           Network.Wai.Middleware.ContentType.ByteString-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.Wai                             (Response)+import           Network.Wai.HTTP2                       (Body)  import qualified Data.Aeson                              as A-import           Control.Monad.IO.Class                  (MonadIO)    -- * Lifted Combinators --- | Uses @Json@ as the key in the map, and @"application/json"@ as the content type.-json :: ( A.ToJSON j-        , MonadIO m-        ) => 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+jsonResponse :: ( A.ToJSON j+                , Monad m+                ) => j+                  -> FileExtListenerT Response m ()+jsonResponse =+  bytestringResponse Json . A.encode -{-# INLINEABLE jsonStatusHeaders #-}+{-# INLINEABLE jsonResponse #-} -jsonStatusHeadersWith :: ( A.ToJSON j-                         , MonadIO m-                         ) => (Response -> Response) -> Status -> RequestHeaders -> j-                           -> FileExtListenerT (MiddlewareT m) m ()-jsonStatusHeadersWith f s hs =-  bytestringStatusWith f Json s hs . A.encode+jsonBody :: ( A.ToJSON j+            , Monad m+            ) => j+              -> FileExtListenerT Body m ()+jsonBody =+  bytestringBody Json . A.encode -{-# INLINEABLE jsonStatusHeadersWith #-}+{-# INLINEABLE jsonBody #-}  --- * 'Network.Wai.Response' Only--jsonOnly :: A.ToJSON j =>-            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 #-}+-- * Data Only -jsonOnlyHeaders :: A.ToJSON j =>-            RequestHeaders -> j -> Response-jsonOnlyHeaders = jsonOnlyStatusHeaders status200+jsonOnlyResponse :: A.ToJSON j => j -> Response+jsonOnlyResponse =+  bytestringOnlyResponse . A.encode -{-# INLINEABLE jsonOnlyHeaders #-}+{-# INLINEABLE jsonOnlyResponse #-} -jsonOnlyStatusHeaders :: A.ToJSON j =>-            Status -> RequestHeaders -> j -> Response-jsonOnlyStatusHeaders s hs =-  bytestringOnlyStatus s hs . A.encode+jsonOnlyBody :: A.ToJSON j => j -> Body+jsonOnlyBody =+  bytestringOnlyBody . A.encode -{-# INLINEABLE jsonOnlyStatusHeaders #-}+{-# INLINEABLE jsonOnlyBody #-}

@@ -1,72 +1,39 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Julius where -import           Network.Wai.Middleware.ContentType.Types-import qualified Network.Wai.Middleware.ContentType.Types as CT-import           Network.Wai.Middleware.ContentType.Builder-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.Wai.Middleware.ContentType.Types as CT+import           Network.Wai.Middleware.ContentType.Text+import           Network.Wai                              (Response)+import           Network.Wai.HTTP2                        (Body)  import           Text.Julius-import qualified Data.Text.Lazy.Encoding                 as LT-import           Control.Monad.IO.Class                  (MonadIO)+import qualified Data.HashMap.Lazy                        as HM   -- * Lifted Combinators --- | Uses @julius@ as the key in the map, and @"application/javascript"@ as the content type.-julius :: MonadIO m =>-          Javascript -> FileExtListenerT (MiddlewareT m) m ()-julius = juliusStatusHeaders status200 [("Content-Type", "application/javascript")]--juliusWith :: MonadIO m =>-              (Response -> Response) -> Javascript-           -> FileExtListenerT (MiddlewareT m) m ()-juliusWith f = juliusStatusHeadersWith f status200 [("Content-Type", "application/javascript")]--juliusStatus :: MonadIO m =>-                Status -> Javascript-             -> FileExtListenerT (MiddlewareT m) m ()-juliusStatus s = juliusStatusHeaders s [("Content-Type", "application/javascript")]--juliusStatusWith :: MonadIO m =>-                    (Response -> Response) -> Status -> Javascript-                 -> FileExtListenerT (MiddlewareT m) m ()-juliusStatusWith f s = juliusStatusHeadersWith f s [("Content-Type", "application/javascript")]--juliusHeaders :: MonadIO m =>-                 RequestHeaders -> Javascript-              -> FileExtListenerT (MiddlewareT m) m ()-juliusHeaders = juliusStatusHeaders status200+juliusResponse :: Monad m =>+                  Javascript+               -> FileExtListenerT Response m ()+juliusResponse i =+  tell' $ HM.singleton CT.JavaScript (juliusOnlyResponse i) -juliusHeadersWith :: MonadIO m =>-                     (Response -> Response) -> RequestHeaders -> Javascript-                  -> FileExtListenerT (MiddlewareT m) m ()-juliusHeadersWith f = juliusStatusHeadersWith f status200+{-# INLINEABLE juliusResponse #-} -juliusStatusHeaders :: MonadIO m =>-                       Status -> RequestHeaders -> Javascript-                    -> FileExtListenerT (MiddlewareT m) m ()-juliusStatusHeaders = juliusStatusHeadersWith id+juliusBody :: Monad m =>+              Javascript+           -> FileExtListenerT Body m ()+juliusBody i =+  tell' $ HM.singleton CT.JavaScript (juliusOnlyBody i) -juliusStatusHeadersWith :: MonadIO m =>-                           (Response -> Response) -> Status -> RequestHeaders -> Javascript-                        -> FileExtListenerT (MiddlewareT m) m ()-juliusStatusHeadersWith f s hs =-  builderStatusWith f CT.JavaScript s hs . LT.encodeUtf8Builder . renderJavascript+{-# INLINEABLE juliusBody #-}  --- * 'Network.Wai.Response' Only--juliusOnly :: Javascript -> Response-juliusOnly = juliusOnlyStatusHeaders status200 [("Content-Type", "application/javascript")]--juliusOnlyStatus :: Status -> Javascript -> Response-juliusOnlyStatus s = juliusOnlyStatusHeaders s [("Content-Type", "application/javascript")]+-- * Data Only -juliusOnlyHeaders :: RequestHeaders -> Javascript -> Response-juliusOnlyHeaders = juliusOnlyStatusHeaders status200+juliusOnlyResponse :: Javascript -> Response+juliusOnlyResponse =+  textOnlyResponse . renderJavascript -juliusOnlyStatusHeaders :: Status -> RequestHeaders -> Javascript -> Response-juliusOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderJavascript+juliusOnlyBody :: Javascript -> Body+juliusOnlyBody =+  textOnlyBody . renderJavascript

@@ -1,99 +1,47 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Lucid where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.Builder-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.HTTP.Types                      (status200)+import           Network.Wai                             (Response, responseBuilder)+import           Network.Wai.HTTP2                       (Body, streamBuilder)  import qualified Lucid.Base                              as L import           Control.Monad.Trans+import qualified Data.HashMap.Lazy                       as HM   -- * Lifted Combinators --- | Uses the @Html@ key in the map, and @"text/html"@ as the content type.-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+lucidResponse :: Monad m =>+                 L.HtmlT m ()+              -> FileExtListenerT Response m ()+lucidResponse i = do+  i' <- lift $ lucidOnlyResponse i+  tell' $ HM.singleton Html i' -{-# INLINEABLE lucidStatusHeaders #-}+{-# INLINEABLE lucidResponse #-} -lucidStatusHeadersWith :: MonadIO m =>-                          (Response -> Response) -> Status -> RequestHeaders -> L.HtmlT m ()-                       -> FileExtListenerT (MiddlewareT m) m ()-lucidStatusHeadersWith f s hs i = do-  i' <- lift $ L.execHtmlT i-  builderStatusWith f Html s hs i'+lucidBody :: Monad m =>+             L.HtmlT m ()+          -> FileExtListenerT Body m ()+lucidBody i = do+  i' <- lift $ lucidOnlyBody i+  tell' $ HM.singleton Html i' -{-# INLINEABLE lucidStatusHeadersWith #-}+{-# INLINEABLE lucidBody #-}   --- * '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 #-}+-- * Data Only -lucidOnlyHeaders :: Monad m =>-             RequestHeaders -> L.HtmlT m () -> m Response-lucidOnlyHeaders = lucidOnlyStatusHeaders status200+lucidOnlyResponse :: Monad m => L.HtmlT m () -> m Response+lucidOnlyResponse i =+  responseBuilder status200 [] <$> L.execHtmlT i -{-# INLINEABLE lucidOnlyHeaders #-}+{-# INLINEABLE lucidOnlyResponse #-} -lucidOnlyStatusHeaders :: Monad m =>-             Status -> RequestHeaders -> L.HtmlT m () -> m Response-lucidOnlyStatusHeaders s hs i = builderOnlyStatus s hs <$> L.execHtmlT i+lucidOnlyBody :: Monad m => L.HtmlT m () -> m Body+lucidOnlyBody i =+  streamBuilder <$> L.execHtmlT i -{-# INLINEABLE lucidOnlyStatusHeaders #-}+{-# INLINEABLE lucidOnlyBody #-}

@@ -1,70 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Lucius where -import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.Builder-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.Wai.Middleware.ContentType.Types as CT+import           Network.Wai.Middleware.ContentType.Text+import           Network.Wai                              (Response)+import           Network.Wai.HTTP2                        (Body)  import           Text.Lucius-import qualified Data.Text.Lazy.Encoding                 as LT-import           Control.Monad.IO.Class                  (MonadIO)+import qualified Data.HashMap.Lazy                        as HM   -- * Lifted Combinators --- | Uses @lucius@ as the key in the map, and @"lucius/css"@ as the content type.-lucius :: MonadIO m => Css -> FileExtListenerT (MiddlewareT m) m ()-lucius = luciusStatusHeaders status200 [("Content-Type", "text/css")]+luciusResponse :: Monad m => Css -> FileExtListenerT Response m ()+luciusResponse i =+  tell' $ HM.singleton CT.Css (luciusOnlyResponse i) -luciusWith :: MonadIO m =>-              (Response -> Response) -> Css-           -> FileExtListenerT (MiddlewareT m) m ()-luciusWith f = luciusStatusHeadersWith f status200 [("Content-Type", "text/css")]+{-# INLINEABLE luciusResponse #-} -luciusStatus :: MonadIO m =>-                Status -> Css-             -> FileExtListenerT (MiddlewareT m) m ()-luciusStatus s = luciusStatusHeaders s [("Content-Type", "text/css")]+luciusBody :: Monad m => Css -> FileExtListenerT Body m ()+luciusBody i =+  tell' $ HM.singleton CT.Css (luciusOnlyBody i) -luciusStatusWith :: MonadIO m =>-                    (Response -> Response) -> Status -> Css-                 -> FileExtListenerT (MiddlewareT m) m ()-luciusStatusWith f s = luciusStatusHeadersWith f s [("Content-Type", "text/css")]+{-# INLINEABLE luciusBody #-} -luciusHeaders :: MonadIO m =>-                 RequestHeaders -> Css-              -> FileExtListenerT (MiddlewareT m) m ()-luciusHeaders = luciusStatusHeaders status200 -luciusHeadersWith :: MonadIO m =>-                     (Response -> Response) -> RequestHeaders -> Css-                  -> FileExtListenerT (MiddlewareT m) m ()-luciusHeadersWith f = luciusStatusHeadersWith f status200+-- * Data Only -luciusStatusHeaders :: MonadIO m =>-                       Status -> RequestHeaders -> Css-                    -> FileExtListenerT (MiddlewareT m) m ()-luciusStatusHeaders = luciusStatusHeadersWith id+luciusOnlyResponse :: Css -> Response+luciusOnlyResponse =+  textOnlyResponse . renderCss -luciusStatusHeadersWith :: MonadIO m =>-                           (Response -> Response) -> Status -> RequestHeaders -> Css-                        -> FileExtListenerT (MiddlewareT m) m ()-luciusStatusHeadersWith f s hs =-  builderStatusWith f Css s hs . LT.encodeUtf8Builder . renderCss+luciusOnlyBody :: Css -> Body+luciusOnlyBody =+  textOnlyBody . renderCss  --- * 'Network.Wai.Response' Only--luciusOnly :: Css -> Response-luciusOnly = luciusOnlyStatusHeaders status200 [("Content-Type", "text/css")]--luciusOnlyStatus :: Status -> Css -> Response-luciusOnlyStatus s = luciusOnlyStatusHeaders s [("Content-Type", "text/css")]--luciusOnlyHeaders :: RequestHeaders -> Css -> Response-luciusOnlyHeaders = luciusOnlyStatusHeaders status200--luciusOnlyStatusHeaders :: Status -> RequestHeaders -> Css -> Response-luciusOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . renderCss

@@ -1,15 +0,0 @@-module Network.Wai.Middleware.ContentType.Middleware where--import Network.Wai.Middleware.ContentType.Types-import Network.Wai.Trans-import qualified Data.HashMap.Lazy as HM----- | Lifts a @MiddlewareT@ directly as a response to a file extension.-middleware :: Monad m =>-              FileExt-           -> MiddlewareT m-           -> FileExtListenerT (MiddlewareT m) m ()-middleware f m = tell' (HM.singleton f m)--{-# INLINEABLE middleware #-}

@@ -1,71 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Pandoc where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.Builder-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.Wai.Middleware.ContentType.Text+import           Network.Wai                              (Response)+import           Network.Wai.HTTP2                        (Body)  import qualified Data.Text.Lazy                           as LT-import qualified Data.Text.Lazy.Encoding                  as LT import qualified Text.Pandoc                              as P-import           Control.Monad.Trans+import qualified Data.HashMap.Lazy                        as HM   -- * Lifted Combinators --- | Uses the @Html@ key in the map, and @"text/html"@ as the content type.-markdown :: MonadIO m => P.Pandoc -> FileExtListenerT (MiddlewareT m) m ()-markdown = markdownStatusHeaders status200 [("Content-Type", "text/markdown")]--markdownWith :: MonadIO m =>-             (Response -> Response) -> P.Pandoc-          -> FileExtListenerT (MiddlewareT m) m ()-markdownWith f = markdownStatusHeadersWith f status200 [("Content-Type", "text/markdown")]--markdownStatus :: MonadIO m =>-               Status -> P.Pandoc-            -> FileExtListenerT (MiddlewareT m) m ()-markdownStatus s = markdownStatusHeaders s [("Content-Type", "text/markdown")]--markdownStatusWith :: MonadIO m =>-                   (Response -> Response) -> Status -> P.Pandoc-                -> FileExtListenerT (MiddlewareT m) m ()-markdownStatusWith f s = markdownStatusHeadersWith f s [("Content-Type", "text/markdown")]--markdownHeaders :: MonadIO m =>-                RequestHeaders -> P.Pandoc-             -> FileExtListenerT (MiddlewareT m) m ()-markdownHeaders = markdownStatusHeaders status200+markdownResponse :: Monad m => P.Pandoc -> FileExtListenerT Response m ()+markdownResponse i =+  tell' $ HM.singleton Markdown (markdownOnlyResponse i) -markdownHeadersWith :: MonadIO m =>-                    (Response -> Response) -> RequestHeaders -> P.Pandoc-                 -> FileExtListenerT (MiddlewareT m) m ()-markdownHeadersWith f = markdownStatusHeadersWith f status200+{-# INLINEABLE markdownResponse #-} -markdownStatusHeaders :: MonadIO m =>-                      Status -> RequestHeaders -> P.Pandoc-                   -> FileExtListenerT (MiddlewareT m) m ()-markdownStatusHeaders = markdownStatusHeadersWith id+markdownBody :: Monad m => P.Pandoc -> FileExtListenerT Body m ()+markdownBody i =+  tell' $ HM.singleton Markdown (markdownOnlyBody i) -markdownStatusHeadersWith :: MonadIO m =>-                          (Response -> Response) -> Status -> RequestHeaders -> P.Pandoc-                       -> FileExtListenerT (MiddlewareT m) m ()-markdownStatusHeadersWith f s hs =-  builderStatusWith f Markdown s hs . LT.encodeUtf8Builder . LT.pack . P.writeMarkdown P.def+{-# INLINEABLE markdownBody #-}  --- * 'Network.Wai.Response' Only--markdownOnly :: P.Pandoc -> Response-markdownOnly = markdownOnlyStatusHeaders status200 [("Content-Type", "text/markdown")]+-- * Data Only -markdownOnlyStatus :: Status -> P.Pandoc -> Response-markdownOnlyStatus s = markdownOnlyStatusHeaders s [("Content-Type", "text/markdown")]+markdownOnlyResponse :: P.Pandoc -> Response+markdownOnlyResponse =+  textOnlyResponse . LT.pack . P.writeMarkdown P.def -markdownOnlyHeaders :: RequestHeaders -> P.Pandoc -> Response-markdownOnlyHeaders = markdownOnlyStatusHeaders status200+markdownOnlyBody :: P.Pandoc -> Body+markdownOnlyBody =+  textOnlyBody . LT.pack . P.writeMarkdown P.def -markdownOnlyStatusHeaders :: Status -> RequestHeaders -> P.Pandoc -> Response-markdownOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder . LT.pack . P.writeMarkdown P.def

@@ -1,94 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Wai.Middleware.ContentType.Text where  import           Network.Wai.Middleware.ContentType.Types-import           Network.Wai.Middleware.ContentType.Builder-import           Network.HTTP.Types                      (RequestHeaders, Status, status200)-import           Network.Wai.Trans+import           Network.HTTP.Types                       (status200)+import           Network.Wai                              (Response, responseBuilder)+import           Network.Wai.HTTP2                        (Body, streamBuilder) -import qualified Data.Text.Lazy                          as LT-import qualified Data.Text.Lazy.Encoding                 as LT-import           Control.Monad.IO.Class                  (MonadIO)+import qualified Data.Text.Lazy                           as LT+import qualified Data.Text.Lazy.Encoding                  as LT+import qualified Data.HashMap.Lazy                        as HM   -- * Lifted Combinators --- | Uses @Text@ as the key in the map, and @"text/plain"@ as the content type.-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+textResponse :: Monad m => LT.Text -> FileExtListenerT Response m ()+textResponse i =+  tell' $ HM.singleton Text (textOnlyResponse i) -{-# INLINEABLE textStatusHeaders #-}+{-# INLINEABLE textResponse #-} -textStatusHeadersWith :: MonadIO m =>-                         (Response -> Response) -> Status -> RequestHeaders -> LT.Text-                      -> FileExtListenerT (MiddlewareT m) m ()-textStatusHeadersWith f s hs =-  builderStatusWith f Text s hs . LT.encodeUtf8Builder+textBody :: Monad m => LT.Text -> FileExtListenerT Body m ()+textBody i =+  tell' $ HM.singleton Text (textOnlyBody i) -{-# INLINEABLE textStatusHeadersWith #-}+{-# INLINEABLE textBody #-}  --- * 'Network.Wai.Response' Only--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+-- * Data Only -{-# INLINEABLE textOnlyHeaders #-}+textOnlyResponse :: LT.Text -> Response+textOnlyResponse =+  responseBuilder status200 [] . LT.encodeUtf8Builder -textOnlyStatusHeaders :: Status -> RequestHeaders -> LT.Text -> Response-textOnlyStatusHeaders s hs = builderOnlyStatus s hs . LT.encodeUtf8Builder+textOnlyBody :: LT.Text -> Body+textOnlyBody =+  streamBuilder . LT.encodeUtf8Builder -{-# INLINEABLE textOnlyStatusHeaders #-}

@@ -32,14 +32,19 @@   , execFileExtListenerT   , -- * Utilities     tell'+  , AcceptHeader+  , possibleFileExts+  , invalidEncoding   ) where -import           Network.Wai.Trans import qualified Data.Text              as T-import           Data.HashMap.Lazy+import           Data.HashMap.Lazy hiding (null)+import qualified Data.HashMap.Lazy as HM import           Data.Monoid+import           Data.Maybe (fromMaybe, catMaybes) import           Data.Url import           Data.Hashable+import qualified Data.ByteString        as BS import           Control.Applicative import           Control.Monad.Base import           Control.Monad.Catch@@ -54,6 +59,7 @@ import           Control.Monad.Morph  import           GHC.Generics+import           Network.HTTP.Media (mapAccept)   -- | Version of 'Control.Monad.Writer.tell' for 'Control.Monad.State.StateT'@@ -142,4 +148,47 @@ execFileExtListenerT :: Monad m => FileExtListenerT r m a -> m (FileExtMap r) execFileExtListenerT xs = execStateT (runFileExtListenerT xs) mempty +++-- * Headers++type AcceptHeader = BS.ByteString++ {-# INLINEABLE execFileExtListenerT #-}++-- | 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+  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+                ]++    wildcard :: [FileExt]+    wildcard = fromMaybe [] $ mapAccept [ ("*/*" :: BS.ByteString, allFileExts)+                                        ] accept++{-# INLINEABLE possibleFileExts #-}++-- | Use this combinator as the last one, as a "catch-all":+--+--   > myApp = do+--   >   text "foo"+--   >   invalidEncoding myErrorHandler -- handles all except text/plain+invalidEncoding :: Monad m => r -> FileExtListenerT r m ()+invalidEncoding r = mapM_ (\t -> tell' $ HM.singleton t r) allFileExts++{-# INLINEABLE invalidEncoding #-}

@@ -7,6 +7,7 @@  import Network.Wai.Middleware.ContentType import Network.Wai.Trans+import Network.Wai.Internal import Network.HTTP.Types import qualified Data.Text      as T import qualified Data.Text.Lazy as LT@@ -157,16 +158,24 @@         406  app :: Application-app = fileExtsToMiddleware allExamples $ \_ resp ->-  resp $ textOnlyStatus status406 "Something went wrong"+app req respond = do+  xs <- execFileExtListenerT allExamples+  let mAcceptHeader = lookup "Accept" (requestHeaders req)+      mFileExt      = getFileExt (pathInfo req)+  respond $+    case lookupFileExt mAcceptHeader mFileExt xs of+      Nothing -> let (ResponseBuilder s h r) = textOnlyResponse "Something went wrong"+                 in (ResponseBuilder status406 [] r)+      Just r  -> r -allExamples :: FileExtListenerT Middleware IO ()+allExamples :: FileExtListenerT Response IO () allExamples = do-  text "Text!"-  json ("Json!" :: T.Text)-  lucid (L.toHtmlRaw ("Html!" :: T.Text))-  cassius ([SL.lucius|body {background: #fff;}|] undefined)-  julius  ([SJ.julius|function foo () {return;}|] undefined)-  markdown $ case P.readMarkdown P.def "*Pandoc*!" of-               Left e -> error $ show e-               Right p -> p+  textResponse "Text!"+  jsonResponse ("Json!" :: T.Text)+  lucidResponse (L.toHtmlRaw ("Html!" :: T.Text))+  cassiusResponse ([SL.lucius|body {background: #fff;}|] undefined)+  juliusResponse  ([SJ.julius|function foo () {return;}|] undefined)+  markdownResponse $+    case P.readMarkdown P.def "*Pandoc*!" of+      Left e -> error $ show e+      Right p -> p

@@ -1,5 +1,5 @@ Name:                   wai-middleware-content-type-Version:                0.1.1.1+Version:                0.2.0 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -23,7 +23,6 @@   Exposed-Modules:      Network.Wai.Middleware.ContentType                         Network.Wai.Middleware.ContentType.Types                         Network.Wai.Middleware.ContentType.Blaze-                        Network.Wai.Middleware.ContentType.Builder                         Network.Wai.Middleware.ContentType.ByteString                         Network.Wai.Middleware.ContentType.Cassius                         Network.Wai.Middleware.ContentType.Clay@@ -33,7 +32,6 @@                         Network.Wai.Middleware.ContentType.Lucius                         Network.Wai.Middleware.ContentType.Pandoc                         Network.Wai.Middleware.ContentType.Text-                        Network.Wai.Middleware.ContentType.Middleware   Build-Depends:        base >= 4.8 && < 5                       , aeson                       , blaze-builder@@ -58,8 +56,6 @@                       , unordered-containers                       , urlpath >= 5.0.0.1                       , wai-                      , wai-transformers >= 0.0.4-                      , wai-util  Test-Suite test   Type:                 exitcode-stdio-1.0@@ -71,7 +67,6 @@   Other-Modules:        Network.Wai.Middleware.ContentType                         Network.Wai.Middleware.ContentType.Types                         Network.Wai.Middleware.ContentType.Blaze-                        Network.Wai.Middleware.ContentType.Builder                         Network.Wai.Middleware.ContentType.ByteString                         Network.Wai.Middleware.ContentType.Cassius                         Network.Wai.Middleware.ContentType.Clay@@ -81,7 +76,6 @@                         Network.Wai.Middleware.ContentType.Lucius                         Network.Wai.Middleware.ContentType.Pandoc                         Network.Wai.Middleware.ContentType.Text-                        Network.Wai.Middleware.ContentType.Middleware                         Network.Wai.Middleware.ContentTypeSpec   Build-Depends:        base >= 4.8 && < 5                       , aeson@@ -113,61 +107,7 @@                       , unordered-containers                       , wai                       , wai-transformers-                      , wai-util                       , warp--Executable example-  if flag(Example)-    Buildable: True-  else-    Buildable: False-  Default-Language:     Haskell2010-  HS-Source-Dirs:       src-                      , examples-  GHC-Options:          -Wall -threaded-  Main-Is:              Example.hs-  Other-Modules:        Network.Wai.Middleware.ContentType-                        Network.Wai.Middleware.ContentType.Types-                        Network.Wai.Middleware.ContentType.Blaze-                        Network.Wai.Middleware.ContentType.Builder-                        Network.Wai.Middleware.ContentType.ByteString-                        Network.Wai.Middleware.ContentType.Cassius-                        Network.Wai.Middleware.ContentType.Clay-                        Network.Wai.Middleware.ContentType.Json-                        Network.Wai.Middleware.ContentType.Julius-                        Network.Wai.Middleware.ContentType.Lucid-                        Network.Wai.Middleware.ContentType.Lucius-                        Network.Wai.Middleware.ContentType.Pandoc-                        Network.Wai.Middleware.ContentType.Text-                        Network.Wai.Middleware.ContentType.Middleware-  Build-Depends:        base >= 4.8 && < 5-                      , aeson-                      , blaze-builder-                      , blaze-html-                      , bytestring-                      , clay-                      , exceptions-                      , hashable-                      , http-media-                      , http-types-                      , lucid-                      , mmorph-                      , monad-control-                      , monad-logger-                      , mtl-                      , pandoc-                      , resourcet-                      , shakespeare-                      , text-                      , transformers-                      , transformers-base-                      , urlpath-                      , unordered-containers-                      , wai-                      , wai-transformers-                      , wai-util-                      , warp-   Source-Repository head