wai-util 0.1 → 0.2

raw patch · 2 files changed

+20/−4 lines, 2 filesdep +http-accept

Dependencies added: http-accept

Files

• Network/Wai/Util.hs +18/−3
• wai-util.cabal +2/−1

@@ -2,6 +2,7 @@  import Data.Char (isAscii) import Data.Maybe (fromMaybe)+import Data.List (intercalate) import Data.Monoid (mappend, mempty) import Control.Monad (liftM2) import Control.Arrow ((***))@@ -9,14 +10,16 @@ import Control.Monad.IO.Class (MonadIO, liftIO)  import Network.URI (URI, uriIsAbsolute)-import Network.HTTP.Types (statusIsRedirection, Status, ResponseHeaders, Header)-import Network.Wai (Request, Response(ResponseBuilder,ResponseFile,ResponseSource), responseLBS, requestBody, responseSource)-import Network.Wai.Parse (BackEnd)+import Network.HTTP.Types (statusIsRedirection, Status, ResponseHeaders, Header, notAcceptable406)+import Network.Wai (Request, Response(ResponseBuilder,ResponseFile,ResponseSource), responseLBS, requestBody, requestHeaders, responseSource)+import Network.Wai.Parse (BackEnd, parseHttpAccept) import Network.Mail.Mime (Part(..), Encoding(QuotedPrintableText, Base64)) import Control.Monad.Trans.Resource (runResourceT, ResourceT) import Data.Conduit (($$), Flush(Chunk)) import Data.Conduit.List (fold, sinkNull) +import Network.HTTP.Accept (selectAcceptType)+ import Data.ByteString (ByteString) import Data.Text (Text) @@ -25,6 +28,18 @@ import qualified Data.Aeson as Aeson import qualified Data.Text.Encoding as T import qualified Data.CaseInsensitive as CI++-- | Build an Application that supports multiple Accept types (Content Negotiation)+handleAcceptTypes :: (MonadIO m) => [(String, m Response)] -> Request -> m Response+handleAcceptTypes handlers req =+	fromMaybe notAcceptable handler+	where+	handler = lookup acceptType handlers+	notAcceptable = string notAcceptable406 [] (intercalate "\n" supportedTypes)+	acceptType = fromMaybe (head supportedTypes) acceptType'+	acceptType' = (selectAcceptType supportedTypes . parseHttpAccept) =<<+		lookup (fromString "Accept") (requestHeaders req)+	supportedTypes = map fst handlers  -- | 'BackeEnd' for 'parseRequestBody' that throws out any file uploads noStoreFileUploads :: BackEnd ()

@@ -1,5 +1,5 @@ name:            wai-util-version:         0.1+version:         0.2 cabal-version:   >= 1.8 license:         OtherLicense license-file:    COPYING@@ -37,6 +37,7 @@                 text,                 case-insensitive,                 mime-mail,+                http-accept,                 network >= 2.4.0.0,                 http-types >= 0.7.2