diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,19 +1,20 @@ Copyright (c) 2012-2015 Timothy Jones -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/http-media.cabal b/http-media.cabal --- a/http-media.cabal +++ b/http-media.cabal @@ -1,26 +1,27 @@ name: http-media -version: 0.6.4 +version: 0.7.0 license: MIT license-file: LICENSE author: Timothy Jones maintainer: Timothy Jones homepage: https://github.com/zmthy/http-media bug-reports: https://github.com/zmthy/http-media/issues -copyright: (c) 2012-2016 Timothy Jones +copyright: (c) 2012-2017 Timothy Jones category: Web build-type: Simple cabal-version: >= 1.10 synopsis: Processing HTTP Content-Type and Accept headers description: This library is intended to be a comprehensive solution to parsing and - selecting quality-indexed values in HTTP headers. It is capable of parsing - both media types and language parameters from the Accept and Content header - families, and can be extended to match against other accept headers as well. - Selecting the appropriate header value is achieved by comparing a list of - server options against the quality-indexed values supplied by the client. + selecting quality-indexed values in HTTP headers. It is capable of + parsing both media types and language parameters from the Accept and + Content header families, and can be extended to match against other + accept headers as well. Selecting the appropriate header value is + achieved by comparing a list of server options against the + quality-indexed values supplied by the client. . - In the following example, the Accept header is parsed and then matched against - a list of server options to serve the appropriate media using + In the following example, the Accept header is parsed and then matched + against a list of server options to serve the appropriate media using 'mapAcceptMedia': . > getHeader >>= maybe send406Error sendResourceWith . mapAcceptMedia @@ -28,8 +29,8 @@ > , ("application/json", asJson) > ] . - Similarly, the Content-Type header can be used to produce a parser for request - bodies based on the given content type with 'mapContentMedia': + Similarly, the Content-Type header can be used to produce a parser for + request bodies based on the given content type with 'mapContentMedia': . > getContentType >>= maybe send415Error readRequestBodyWith . mapContentMedia > [ ("application/json", parseJson) @@ -69,7 +70,8 @@ base >= 4.6 && < 5.0, bytestring >= 0.10 && < 0.11, case-insensitive >= 1.0 && < 1.3, - containers >= 0.5 && < 0.6 + containers >= 0.5 && < 0.6, + utf8-string >= 1.0 && < 1.1 test-suite test-http-media type: exitcode-stdio-1.0 @@ -109,11 +111,12 @@ Network.HTTP.Media.Utils build-depends: - base >= 4.6 && < 5.0, + base >= 4.7 && < 5.0, bytestring >= 0.10 && < 0.11, case-insensitive >= 1.0 && < 1.3, containers >= 0.5 && < 0.6, - QuickCheck >= 2.6 && < 2.10, + utf8-string >= 1.0 && < 1.1, + QuickCheck >= 2.6 && < 2.11, test-framework >= 0.8 && < 0.9, test-framework-quickcheck2 >= 0.3 && < 0.4 diff --git a/src/Network/HTTP/Media.hs b/src/Network/HTTP/Media.hs --- a/src/Network/HTTP/Media.hs +++ b/src/Network/HTTP/Media.hs @@ -33,6 +33,9 @@ -- * Quality values , Quality + , quality + , maxQuality + , minQuality , parseQuality , matchQuality , mapQuality @@ -44,28 +47,25 @@ , RenderHeader (..) ) where ------------------------------------------------------------------------------- #if MIN_VERSION_base(4, 8, 0) -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>)) #else -import Control.Applicative (pure, (<$>), (<*>), (<|>)) +import Control.Applicative (pure, (<$>), (<*>), (<|>)) #endif ------------------------------------------------------------------------------- -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Char8 as BS ------------------------------------------------------------------------------- -import Control.Monad (guard, (>=>)) -import Data.ByteString (ByteString) -import Data.Maybe (fromMaybe) +import Control.Monad (guard, (>=>)) +import Data.ByteString (ByteString) +import Data.Maybe (fromMaybe) +import Data.Proxy (Proxy (Proxy)) ------------------------------------------------------------------------------- -import Network.HTTP.Media.Accept as Accept -import Network.HTTP.Media.Language as Language -import Network.HTTP.Media.MediaType as MediaType -import Network.HTTP.Media.Quality -import Network.HTTP.Media.RenderHeader -import Network.HTTP.Media.Utils (trimBS) +import Network.HTTP.Media.Accept as Accept +import Network.HTTP.Media.Language as Language +import Network.HTTP.Media.MediaType as MediaType +import Network.HTTP.Media.Quality +import Network.HTTP.Media.RenderHeader +import Network.HTTP.Media.Utils (trimBS) ------------------------------------------------------------------------------ diff --git a/src/Network/HTTP/Media/Accept.hs b/src/Network/HTTP/Media/Accept.hs --- a/src/Network/HTTP/Media/Accept.hs +++ b/src/Network/HTTP/Media/Accept.hs @@ -4,14 +4,12 @@ module Network.HTTP.Media.Accept ( Accept (..) , mostSpecific - , Proxy (..) ) where ------------------------------------------------------------------------------- import qualified Data.CaseInsensitive as CI ------------------------------------------------------------------------------- -import Data.ByteString (ByteString) +import Data.ByteString (ByteString) +import Data.Proxy (Proxy) ------------------------------------------------------------------------------ @@ -65,9 +63,3 @@ mostSpecific a b | b `moreSpecificThan` a = b | otherwise = a - - ------------------------------------------------------------------------------- --- | Serves the same purpose as the Proxy type in base, but redefined here in --- a basic form for older versions of base that do not include it. -data Proxy a = Proxy diff --git a/src/Network/HTTP/Media/Language.hs b/src/Network/HTTP/Media/Language.hs --- a/src/Network/HTTP/Media/Language.hs +++ b/src/Network/HTTP/Media/Language.hs @@ -6,12 +6,10 @@ , toParts ) where ------------------------------------------------------------------------------- -import Data.ByteString (ByteString) -import Data.CaseInsensitive (CI) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI) ------------------------------------------------------------------------------- -import Network.HTTP.Media.Language.Internal +import Network.HTTP.Media.Language.Internal ------------------------------------------------------------------------------ diff --git a/src/Network/HTTP/Media/Language/Internal.hs b/src/Network/HTTP/Media/Language/Internal.hs --- a/src/Network/HTTP/Media/Language/Internal.hs +++ b/src/Network/HTTP/Media/Language/Internal.hs @@ -7,27 +7,23 @@ ( Language (..) ) where ------------------------------------------------------------------------------- #if !MIN_VERSION_base(4, 8, 0) -import Data.Functor ((<$>)) +import Data.Functor ((<$>)) #endif ------------------------------------------------------------------------------- -import qualified Data.ByteString.Char8 as BS -import qualified Data.CaseInsensitive as CI +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI ------------------------------------------------------------------------------- -import Control.Monad (guard) -import Data.ByteString (ByteString) -import Data.CaseInsensitive (CI, original) -import Data.Char (isAlpha) -import Data.List (isPrefixOf) -import Data.Maybe (fromMaybe) -import Data.String (IsString (..)) +import Control.Monad (guard) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI, original) +import Data.Char (isAlpha) +import Data.List (isPrefixOf) +import Data.Maybe (fromMaybe) +import Data.String (IsString (..)) ------------------------------------------------------------------------------- -import Network.HTTP.Media.Accept (Accept (..)) -import Network.HTTP.Media.RenderHeader (RenderHeader (..)) +import Network.HTTP.Media.Accept (Accept (..)) +import Network.HTTP.Media.RenderHeader (RenderHeader (..)) ------------------------------------------------------------------------------ diff --git a/src/Network/HTTP/Media/MediaType.hs b/src/Network/HTTP/Media/MediaType.hs --- a/src/Network/HTTP/Media/MediaType.hs +++ b/src/Network/HTTP/Media/MediaType.hs @@ -17,23 +17,19 @@ , (/.) ) where ------------------------------------------------------------------------------- -import qualified Data.ByteString.Char8 as BS -import qualified Data.CaseInsensitive as CI -import qualified Data.Map as Map +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI +import qualified Data.Map as Map ------------------------------------------------------------------------------- -import Data.ByteString (ByteString) -import Data.CaseInsensitive (CI) -import Data.Map (empty, insert) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI) +import Data.Map (empty, insert) ------------------------------------------------------------------------------- import qualified Network.HTTP.Media.MediaType.Internal as Internal ------------------------------------------------------------------------------- -import Network.HTTP.Media.MediaType.Internal (MediaType (MediaType)) -import Network.HTTP.Media.MediaType.Internal hiding (MediaType (..)) -import Network.HTTP.Media.Utils +import Network.HTTP.Media.MediaType.Internal (MediaType (MediaType)) +import Network.HTTP.Media.MediaType.Internal hiding (MediaType (..)) +import Network.HTTP.Media.Utils ------------------------------------------------------------------------------ diff --git a/src/Network/HTTP/Media/MediaType/Internal.hs b/src/Network/HTTP/Media/MediaType/Internal.hs --- a/src/Network/HTTP/Media/MediaType/Internal.hs +++ b/src/Network/HTTP/Media/MediaType/Internal.hs @@ -5,24 +5,21 @@ , Parameters ) where ------------------------------------------------------------------------------- -import qualified Data.ByteString.Char8 as BS -import qualified Data.CaseInsensitive as CI -import qualified Data.Map as Map +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI +import qualified Data.Map as Map ------------------------------------------------------------------------------- -import Control.Monad (foldM, guard) -import Data.ByteString (ByteString) -import Data.CaseInsensitive (CI, original) -import Data.Map (Map) -import Data.Maybe (fromMaybe) -import Data.Monoid ((<>)) -import Data.String (IsString (..)) +import Control.Monad (foldM, guard) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI, original) +import Data.Map (Map) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.String (IsString (..)) ------------------------------------------------------------------------------- -import Network.HTTP.Media.Accept (Accept (..)) -import Network.HTTP.Media.RenderHeader (RenderHeader (..)) -import Network.HTTP.Media.Utils (breakChar, trimBS) +import Network.HTTP.Media.Accept (Accept (..)) +import Network.HTTP.Media.RenderHeader (RenderHeader (..)) +import Network.HTTP.Media.Utils (breakChar, trimBS) ------------------------------------------------------------------------------ diff --git a/src/Network/HTTP/Media/Quality.hs b/src/Network/HTTP/Media/Quality.hs --- a/src/Network/HTTP/Media/Quality.hs +++ b/src/Network/HTTP/Media/Quality.hs @@ -2,24 +2,24 @@ -- | Defines the quality value data type. module Network.HTTP.Media.Quality ( Quality (..) + , quality , maxQuality , minQuality , showQ , readQ ) where ------------------------------------------------------------------------------- -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Char8 as BS ------------------------------------------------------------------------------- -import Data.ByteString (ByteString) -import Data.Char (isDigit) -import Data.List (dropWhileEnd) -import Data.Monoid ((<>)) -import Data.Word (Word16) +import Data.ByteString (ByteString) +import Data.ByteString.UTF8 (toString) +import Data.Char (isDigit) +import Data.List (dropWhileEnd) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.Word (Word16) ------------------------------------------------------------------------------- -import Network.HTTP.Media.RenderHeader (RenderHeader (..)) +import Network.HTTP.Media.RenderHeader (RenderHeader (..)) ------------------------------------------------------------------------------ -- | Attaches a quality value to data. @@ -33,6 +33,13 @@ instance RenderHeader h => RenderHeader (Quality h) where renderHeader (Quality a q) = renderHeader a <> ";q=" <> showQ q + + +------------------------------------------------------------------------------ +-- | Manually construct a quality value. +quality :: a -> ByteString -> Quality a +quality x q = Quality x $ flip fromMaybe (readQ q) $ + error ("Invalid quality value " ++ toString q) ------------------------------------------------------------------------------ diff --git a/src/Network/HTTP/Media/RenderHeader.hs b/src/Network/HTTP/Media/RenderHeader.hs --- a/src/Network/HTTP/Media/RenderHeader.hs +++ b/src/Network/HTTP/Media/RenderHeader.hs @@ -8,8 +8,7 @@ ( RenderHeader (..) ) where ------------------------------------------------------------------------------- -import Data.ByteString (ByteString, intercalate) +import Data.ByteString (ByteString, intercalate) ------------------------------------------------------------------------------ diff --git a/src/Network/HTTP/Media/Utils.hs b/src/Network/HTTP/Media/Utils.hs --- a/src/Network/HTTP/Media/Utils.hs +++ b/src/Network/HTTP/Media/Utils.hs @@ -8,11 +8,9 @@ , isValidChar ) where ------------------------------------------------------------------------------- import qualified Data.ByteString.Char8 as BS ------------------------------------------------------------------------------- -import Data.ByteString (ByteString) +import Data.ByteString (ByteString) ------------------------------------------------------------------------------