diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,39 @@ +wai-middleware-content-type +=========================== + +Route middlewares based on the incoming `Accept` HTTP header, +and other hints like the file extension (`foo.txt`) of the route +requested. + +## Usage + +This package provides many combinators for turning various data +types into the response you'd expect. For instance, +[blaze-html](https://hackage.haskell.org/package/blaze-html) gives +us _strictly_ `Html` data, right? We can be sure to only respond +with `Html`-compatible requests with our toolset: + +```haskell +import Network.Wai.Middleware.ContentType +import Network.Wai.Trans + + +myMiddleware :: MiddlewareT (ReaderT Env m) + +contentTypeRoutes :: Monad m => + FileExtListenerT (Status -> ResponseHeaders -> Response) m () +contentTypeRoutes = do + blaze myBlazeResponse + cassius myCassiusResponse + text myTextResponse + + +contentMiddleware :: Monad m => MiddlewareT m +contentMiddleware app req respond = + fileExtsToMiddleware $ + mapResponse (\f -> f status200 []) contentTypeRoutes +``` + + +This library was designed for use with [nested-routes](https://hackage.haskell.org/package/nested-routes), +but it's all good if you want to use it separately. diff --git a/src/Network/Wai/Middleware/ContentType.hs b/src/Network/Wai/Middleware/ContentType.hs --- a/src/Network/Wai/Middleware/ContentType.hs +++ b/src/Network/Wai/Middleware/ContentType.hs @@ -29,7 +29,6 @@ , module Network.Wai.Middleware.ContentType.Lucid , module Network.Wai.Middleware.ContentType.Lucius , module Network.Wai.Middleware.ContentType.Text - , module Network.Wai.Middleware.ContentType.Pandoc ) where import Network.Wai.Middleware.ContentType.Types hiding (tell') @@ -42,7 +41,6 @@ import Network.Wai.Middleware.ContentType.Lucid import Network.Wai.Middleware.ContentType.Lucius import Network.Wai.Middleware.ContentType.Text -import Network.Wai.Middleware.ContentType.Pandoc import Network.Wai.Trans (Response, MiddlewareT, requestHeaders, pathInfo) diff --git a/src/Network/Wai/Middleware/ContentType/Pandoc.hs b/src/Network/Wai/Middleware/ContentType/Pandoc.hs deleted file mode 100644 --- a/src/Network/Wai/Middleware/ContentType/Pandoc.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE - OverloadedStrings - #-} - - -module Network.Wai.Middleware.ContentType.Pandoc where - -import Network.Wai.Middleware.ContentType.Types -import Network.Wai.Middleware.ContentType.Text -import Network.HTTP.Types (status200, Status, ResponseHeaders) -import Network.Wai (Response) - -import qualified Data.Text.Lazy as LT -import qualified Text.Pandoc as P -import qualified Data.HashMap.Lazy as HM - - --- * Lifted Combinators - -markdown :: Monad m => - P.Pandoc - -> FileExtListenerT m () -markdown i = - tell' $ HM.singleton Markdown $ - ResponseVia - i - status200 - [("Content-Type","text/markdown")] - markdownOnly - -{-# INLINEABLE markdown #-} - - --- * Data Only - -markdownOnly :: P.Pandoc -> Status -> ResponseHeaders -> Response -markdownOnly p = case P.runPure (P.writeMarkdown P.def p) of - Left e -> error (show e) - Right x -> textOnly (LT.fromStrict x) diff --git a/test/Network/Wai/Middleware/ContentTypeSpec.hs b/test/Network/Wai/Middleware/ContentTypeSpec.hs --- a/test/Network/Wai/Middleware/ContentTypeSpec.hs +++ b/test/Network/Wai/Middleware/ContentTypeSpec.hs @@ -15,7 +15,6 @@ import qualified Lucid as L import qualified Text.Lucius as SL import qualified Text.Julius as SJ -import qualified Text.Pandoc as P import Test.Hspec import Test.Hspec.Wai as HW @@ -55,12 +54,6 @@ "" { matchStatus = 200 , matchBody = "function foo () {return;}" } - describe "Markdown" $ - it "should respond with 200" $ - HW.request "GET" "/" [("Accept", "text/markdown")] "" `shouldRespondWith` - "" { matchStatus = 200 - , matchBody = "*Pandoc*!" - } describe "All Requests Respond to the File Extension" $ with (return app) $ do describe "Text" $ @@ -93,12 +86,6 @@ "" { matchStatus = 200 , matchBody = "function foo () {return;}" } - describe "Markdown" $ - it "should respond with 200" $ - HW.get "/index.md" `shouldRespondWith` - "" { matchStatus = 200 - , matchBody = "*Pandoc*!" - } describe "Foo" $ it "should respond with 200" $ HW.get "/index.foo" `shouldRespondWith` @@ -137,12 +124,6 @@ "" { matchStatus = 200 , matchBody = "function foo () {return;}" } - describe "Markdown" $ - it "should respond with 200" $ - HW.request "GET" "/index.md" [("Accept", "text/markdown")] "" `shouldRespondWith` - "" { matchStatus = 200 - , matchBody = "*Pandoc*!" - } describe "Outlier behavior" $ with (return app) $ do describe "No extension, with header" $ @@ -151,12 +132,6 @@ "" { matchStatus = 200 , matchBody = "Text!" } - describe ".markdown & text/plain" $ - it " should respond with 200" $ - HW.request "GET" "/index.md" [("Accept", "text/plain")] "" `shouldRespondWith` - "" { matchStatus = 200 - , matchBody = "*Pandoc*!" - } describe "Unfulfillable accept headers should break" $ with (return app) $ do describe "Text on non-ContentType" $ @@ -176,8 +151,4 @@ 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 bytestring (Other "foo") (LT.encodeUtf8 "Foo") diff --git a/wai-middleware-content-type.cabal b/wai-middleware-content-type.cabal --- a/wai-middleware-content-type.cabal +++ b/wai-middleware-content-type.cabal @@ -1,107 +1,118 @@ -Name: wai-middleware-content-type -Version: 0.5.2 -Author: Athan Clark -Maintainer: Athan Clark -License: BSD3 -License-File: LICENSE -Synopsis: Route to different middlewares based on the incoming Accept header. --- Description: -Cabal-Version: >= 1.10 -Build-Type: Simple -Category: Web - - -Flag Example - Description: Build a trivial example - Default: False +-- This file has been generated from package.yaml by hpack version 0.21.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 9afbbd3c4ff146797016c5eef9779f0e704a685311098f1e20cdf09ca06c944f +name: wai-middleware-content-type +version: 0.6.0 +synopsis: Route to different middlewares based on the incoming Accept header. +description: Please see the README on Github at +category: Web +author: Athan Clark +maintainer: athan.clark@localcooking.com +copyright: 2018 Athan Clark +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 -Library - Default-Language: Haskell2010 - HS-Source-Dirs: src - GHC-Options: -Wall - Exposed-Modules: Network.Wai.Middleware.ContentType - Network.Wai.Middleware.ContentType.Types - Network.Wai.Middleware.ContentType.Blaze - 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 - Build-Depends: base >= 4.8 && < 5 - , aeson - , blaze-builder - , blaze-html - , bytestring - , clay - , exceptions - , extractable-singleton - , hashable - , http-media - , http-types - , lucid - , mmorph - , monad-control - , monad-control-aligned - , monad-logger - , mtl - , pandoc >= 2.0 - , resourcet - , shakespeare - , text - , transformers - , transformers-base - , unordered-containers - , urlpath >= 5.0.0.1 - , wai >= 3.2 - , wai-logger - , wai-transformers +extra-source-files: + README.md -Test-Suite test - Type: exitcode-stdio-1.0 - Default-Language: Haskell2010 - HS-Source-Dirs: test - GHC-Options: -Wall -threaded - Main-Is: Spec.hs - Other-Modules: Network.Wai.Middleware.ContentTypeSpec - Build-Depends: base >= 4.8 && < 5 - , wai-middleware-content-type - , aeson - , blaze-builder - , blaze-html - , bytestring - , clay - , exceptions - , hashable - , hspec - , hspec-wai - , http-media - , http-types - , lucid - , mmorph - , monad-control - , monad-logger - , mtl - , pandoc - , pandoc-types - , resourcet - , shakespeare - , text - , tasty - , tasty-hspec - , transformers - , transformers-base - , urlpath - , unordered-containers - , wai - , wai-transformers - , warp +source-repository head + type: git + location: git://git.localcooking.com/tooling/wai-middleware-content-type.git +library + exposed-modules: + Network.Wai.Middleware.ContentType + Network.Wai.Middleware.ContentType.Blaze + 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.Text + Network.Wai.Middleware.ContentType.Types + other-modules: + Paths_wai_middleware_content_type + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + aeson + , base >=4.8 && <5 + , blaze-builder + , blaze-html + , bytestring + , clay + , exceptions + , extractable-singleton + , hashable + , http-media + , http-types + , lucid + , mmorph + , monad-control + , monad-control-aligned + , monad-logger + , mtl + , resourcet + , shakespeare + , text + , transformers + , transformers-base + , unordered-containers + , urlpath >=8.0.1 + , wai >=3.2 + , wai-logger + , wai-transformers + default-language: Haskell2010 -Source-Repository head - Type: git - Location: https://github.com/athanclark/wai-middleware-content-type.git +test-suite wai-middleware-content-type-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Network.Wai.Middleware.ContentTypeSpec + Paths_wai_middleware_content_type + hs-source-dirs: + test + ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N + build-depends: + aeson + , base >=4.8 && <5 + , blaze-builder + , blaze-html + , bytestring + , clay + , exceptions + , extractable-singleton + , hashable + , hspec + , hspec-wai + , http-media + , http-types + , lucid + , mmorph + , monad-control + , monad-control-aligned + , monad-logger + , mtl + , resourcet + , shakespeare + , tasty + , tasty-hspec + , text + , transformers + , transformers-base + , unordered-containers + , urlpath + , wai + , wai-logger + , wai-middleware-content-type + , wai-transformers + , warp + default-language: Haskell2010