wai-middleware-content-type 0.2.1 → 0.3.0

raw patch · 14 files changed

+87/−53 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Network/Wai/Middleware/ContentType.hs +11/−0
• src/Network/Wai/Middleware/ContentType/Blaze.hs +4/−4
• src/Network/Wai/Middleware/ContentType/ByteString.hs +4/−4
• src/Network/Wai/Middleware/ContentType/Cassius.hs +5/−5
• src/Network/Wai/Middleware/ContentType/Clay.hs +5/−4
• src/Network/Wai/Middleware/ContentType/Json.hs +5/−4
• src/Network/Wai/Middleware/ContentType/Julius.hs +5/−4
• src/Network/Wai/Middleware/ContentType/Lucid.hs +4/−4
• src/Network/Wai/Middleware/ContentType/Lucius.hs +7/−4
• src/Network/Wai/Middleware/ContentType/Pandoc.hs +7/−4
• src/Network/Wai/Middleware/ContentType/Text.hs +7/−5
• src/Network/Wai/Middleware/ContentType/Types.hs +17/−0
• test/Network/Wai/Middleware/ContentTypeSpec.hs +4/−10
• wai-middleware-content-type.cabal +2/−1

@@ -15,6 +15,7 @@  module Network.Wai.Middleware.ContentType   ( lookupFileExt+  , fileExtsToMiddleware    , -- * Re-Exports     module Network.Wai.Middleware.ContentType.Types@@ -42,6 +43,8 @@ import Network.Wai.Middleware.ContentType.Text import Network.Wai.Middleware.ContentType.Pandoc +import Network.Wai.Trans (Response, MiddlewareT, requestHeaders,+                         pathInfo) import qualified Data.HashMap.Lazy as HM import Data.Monoid import Control.Monad@@ -62,3 +65,11 @@         Nothing -> xs         Just fe -> fe <$ guard (fe `elem` xs) +fileExtsToMiddleware :: Monad m => FileExtListenerT Response m a -> MiddlewareT m+fileExtsToMiddleware xs app req respond = do+  map <- execFileExtListenerT xs+  let mAcceptHeader = lookup "Accept" (requestHeaders req)+      mFileExt      = getFileExt (pathInfo req)+  case lookupFileExt mAcceptHeader mFileExt map of+    Nothing -> app req respond+    Just r  -> respond r

@@ -1,7 +1,7 @@ module Network.Wai.Middleware.ContentType.Blaze where  import           Network.Wai.Middleware.ContentType.Types-import           Network.HTTP.Types                      (status200)+import           Network.HTTP.Types                      (Status, ResponseHeaders) import           Network.Wai                             (Response, responseBuilder)  import qualified Text.Blaze.Html                         as H@@ -13,7 +13,7 @@  blaze :: Monad m =>          H.Html-      -> FileExtListenerT Response m ()+      -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () blaze i =   tell' $ HM.singleton Html (blazeOnly i) @@ -21,6 +21,6 @@  -- * Data Only -blazeOnly :: H.Html -> Response-blazeOnly = responseBuilder status200 [] . H.renderHtmlBuilder+blazeOnly :: H.Html -> Status -> ResponseHeaders -> Response+blazeOnly h s hs = responseBuilder s hs (H.renderHtmlBuilder h) 

@@ -1,7 +1,7 @@ module Network.Wai.Middleware.ContentType.ByteString where  import           Network.Wai.Middleware.ContentType.Types-import           Network.HTTP.Types                      (status200)+import           Network.HTTP.Types                      (Status, ResponseHeaders) import           Network.Wai                             (Response, responseLBS)  import qualified Data.ByteString.Lazy                    as LBS@@ -14,7 +14,7 @@ bytestring :: Monad m =>               FileExt            -> LBS.ByteString-           -> FileExtListenerT Response m ()+           -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () bytestring fe i =   tell' $ HM.singleton fe (bytestringOnly i) @@ -24,5 +24,5 @@ -- * Data Only  -- | The exact same thing as @Network.Wai.responseLBS@.-bytestringOnly :: LBS.ByteString -> Response-bytestringOnly = responseLBS status200 []+bytestringOnly :: LBS.ByteString -> Status -> ResponseHeaders -> Response+bytestringOnly b s hs = responseLBS s hs b

@@ -2,10 +2,10 @@  import           Network.Wai.Middleware.ContentType.Types as CT import           Network.Wai.Middleware.ContentType.Text+import           Network.HTTP.Types                       (Status, ResponseHeaders) import           Network.Wai                              (Response)  import           Text.Cassius-import qualified Data.Text.Lazy.Encoding                  as LT import qualified Data.HashMap.Lazy                        as HM  @@ -13,7 +13,7 @@  cassius :: Monad m =>            Css-        -> FileExtListenerT Response m ()+        -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () cassius i =   tell' $ HM.singleton CT.Css (cassiusOnly i) @@ -22,6 +22,6 @@  -- * Data Only -cassiusOnly :: Css -> Response-cassiusOnly =-  textOnly . renderCss+cassiusOnly :: Css -> Status -> ResponseHeaders -> Response+cassiusOnly c =+  textOnly (renderCss c)

@@ -2,6 +2,7 @@  import           Network.Wai.Middleware.ContentType.Types as CT import           Network.Wai.Middleware.ContentType.Text+import           Network.HTTP.Types                       (Status, ResponseHeaders) import           Network.Wai                              (Response)  import           Clay.Render@@ -13,7 +14,7 @@  clay :: Monad m =>         Config -> [App] -> Css-     -> FileExtListenerT Response m ()+     -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () clay c as i =   tell' $ HM.singleton CT.Css (clayOnly c as i) @@ -22,6 +23,6 @@  -- * Data Only -clayOnly :: Config -> [App] -> Css -> Response-clayOnly c as =-  textOnly . renderWith c as+clayOnly :: Config -> [App] -> Css -> Status -> ResponseHeaders -> Response+clayOnly c as css =+  textOnly (renderWith c as css)

@@ -2,6 +2,7 @@  import           Network.Wai.Middleware.ContentType.Types import           Network.Wai.Middleware.ContentType.ByteString+import           Network.HTTP.Types                      (Status, ResponseHeaders) import           Network.Wai                             (Response)  import qualified Data.Aeson                              as A@@ -13,7 +14,7 @@ json :: ( A.ToJSON j         , Monad m         ) => j-          -> FileExtListenerT Response m ()+          -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () json =   bytestring Json . A.encode @@ -21,8 +22,8 @@  -- * Data Only -jsonOnly :: A.ToJSON j => j -> Response-jsonOnly =-  bytestringOnly . A.encode+jsonOnly :: A.ToJSON j => j -> Status -> ResponseHeaders -> Response+jsonOnly j =+  bytestringOnly (A.encode j)  {-# INLINEABLE jsonOnly #-}

@@ -2,6 +2,7 @@  import           Network.Wai.Middleware.ContentType.Types as CT import           Network.Wai.Middleware.ContentType.Text+import           Network.HTTP.Types                       (Status, ResponseHeaders) import           Network.Wai                              (Response)  import           Text.Julius@@ -12,7 +13,7 @@  julius :: Monad m =>           Javascript-       -> FileExtListenerT Response m ()+       -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () julius i =   tell' $ HM.singleton CT.JavaScript (juliusOnly i) @@ -21,6 +22,6 @@  -- * Data Only -juliusOnly :: Javascript -> Response-juliusOnly =-  textOnly . renderJavascript+juliusOnly :: Javascript -> Status -> ResponseHeaders -> Response+juliusOnly j =+  textOnly (renderJavascript j)

@@ -1,7 +1,7 @@ module Network.Wai.Middleware.ContentType.Lucid where  import           Network.Wai.Middleware.ContentType.Types-import           Network.HTTP.Types                      (status200)+import           Network.HTTP.Types                      (Status, ResponseHeaders) import           Network.Wai                             (Response, responseBuilder)  import qualified Lucid.Base                              as L@@ -13,7 +13,7 @@  lucid :: Monad m =>          L.HtmlT m ()-      -> FileExtListenerT Response m ()+      -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () lucid i = do   i' <- lift (lucidOnly i)   tell' (HM.singleton Html i')@@ -23,8 +23,8 @@  -- * Data Only -lucidOnly :: Monad m => L.HtmlT m () -> m Response+lucidOnly :: Monad m => L.HtmlT m () -> m (Status -> ResponseHeaders -> Response) lucidOnly i =-  responseBuilder status200 [] <$> L.execHtmlT i+  (\b s hs -> responseBuilder s hs b) <$> L.execHtmlT i  {-# INLINEABLE lucidOnly #-}

@@ -2,6 +2,7 @@  import           Network.Wai.Middleware.ContentType.Types as CT import           Network.Wai.Middleware.ContentType.Text+import           Network.HTTP.Types                       (Status, ResponseHeaders) import           Network.Wai                              (Response)  import           Text.Lucius@@ -10,7 +11,9 @@  -- * Lifted Combinators -lucius :: Monad m => Css -> FileExtListenerT Response m ()+lucius :: Monad m =>+          Css+       -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () lucius i =   tell' $ HM.singleton CT.Css (luciusOnly i) @@ -19,6 +22,6 @@  -- * Data Only -luciusOnly :: Css -> Response-luciusOnly =-  textOnly . renderCss+luciusOnly :: Css -> Status -> ResponseHeaders -> Response+luciusOnly c =+  textOnly (renderCss c)

@@ -2,6 +2,7 @@  import           Network.Wai.Middleware.ContentType.Types import           Network.Wai.Middleware.ContentType.Text+import           Network.HTTP.Types                       (Status, ResponseHeaders) import           Network.Wai                              (Response)  import qualified Data.Text.Lazy                           as LT@@ -11,7 +12,9 @@  -- * Lifted Combinators -markdown :: Monad m => P.Pandoc -> FileExtListenerT Response m ()+markdown :: Monad m =>+            P.Pandoc+         -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () markdown i =   tell' $ HM.singleton Markdown (markdownOnly i) @@ -20,6 +23,6 @@  -- * Data Only -markdownOnly :: P.Pandoc -> Response-markdownOnly =-  textOnly . LT.pack . P.writeMarkdown P.def+markdownOnly :: P.Pandoc -> Status -> ResponseHeaders -> Response+markdownOnly p =+  textOnly (LT.pack $ P.writeMarkdown P.def p)

@@ -1,7 +1,7 @@ module Network.Wai.Middleware.ContentType.Text where  import           Network.Wai.Middleware.ContentType.Types-import           Network.HTTP.Types                       (status200)+import           Network.HTTP.Types                       (Status, ResponseHeaders) import           Network.Wai                              (Response, responseBuilder)  import qualified Data.Text.Lazy                           as LT@@ -11,7 +11,9 @@  -- * Lifted Combinators -text :: Monad m => LT.Text -> FileExtListenerT Response m ()+text :: Monad m =>+        LT.Text+     -> FileExtListenerT (Status -> ResponseHeaders -> Response) m () text i =   tell' $ HM.singleton Text (textOnly i) @@ -20,7 +22,7 @@  -- * Data Only -textOnly :: LT.Text -> Response-textOnly =-  responseBuilder status200 [] . LT.encodeUtf8Builder+textOnly :: LT.Text -> Status -> ResponseHeaders -> Response+textOnly t s hs =+  responseBuilder s hs (LT.encodeUtf8Builder t) 

@@ -30,6 +30,7 @@   , FileExtMap   , FileExtListenerT (..)   , execFileExtListenerT+  , mapResponse   , -- * Utilities     tell'   , AcceptHeader@@ -59,6 +60,8 @@ import           Control.Monad.Morph  import           GHC.Generics+import           Network.HTTP.Types (Status, ResponseHeaders)+import           Network.Wai.Trans (Response) import           Network.HTTP.Media (mapAccept)  @@ -114,6 +117,8 @@  {-# INLINEABLE toExt #-} ++ type FileExtMap a = HashMap FileExt a  -- | The monad for our DSL - when using the combinators, our result will be this@@ -144,6 +149,18 @@   liftBaseWith = defaultLiftBaseWith   restoreM     = defaultRestoreM +mapResponse :: Monad m =>+               ((Status -> ResponseHeaders -> Response) -> Response)+            -> FileExtListenerT (Status -> ResponseHeaders -> Response) m a+            -> FileExtListenerT Response m a+mapResponse f (FileExtListenerT xs) =+  FileExtListenerT $ mapState (HM.map f) (HM.map (const . const)) xs+  where+    mapState to from xs = do+      i <- get+      (x,s) <- lift (runStateT xs (from i))+      put (to s)+      pure x  execFileExtListenerT :: Monad m => FileExtListenerT r m a -> m (FileExtMap r) execFileExtListenerT xs = execStateT (runFileExtListenerT xs) mempty

@@ -158,18 +158,12 @@         406  app :: Application-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) = textOnly "Something went wrong"-                 in (ResponseBuilder status406 [] r)-      Just r  -> r+app =+  fileExtsToMiddleware allExamples $+  (\req respond -> respond (textOnly "Something went wrong" status406 []))  allExamples :: FileExtListenerT Response IO ()-allExamples = do+allExamples = mapResponse (\f -> f status200 []) $ do   text "Text!"   json ("Json!" :: T.Text)   lucid (L.toHtmlRaw ("Html!" :: T.Text))

@@ -1,5 +1,5 @@ Name:                   wai-middleware-content-type-Version:                0.2.1+Version:                0.3.0 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -56,6 +56,7 @@                       , unordered-containers                       , urlpath >= 5.0.0.1                       , wai >= 3.2+                      , wai-transformers  Test-Suite test   Type:                 exitcode-stdio-1.0