wai-middleware-content-type 0.2.0 → 0.2.1
raw patch · 13 files changed
+94/−229 lines, 13 filesdep ~wai
Dependency ranges changed: wai
Files
- src/Network/Wai/Middleware/ContentType.hs +0/−2
- src/Network/Wai/Middleware/ContentType/Blaze.hs +8/−19
- src/Network/Wai/Middleware/ContentType/ByteString.hs +9/−22
- src/Network/Wai/Middleware/ContentType/Cassius.hs +9/−22
- src/Network/Wai/Middleware/ContentType/Clay.hs +9/−22
- src/Network/Wai/Middleware/ContentType/Json.hs +11/−28
- src/Network/Wai/Middleware/ContentType/Julius.hs +9/−22
- src/Network/Wai/Middleware/ContentType/Lucid.hs +10/−27
- src/Network/Wai/Middleware/ContentType/Lucius.hs +7/−20
- src/Network/Wai/Middleware/ContentType/Pandoc.hs +7/−19
- src/Network/Wai/Middleware/ContentType/Text.hs +6/−17
- test/Network/Wai/Middleware/ContentTypeSpec.hs +7/−7
- wai-middleware-content-type.cabal +2/−2
src/Network/Wai/Middleware/ContentType.hs view
@@ -42,8 +42,6 @@ import Network.Wai.Middleware.ContentType.Text import Network.Wai.Middleware.ContentType.Pandoc -import qualified Network.Wai.Middleware.ContentType.Types as CT- import qualified Data.HashMap.Lazy as HM import Data.Monoid import Control.Monad
src/Network/Wai/Middleware/ContentType/Blaze.hs view
@@ -3,7 +3,6 @@ import Network.Wai.Middleware.ContentType.Types import Network.HTTP.Types (status200) import Network.Wai (Response, responseBuilder)-import Network.Wai.HTTP2 (Body, streamBuilder) import qualified Text.Blaze.Html as H import qualified Text.Blaze.Html.Renderer.Utf8 as H@@ -12,26 +11,16 @@ -- * Lifted Combinators -blazeResponse :: Monad m =>- H.Html- -> FileExtListenerT Response m ()-blazeResponse i =- tell' $ HM.singleton Html (blazeOnlyResponse i)--{-# INLINEABLE blazeResponse #-}--blazeBody :: Monad m =>- H.Html- -> FileExtListenerT Body m ()-blazeBody i =- tell' $ HM.singleton Html (blazeOnlyBody i)+blaze :: Monad m =>+ H.Html+ -> FileExtListenerT Response m ()+blaze i =+ tell' $ HM.singleton Html (blazeOnly i) -{-# INLINEABLE blazeBody #-}+{-# INLINEABLE blaze #-} -- * Data Only -blazeOnlyResponse :: H.Html -> Response-blazeOnlyResponse = responseBuilder status200 [] . H.renderHtmlBuilder+blazeOnly :: H.Html -> Response+blazeOnly = responseBuilder status200 [] . H.renderHtmlBuilder -blazeOnlyBody :: H.Html -> Body-blazeOnlyBody = streamBuilder . H.renderHtmlBuilder
src/Network/Wai/Middleware/ContentType/ByteString.hs view
@@ -3,7 +3,6 @@ import Network.Wai.Middleware.ContentType.Types import Network.HTTP.Types (status200) import Network.Wai (Response, responseLBS)-import Network.Wai.HTTP2 (Body, streamBuilder) import qualified Data.ByteString.Lazy as LBS import qualified Blaze.ByteString.Builder.ByteString as BU@@ -12,30 +11,18 @@ -- * Lifted Combinators -bytestringResponse :: Monad m =>- FileExt- -> LBS.ByteString- -> FileExtListenerT Response m ()-bytestringResponse fe i =- tell' $ HM.singleton fe (bytestringOnlyResponse i)--{-# INLINEABLE bytestringResponse #-}--bytestringBody :: Monad m =>- FileExt- -> LBS.ByteString- -> FileExtListenerT Body m ()-bytestringBody fe i =- tell' $ HM.singleton fe (bytestringOnlyBody i)+bytestring :: Monad m =>+ FileExt+ -> LBS.ByteString+ -> FileExtListenerT Response m ()+bytestring fe i =+ tell' $ HM.singleton fe (bytestringOnly i) -{-# INLINEABLE bytestringBody #-}+{-# INLINEABLE bytestring #-} -- * Data Only -- | The exact same thing as @Network.Wai.responseLBS@.-bytestringOnlyResponse :: LBS.ByteString -> Response-bytestringOnlyResponse = responseLBS status200 []--bytestringOnlyBody :: LBS.ByteString -> Body-bytestringOnlyBody = streamBuilder . BU.fromLazyByteString+bytestringOnly :: LBS.ByteString -> Response+bytestringOnly = responseLBS status200 []
src/Network/Wai/Middleware/ContentType/Cassius.hs view
@@ -3,7 +3,6 @@ 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@@ -12,29 +11,17 @@ -- * Lifted Combinators -cassiusResponse :: Monad m =>- Css- -> FileExtListenerT Response m ()-cassiusResponse i =- tell' $ HM.singleton CT.Css (cassiusOnlyResponse i)--{-# INLINEABLE cassiusResponse #-}--cassiusBody :: Monad m =>- Css- -> FileExtListenerT Body m ()-cassiusBody i =- tell' $ HM.singleton CT.Css (cassiusOnlyBody i)+cassius :: Monad m =>+ Css+ -> FileExtListenerT Response m ()+cassius i =+ tell' $ HM.singleton CT.Css (cassiusOnly i) -{-# INLINEABLE cassiusBody #-}+{-# INLINEABLE cassius #-} -- * Data Only -cassiusOnlyResponse :: Css -> Response-cassiusOnlyResponse =- textOnlyResponse . renderCss--cassiusOnlyBody :: Css -> Body-cassiusOnlyBody =- textOnlyBody . renderCss+cassiusOnly :: Css -> Response+cassiusOnly =+ textOnly . renderCss
src/Network/Wai/Middleware/ContentType/Clay.hs view
@@ -3,7 +3,6 @@ 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@@ -12,29 +11,17 @@ -- * Lifted Combinators -clayResponse :: Monad m =>- Config -> [App] -> Css- -> FileExtListenerT Response m ()-clayResponse c as i =- tell' $ HM.singleton CT.Css (clayOnlyResponse c as i)--{-# INLINEABLE clayResponse #-}--clayBody :: Monad m =>- Config -> [App] -> Css- -> FileExtListenerT Body m ()-clayBody c as i =- tell' $ HM.singleton CT.Css (clayOnlyBody c as i)+clay :: Monad m =>+ Config -> [App] -> Css+ -> FileExtListenerT Response m ()+clay c as i =+ tell' $ HM.singleton CT.Css (clayOnly c as i) -{-# INLINEABLE clayBody #-}+{-# INLINEABLE clay #-} -- * Data Only -clayOnlyResponse :: Config -> [App] -> Css -> Response-clayOnlyResponse c as =- textOnlyResponse . renderWith c as--clayOnlyBody :: Config -> [App] -> Css -> Body-clayOnlyBody c as =- textOnlyBody . renderWith c as+clayOnly :: Config -> [App] -> Css -> Response+clayOnly c as =+ textOnly . renderWith c as
src/Network/Wai/Middleware/ContentType/Json.hs view
@@ -3,7 +3,6 @@ import Network.Wai.Middleware.ContentType.Types import Network.Wai.Middleware.ContentType.ByteString import Network.Wai (Response)-import Network.Wai.HTTP2 (Body) import qualified Data.Aeson as A @@ -11,35 +10,19 @@ -- * Lifted Combinators -jsonResponse :: ( A.ToJSON j- , Monad m- ) => j- -> FileExtListenerT Response m ()-jsonResponse =- bytestringResponse Json . A.encode--{-# INLINEABLE jsonResponse #-}--jsonBody :: ( A.ToJSON j- , Monad m- ) => j- -> FileExtListenerT Body m ()-jsonBody =- bytestringBody Json . A.encode--{-# INLINEABLE jsonBody #-}+json :: ( A.ToJSON j+ , Monad m+ ) => j+ -> FileExtListenerT Response m ()+json =+ bytestring Json . A.encode +{-# INLINEABLE json #-} -- * Data Only -jsonOnlyResponse :: A.ToJSON j => j -> Response-jsonOnlyResponse =- bytestringOnlyResponse . A.encode--{-# INLINEABLE jsonOnlyResponse #-}--jsonOnlyBody :: A.ToJSON j => j -> Body-jsonOnlyBody =- bytestringOnlyBody . A.encode+jsonOnly :: A.ToJSON j => j -> Response+jsonOnly =+ bytestringOnly . A.encode -{-# INLINEABLE jsonOnlyBody #-}+{-# INLINEABLE jsonOnly #-}
src/Network/Wai/Middleware/ContentType/Julius.hs view
@@ -3,7 +3,6 @@ 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.HashMap.Lazy as HM@@ -11,29 +10,17 @@ -- * Lifted Combinators -juliusResponse :: Monad m =>- Javascript- -> FileExtListenerT Response m ()-juliusResponse i =- tell' $ HM.singleton CT.JavaScript (juliusOnlyResponse i)--{-# INLINEABLE juliusResponse #-}--juliusBody :: Monad m =>- Javascript- -> FileExtListenerT Body m ()-juliusBody i =- tell' $ HM.singleton CT.JavaScript (juliusOnlyBody i)+julius :: Monad m =>+ Javascript+ -> FileExtListenerT Response m ()+julius i =+ tell' $ HM.singleton CT.JavaScript (juliusOnly i) -{-# INLINEABLE juliusBody #-}+{-# INLINEABLE julius #-} -- * Data Only -juliusOnlyResponse :: Javascript -> Response-juliusOnlyResponse =- textOnlyResponse . renderJavascript--juliusOnlyBody :: Javascript -> Body-juliusOnlyBody =- textOnlyBody . renderJavascript+juliusOnly :: Javascript -> Response+juliusOnly =+ textOnly . renderJavascript
src/Network/Wai/Middleware/ContentType/Lucid.hs view
@@ -3,7 +3,6 @@ import Network.Wai.Middleware.ContentType.Types 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@@ -12,36 +11,20 @@ -- * Lifted Combinators -lucidResponse :: Monad m =>- L.HtmlT m ()- -> FileExtListenerT Response m ()-lucidResponse i = do- i' <- lift $ lucidOnlyResponse i- tell' $ HM.singleton Html i'--{-# INLINEABLE lucidResponse #-}--lucidBody :: Monad m =>- L.HtmlT m ()- -> FileExtListenerT Body m ()-lucidBody i = do- i' <- lift $ lucidOnlyBody i- tell' $ HM.singleton Html i'--{-# INLINEABLE lucidBody #-}+lucid :: Monad m =>+ L.HtmlT m ()+ -> FileExtListenerT Response m ()+lucid i = do+ i' <- lift (lucidOnly i)+ tell' (HM.singleton Html i') +{-# INLINEABLE lucid #-} -- * Data Only -lucidOnlyResponse :: Monad m => L.HtmlT m () -> m Response-lucidOnlyResponse i =+lucidOnly :: Monad m => L.HtmlT m () -> m Response+lucidOnly i = responseBuilder status200 [] <$> L.execHtmlT i -{-# INLINEABLE lucidOnlyResponse #-}--lucidOnlyBody :: Monad m => L.HtmlT m () -> m Body-lucidOnlyBody i =- streamBuilder <$> L.execHtmlT i--{-# INLINEABLE lucidOnlyBody #-}+{-# INLINEABLE lucidOnly #-}
src/Network/Wai/Middleware/ContentType/Lucius.hs view
@@ -3,7 +3,6 @@ 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.HashMap.Lazy as HM@@ -11,27 +10,15 @@ -- * Lifted Combinators -luciusResponse :: Monad m => Css -> FileExtListenerT Response m ()-luciusResponse i =- tell' $ HM.singleton CT.Css (luciusOnlyResponse i)--{-# INLINEABLE luciusResponse #-}--luciusBody :: Monad m => Css -> FileExtListenerT Body m ()-luciusBody i =- tell' $ HM.singleton CT.Css (luciusOnlyBody i)+lucius :: Monad m => Css -> FileExtListenerT Response m ()+lucius i =+ tell' $ HM.singleton CT.Css (luciusOnly i) -{-# INLINEABLE luciusBody #-}+{-# INLINEABLE lucius #-} -- * Data Only -luciusOnlyResponse :: Css -> Response-luciusOnlyResponse =- textOnlyResponse . renderCss--luciusOnlyBody :: Css -> Body-luciusOnlyBody =- textOnlyBody . renderCss--+luciusOnly :: Css -> Response+luciusOnly =+ textOnly . renderCss
src/Network/Wai/Middleware/ContentType/Pandoc.hs view
@@ -3,7 +3,6 @@ import Network.Wai.Middleware.ContentType.Types import Network.Wai.Middleware.ContentType.Text import Network.Wai (Response)-import Network.Wai.HTTP2 (Body) import qualified Data.Text.Lazy as LT import qualified Text.Pandoc as P@@ -12,26 +11,15 @@ -- * Lifted Combinators -markdownResponse :: Monad m => P.Pandoc -> FileExtListenerT Response m ()-markdownResponse i =- tell' $ HM.singleton Markdown (markdownOnlyResponse i)--{-# INLINEABLE markdownResponse #-}--markdownBody :: Monad m => P.Pandoc -> FileExtListenerT Body m ()-markdownBody i =- tell' $ HM.singleton Markdown (markdownOnlyBody i)+markdown :: Monad m => P.Pandoc -> FileExtListenerT Response m ()+markdown i =+ tell' $ HM.singleton Markdown (markdownOnly i) -{-# INLINEABLE markdownBody #-}+{-# INLINEABLE markdown #-} -- * Data Only -markdownOnlyResponse :: P.Pandoc -> Response-markdownOnlyResponse =- textOnlyResponse . LT.pack . P.writeMarkdown P.def--markdownOnlyBody :: P.Pandoc -> Body-markdownOnlyBody =- textOnlyBody . LT.pack . P.writeMarkdown P.def-+markdownOnly :: P.Pandoc -> Response+markdownOnly =+ textOnly . LT.pack . P.writeMarkdown P.def
src/Network/Wai/Middleware/ContentType/Text.hs view
@@ -3,7 +3,6 @@ import Network.Wai.Middleware.ContentType.Types 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@@ -12,26 +11,16 @@ -- * Lifted Combinators -textResponse :: Monad m => LT.Text -> FileExtListenerT Response m ()-textResponse i =- tell' $ HM.singleton Text (textOnlyResponse i)--{-# INLINEABLE textResponse #-}--textBody :: Monad m => LT.Text -> FileExtListenerT Body m ()-textBody i =- tell' $ HM.singleton Text (textOnlyBody i)+text :: Monad m => LT.Text -> FileExtListenerT Response m ()+text i =+ tell' $ HM.singleton Text (textOnly i) -{-# INLINEABLE textBody #-}+{-# INLINEABLE text #-} -- * Data Only -textOnlyResponse :: LT.Text -> Response-textOnlyResponse =+textOnly :: LT.Text -> Response+textOnly = responseBuilder status200 [] . LT.encodeUtf8Builder--textOnlyBody :: LT.Text -> Body-textOnlyBody =- streamBuilder . LT.encodeUtf8Builder
test/Network/Wai/Middleware/ContentTypeSpec.hs view
@@ -164,18 +164,18 @@ mFileExt = getFileExt (pathInfo req) respond $ case lookupFileExt mAcceptHeader mFileExt xs of- Nothing -> let (ResponseBuilder s h r) = textOnlyResponse "Something went wrong"+ Nothing -> let (ResponseBuilder s h r) = textOnly "Something went wrong" in (ResponseBuilder status406 [] r) Just r -> r allExamples :: FileExtListenerT Response IO () allExamples = do- 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 $+ 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
wai-middleware-content-type.cabal view
@@ -1,5 +1,5 @@ Name: wai-middleware-content-type-Version: 0.2.0+Version: 0.2.1 Author: Athan Clark <athan.clark@gmail.com> Maintainer: Athan Clark <athan.clark@gmail.com> License: BSD3@@ -55,7 +55,7 @@ , transformers-base , unordered-containers , urlpath >= 5.0.0.1- , wai+ , wai >= 3.2 Test-Suite test Type: exitcode-stdio-1.0