http-api-data 0.3.8.1 → 0.7
raw patch · 13 files changed
Files
- CHANGELOG.md +94/−0
- Setup.hs +2/−0
- Setup.lhs +0/−36
- http-api-data.cabal +51/−57
- include/overlapping-compat.h +0/−8
- src/Web/FormUrlEncoded.hs +1/−1
- src/Web/HttpApiData.hs +2/−3
- src/Web/Internal/FormUrlEncoded.hs +104/−76
- src/Web/Internal/HttpApiData.hs +351/−120
- test/Web/Internal/FormUrlEncodedSpec.hs +8/−14
- test/Web/Internal/HttpApiDataSpec.hs +60/−102
- test/Web/Internal/TestInstances.hs +4/−4
- test/doctests.hs +0/−25
CHANGELOG.md view
@@ -1,3 +1,97 @@+0.7++* Change Form representation to use Map (from `containers`) instead of `HashMap`.+ This prevents possible HashDOS attacks.++0.6.3++* Add To/FromForm instances for () and Void++0.6.2++* Support GHC-9.12+* Require `cookie-0.5.1`++0.6.1++* Require at least GHC-8.6+* Support `cookie-0.5.0`, see [#137](https://github.com/fizruk/http-api-data/pull/137).++ Note that `cookie-0.5.0`'s parser now removes double quotes around cookie values.++0.6+---++* Use [`text-iso8601`](https://hackage.haskell.org/package/text-iso8601)+ to parse and serialise `time` types. (Instead of `attoparsec-iso8601`).+ Due this change some formats are slightly changed:++ - Space between timezone is not accepted+ - Timezone offset can be between -23:59..23:59+ - Timezone offset is output with colon between hours and minutes++* Require at least GHC-8.2++0.5.1+-----++* Add `toEncodedQueryParam` to `ToHttpApiData` type class. It has default+ implementation using `toQueryParam`, but may be overriden with more efficient+ one.++0.5+---++* Use `attoparsec-iso8601-1.1.0.0`.+ `Day` and `UTCTime` parsers require at least 4 digits now, which is a breaking change.+* Drop GHC-7.8 and GHC-7.10 support.++0.4.3+-----++* Add `Quarter`, `QuarterOfYear` and `Month` instances+* Support `bytestring-0.11`++0.4.2+-----++* Add instances for `Const` and `Identity`++0.4.1.1+-------++* Allow cookie <0.5+* Change to `build-type: Simple`++0.4.1+-----++* Use `time-compat` to provide instances for `DayOfWeek`.++0.4+---++* `NominalDiffTime` instances preserve precision (roundtrip)+* Add `Semigroup.Min`, `Max`, `First`, `Last` instances+* Add `Tagged b a` instances++0.3.10+---++* Fix 'SetCookie' instances+ (see [#86](https://github.com/fizruk/http-api-data/pull/86))+* Add support for `Fixed`+ (see [#78](https://github.com/fizruk/http-api-data/pull/87))++0.3.9+---++* GHC-8.6 support+* Remove dependency on `uri-bytestring` and use functions from `http-types` instead+ (see [#75](https://github.com/fizruk/http-api-data/pull/75))+* Add support for `SetCookie`+ (see [#74](https://github.com/fizruk/http-api-data/pull/74))+ 0.3.8.1 ---
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,36 +0,0 @@-\begin{code}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--#ifndef MIN_VERSION_cabal_doctest-#define MIN_VERSION_cabal_doctest(x,y,z) 0-#endif--#if MIN_VERSION_cabal_doctest(1,0,0)--import Distribution.Extra.Doctest ( defaultMainWithDoctests )-main :: IO ()-main = defaultMainWithDoctests "doctests"--#else--#ifdef MIN_VERSION_Cabal--- If the macro is defined, we have new cabal-install,--- but for some reason we don't have cabal-doctest in package-db------ Probably we are running cabal sdist, when otherwise using new-build--- workflow-#warning You are configuring this package without cabal-doctest installed. \- The doctests test-suite will not work as a result. \- To fix this, install cabal-doctest before configuring.-#endif--import Distribution.Simple--main :: IO ()-main = defaultMain--#endif--\end{code}
http-api-data.cabal view
@@ -1,36 +1,38 @@+cabal-version: 1.12 name: http-api-data-version: 0.3.8.1-license: BSD3-license-file: LICENSE-author: Nickolay Kudasov <nickolay.kudasov@gmail.com>-maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com>+version: 0.7+ synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters.+category: Web description: This package defines typeclasses used for converting Haskell data types to and from HTTP API data. . Please see README.md++license: BSD3+license-file: LICENSE+author: Nickolay Kudasov <nickolay.kudasov@gmail.com>+maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com> homepage: http://github.com/fizruk/http-api-data-category: Web stability: unstable-cabal-version: >= 1.10-build-type: Custom+build-type: Simple+ extra-source-files:- include/overlapping-compat.h test/*.hs CHANGELOG.md README.md-tested-with:- GHC==7.8.4,- GHC==7.10.3,- GHC==8.0.2,- GHC==8.2.2,- GHC==8.4.1 -custom-setup- setup-depends:- base >= 4.7 && <4.12,- Cabal >= 1.18 && <2.3,- cabal-doctest >=1.0.6 && <1.1+tested-with:+ GHC==8.6.5,+ GHC==8.8.4,+ GHC==8.10.7,+ GHC==9.0.2,+ GHC==9.2.8,+ GHC==9.4.8,+ GHC==9.6.7,+ GHC==9.8.4,+ GHC==9.10.1,+ GHC==9.12.2 flag use-text-show description: Use text-show library for efficient ToHttpApiData implementations.@@ -39,25 +41,27 @@ library hs-source-dirs: src/- include-dirs: include/- build-depends: base >= 4.7 && < 4.12- , attoparsec >= 0.13.0.1 && < 0.14- , attoparsec-iso8601 >= 1.0.0.0 && < 1.1- , bytestring >= 0.10.4.0 && < 0.11- , containers >= 0.5.5.1 && < 0.6- , hashable >= 1.1.2.4 && < 1.3- , http-types >= 0.8.6 && < 0.13- , text >= 1.1.1.3 && < 1.3- , time >= 1.4.2 && < 1.9- , time-locale-compat >= 0.1.1.0 && < 0.2- , unordered-containers >= 0.2.6.0 && < 0.3- , uri-bytestring >= 0.1.7 && < 0.4- , uuid-types >= 1.0.2 && <1.1- if !impl(ghc >= 8.0)- build-depends: semigroups >= 0.16 && < 0.19++ -- GHC bundled+ build-depends: base >= 4.12.0.0 && < 4.22+ , bytestring >= 0.10.8.2 && < 0.13+ , containers >= 0.6.0.1 && < 0.8+ , text >= 1.2.3.0 && < 1.3 || >=2.0 && <2.2++ -- other-dependencies+ build-depends:+ cookie >= 0.5.1 && < 0.6+ , hashable >= 1.4.4.0 && < 1.6+ , http-types >= 0.12.4 && < 0.13+ , text-iso8601 >= 0.1.1 && < 0.2+ , tagged >= 0.8.8 && < 0.9+ , time-compat >= 1.9.5 && < 1.10+ , uuid-types >= 1.0.6 && < 1.1+ if flag(use-text-show) cpp-options: -DUSE_TEXT_SHOW- build-depends: text-show >= 2+ build-depends: text-show >= 3.10.5 && <3.12+ exposed-modules: Web.HttpApiData Web.FormUrlEncoded@@ -76,31 +80,21 @@ hs-source-dirs: test ghc-options: -Wall default-language: Haskell2010- build-tool-depends: hspec-discover:hspec-discover >= 2.4.7 && <2.5- build-depends: HUnit- , hspec >= 2.4.7- , base+ build-tool-depends: hspec-discover:hspec-discover >= 2.7.1 && <2.12+ -- inherited depndencies+ build-depends:+ base , bytestring- , QuickCheck >=2.9- , quickcheck-instances >= 0.3.12- , unordered-containers+ , cookie , http-api-data , text- , time- , bytestring+ , time-compat+ , containers , uuid-types -test-suite doctests- ghc-options: -Wall- build-depends:- base,- directory >= 1.0,- doctest >= 0.11 && <0.16,- filepath- default-language: Haskell2010- hs-source-dirs: test- main-is: doctests.hs- type: exitcode-stdio-1.0+ build-depends: hspec >= 2.7.1 && <2.12+ , QuickCheck >= 2.13.1 && <2.16+ , quickcheck-instances >= 0.3.25.2 && <0.4 source-repository head type: git
− include/overlapping-compat.h
@@ -1,8 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#define OVERLAPPING_ {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPABLE_-#define OVERLAPPING_-#endif
src/Web/FormUrlEncoded.hs view
@@ -47,5 +47,5 @@ urlDecodeParams, ) where -import Web.Internal.FormUrlEncoded+import Web.Internal.FormUrlEncoded
src/Web/HttpApiData.hs view
@@ -43,16 +43,15 @@ readTextData, ) where -import Web.Internal.HttpApiData+import Web.Internal.HttpApiData -- $setup -- -- >>> :set -XOverloadedStrings -- >>> import Control.Applicative--- >>> import Data.Time+-- >>> import Data.Time.Compat -- >>> import Data.Int -- >>> import Data.Text (Text)--- >>> import Data.Time (Day) -- >>> import Data.Version -- $examples
src/Web/Internal/FormUrlEncoded.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-}@@ -14,64 +13,54 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-#include "overlapping-compat.h" module Web.Internal.FormUrlEncoded where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-import Data.Traversable-#endif--+import Control.Applicative (Const(Const)) import Control.Arrow ((***)) import Control.Monad ((<=<))-import Data.ByteString.Builder (toLazyByteString, shortByteString)+import Data.ByteString.Builder (shortByteString, toLazyByteString) import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSL8+import Data.Coerce (coerce) import qualified Data.Foldable as F+import Data.Functor.Identity (Identity(Identity)) import Data.Hashable (Hashable)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import Data.Int+import qualified Data.Map.Strict as Map+import Data.Int (Int16, Int32, Int64, Int8) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.List (intersperse, sortBy)-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Monoid-import qualified Data.Semigroup as Semi+import Data.Monoid (All (..), Any (..), Dual (..),+ Product (..), Sum (..)) import Data.Ord (comparing)-+import Data.Proxy (Proxy (..))+import Data.Semigroup (Semigroup (..))+import qualified Data.Semigroup as Semi+import Data.Tagged (Tagged (..)) import Data.Text (Text) import qualified Data.Text as Text-import qualified Data.Text.Lazy as Lazy-import Data.Text.Encoding as Text+import qualified Data.Text.Encoding as Text import Data.Text.Encoding.Error (lenientDecode)--import Data.Time-import Data.Proxy-import Data.Word--#if MIN_VERSION_base(4,8,0)-import Data.Void-import Numeric.Natural-#endif--import GHC.Exts (IsList (..), Constraint)+import qualified Data.Text.Lazy as Lazy+import Data.Time.Compat (Day, LocalTime, NominalDiffTime,+ UTCTime, ZonedTime)+import Data.Time.Calendar.Month.Compat (Month)+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))+import Data.Void (Void, absurd)+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Exts (Constraint, IsList (..)) import GHC.Generics import GHC.TypeLits-import URI.ByteString (urlEncodeQuery, urlDecodeQuery)--import Web.Internal.HttpApiData+import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)+import Numeric.Natural (Natural)+import Web.Internal.HttpApiData -- $setup--- >>> :set -XDeriveGeneric--- >>> :set -XOverloadedLists--- >>> :set -XOverloadedStrings--- >>> :set -XFlexibleContexts--- >>> :set -XScopedTypeVariables--- >>> :set -XTypeFamilies+-- >>> :set -XDeriveGeneric -XOverloadedLists -XOverloadedStrings -XFlexibleContexts -XScopedTypeVariables -XTypeFamilies+-- >>> import GHC.Generics (Generic) -- >>> import Data.Char (toLower)+-- >>> import Data.Text (Text)+-- >>> import Data.Word (Word8) -- -- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic) -- >>> instance ToForm Person@@ -116,6 +105,9 @@ instance ToFormKey ZonedTime where toFormKey = toQueryParam instance ToFormKey UTCTime where toFormKey = toQueryParam instance ToFormKey NominalDiffTime where toFormKey = toQueryParam+instance ToFormKey Quarter where toFormKey = toQueryParam+instance ToFormKey QuarterOfYear where toFormKey = toQueryParam+instance ToFormKey Month where toFormKey = toQueryParam instance ToFormKey String where toFormKey = toQueryParam instance ToFormKey Text where toFormKey = toQueryParam@@ -124,14 +116,26 @@ instance ToFormKey All where toFormKey = toQueryParam instance ToFormKey Any where toFormKey = toQueryParam -instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getDual-instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum-instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct+instance ToFormKey a => ToFormKey (Dual a) where toFormKey = coerce (toFormKey :: a -> Text)+instance ToFormKey a => ToFormKey (Sum a) where toFormKey = coerce (toFormKey :: a -> Text)+instance ToFormKey a => ToFormKey (Product a) where toFormKey = coerce (toFormKey :: a -> Text) -#if MIN_VERSION_base(4,8,0)+instance ToFormKey a => ToFormKey (Semi.Min a) where toFormKey = coerce (toFormKey :: a -> Text)+instance ToFormKey a => ToFormKey (Semi.Max a) where toFormKey = coerce (toFormKey :: a -> Text)+instance ToFormKey a => ToFormKey (Semi.First a) where toFormKey = coerce (toFormKey :: a -> Text)+instance ToFormKey a => ToFormKey (Semi.Last a) where toFormKey = coerce (toFormKey :: a -> Text)++instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey = coerce (toFormKey :: a -> Text)++-- | @since 0.4.2+instance ToFormKey a => ToFormKey (Identity a) where toFormKey = coerce (toFormKey :: a -> Text)++-- | @since 0.4.2+instance ToFormKey a => ToFormKey (Const a b) where+ toFormKey = coerce (toFormKey :: a -> Text)+ instance ToFormKey Void where toFormKey = toQueryParam instance ToFormKey Natural where toFormKey = toQueryParam-#endif -- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'. class FromFormKey k where@@ -163,6 +167,9 @@ instance FromFormKey ZonedTime where parseFormKey = parseQueryParam instance FromFormKey UTCTime where parseFormKey = parseQueryParam instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam+instance FromFormKey Quarter where parseFormKey = parseQueryParam+instance FromFormKey QuarterOfYear where parseFormKey = parseQueryParam+instance FromFormKey Month where parseFormKey = parseQueryParam instance FromFormKey String where parseFormKey = parseQueryParam instance FromFormKey Text where parseFormKey = parseQueryParam@@ -171,20 +178,32 @@ instance FromFormKey All where parseFormKey = parseQueryParam instance FromFormKey Any where parseFormKey = parseQueryParam -instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . parseFormKey-instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey-instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey+instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)+instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)+instance FromFormKey a => FromFormKey (Product a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a) -#if MIN_VERSION_base(4,8,0)+instance FromFormKey a => FromFormKey (Semi.Min a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)+instance FromFormKey a => FromFormKey (Semi.Max a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)+instance FromFormKey a => FromFormKey (Semi.First a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)+instance FromFormKey a => FromFormKey (Semi.Last a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)++instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)++-- | @since 0.4.2+instance FromFormKey a => FromFormKey (Identity a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)++-- | @since 0.4.2+instance FromFormKey a => FromFormKey (Const a b) where+ parseFormKey = coerce (parseFormKey :: Text -> Either Text a)+ instance FromFormKey Void where parseFormKey = parseQueryParam instance FromFormKey Natural where parseFormKey = parseQueryParam-#endif -- | The contents of a form, not yet URL-encoded. -- -- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.-newtype Form = Form { unForm :: HashMap Text [Text] }- deriving (Eq, Read, Generic, Semi.Semigroup, Monoid)+newtype Form = Form { unForm :: Map.Map Text [Text] }+ deriving (Eq, Read, Generic, Semigroup, Monoid) instance Show Form where showsPrec d form = showParen (d > 10) $@@ -194,8 +213,8 @@ -- For a stable conversion use 'toListStable'. instance IsList Form where type Item Form = (Text, Text)- fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))- toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm+ fromList = Form . Map.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))+ toList = concatMap (\(k, vs) -> map ((,) k) vs) . Map.toList . unForm -- | A stable version of 'toList'. toListStable :: Form -> [(Text, Text)]@@ -245,15 +264,22 @@ instance ToForm Form where toForm = id +-- |+--+-- @since 0.6.3+instance ToForm Void where toForm = absurd++-- |+--+-- @since 0.6.3+instance ToForm () where toForm _ = Form Map.empty+ instance (ToFormKey k, ToHttpApiData v) => ToForm [(k, v)] where toForm = fromList . map (toFormKey *** toQueryParam) -instance (ToFormKey k, ToHttpApiData v) => ToForm (Map k [v]) where+instance (ToFormKey k, ToHttpApiData v) => ToForm (Map.Map k [v]) where toForm = fromEntriesByKey . Map.toList -instance (ToFormKey k, ToHttpApiData v) => ToForm (HashMap k [v]) where- toForm = fromEntriesByKey . HashMap.toList- instance ToHttpApiData v => ToForm (IntMap [v]) where toForm = fromEntriesByKey . IntMap.toList @@ -262,21 +288,16 @@ -- >>> fromEntriesByKey [("name",["Nick"]),("color",["red","blue"])] -- fromList [("color","red"),("color","blue"),("name","Nick")] fromEntriesByKey :: (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form-fromEntriesByKey = Form . HashMap.fromListWith (<>) . map (toFormKey *** map toQueryParam)+fromEntriesByKey = Form . Map.fromListWith (<>) . map (toFormKey *** map toQueryParam) data Proxy3 a b c = Proxy3 type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where-#if __GLASGOW_HASKELL__ < 800- -- this is just a placeholder case for older GHCs to not freak out on an empty closed type family- NotSupported cls a "this type family is actually empty" = ()-#else NotSupported cls a reason = TypeError ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$: 'ShowType a ':<>: 'Text " " ':<>: 'Text reason ':<>: 'Text "," ':$$: 'Text "but Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instances can be derived only for records" ':$$: 'Text "(i.e. product types with named fields)." )-#endif -- | A 'Generic'-based implementation of 'toForm'. -- This is used as a default implementation in 'ToForm'.@@ -328,7 +349,7 @@ instance (GToForm t f) => GToForm t (M1 C x f) where gToForm p opts (M1 a) = gToForm p opts a -instance OVERLAPPABLE_ (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where+instance {-# OVERLAPPABLE #-} (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)] where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)@@ -346,7 +367,7 @@ where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p) -instance OVERLAPPING_ (Selector s) => GToForm t (M1 S s (K1 i String)) where+instance {-# OVERLAPPING #-} (Selector s) => GToForm t (M1 S s (K1 i String)) where gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)] where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)@@ -396,16 +417,23 @@ instance FromForm Form where fromForm = pure +-- |+--+-- @since 0.6.3+instance FromForm Void where fromForm _ = Left "fromForm: Void"++-- |+--+-- @since 0.6.3+instance FromForm () where fromForm _ = Right ()+ -- | _NOTE:_ this conversion is unstable and may result in different key order (but not values). instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey -instance (Ord k, FromFormKey k, FromHttpApiData v) => FromForm (Map k [v]) where+instance (Ord k, Eq k, Hashable k, FromFormKey k, FromHttpApiData v) => FromForm (Map.Map k [v]) where fromForm = fmap (Map.fromListWith (<>)) . toEntriesByKey -instance (Eq k, Hashable k, FromFormKey k, FromHttpApiData v) => FromForm (HashMap k [v]) where- fromForm = fmap (HashMap.fromListWith (<>)) . toEntriesByKey- instance FromHttpApiData v => FromForm (IntMap [v]) where fromForm = fmap (IntMap.fromListWith (<>)) . toEntriesByKey @@ -414,7 +442,7 @@ -- _NOTE:_ this conversion is unstable and may result in different key order -- (but not values). For a stable encoding see 'toEntriesByKeyStable'. toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]-toEntriesByKey = traverse parseGroup . HashMap.toList . unForm+toEntriesByKey = traverse parseGroup . Map.toList . unForm where parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs @@ -476,7 +504,7 @@ instance GFromForm t f => GFromForm t (M1 C x f) where gFromForm p opts f = M1 <$> gFromForm p opts f -instance OVERLAPPABLE_ (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where+instance {-# OVERLAPPABLE #-} (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where gFromForm _ opts form = M1 . K1 <$> parseUnique key form where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)@@ -491,7 +519,7 @@ where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p) -instance OVERLAPPING_ (Selector s) => GFromForm t (M1 S s (K1 i String)) where+instance {-# OVERLAPPING #-} (Selector s) => GFromForm t (M1 S s (K1 i String)) where gFromForm _ opts form = M1 . K1 <$> parseUnique key form where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)@@ -543,10 +571,10 @@ urlEncodeParams :: [(Text, Text)] -> BSL.ByteString urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair where- escape = urlEncodeQuery . Text.encodeUtf8+ escape = urlEncodeBuilder True . Text.encodeUtf8 encodePair (k, "") = escape k- encodePair (k, v) = escape k <> shortByteString "=" <> escape v+ encodePair (k, v) = escape k <> shortByteString "=" <> escape v -- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'. --@@ -590,7 +618,7 @@ where pairs = map (BSL8.split '=') (BSL8.split '&' bs) - unescape = Text.decodeUtf8With lenientDecode . urlDecodeQuery . BSL.toStrict+ unescape = Text.decodeUtf8With lenientDecode . urlDecode True . BSL.toStrict parsePair p = case map unescape p of@@ -641,7 +669,7 @@ -- >>> lookupAll "name" [("name", "Oleg"), ("name", "David")] -- ["Oleg","David"] lookupAll :: Text -> Form -> [Text]-lookupAll key = F.concat . HashMap.lookup key . unForm+lookupAll key = F.concat . Map.lookup key . unForm -- | Lookup an optional value for a key. -- Fail if there is more than one value.
src/Web/Internal/HttpApiData.hs view
@@ -1,68 +1,84 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} -- | -- Convert Haskell values to and from HTTP API data -- such as URL pieces, headers and query parameters. module Web.Internal.HttpApiData where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-import Data.Foldable (Foldable)-import Data.Traversable (Traversable(traverse))-#endif--import Control.Arrow ((&&&), left)-import Control.Monad ((<=<))--import Data.Monoid-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS--import Data.Int-import Data.Word--import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8')-import Data.Text.Read (signed, decimal, rational, Reader)-import qualified Data.Text as T-import qualified Data.Text.Lazy as L--import Data.Time.Locale.Compat-import Data.Time-import Data.Version--#if MIN_VERSION_base(4,8,0)-import Data.Void-import Numeric.Natural-#endif--import Text.Read (readMaybe)-import Text.ParserCombinators.ReadP (readP_to_S)+import Control.Applicative (Const(Const))+import Control.Arrow (left, (&&&))+import Control.Monad ((<=<))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Coerce (coerce)+import Data.Data (Data)+import qualified Data.Fixed as F+import Data.Functor.Identity (Identity(Identity))+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Kind (Type)+import qualified Data.Map.Strict as Map+import Data.Monoid (All (..), Any (..), Dual (..),+ First (..), Last (..),+ Product (..), Sum (..))+import qualified Data.Semigroup as Semi+import Data.Tagged (Tagged (..))+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8', decodeUtf8With,+ encodeUtf8)+import Data.Text.Encoding.Error (lenientDecode)+import qualified Data.Text.Lazy as L+import Data.Text.Lazy.Builder (Builder, toLazyText)+import Data.Text.Read (Reader, decimal, rational,+ signed)+import qualified Data.Time.ToText as TT+import qualified Data.Time.FromText as FT+import Data.Time.Compat (Day, LocalTime,+ NominalDiffTime, TimeOfDay,+ UTCTime, ZonedTime, DayOfWeek (..),+ nominalDiffTimeToSeconds,+ secondsToNominalDiffTime)+import Data.Time.Calendar.Month.Compat (Month)+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))+import Data.Typeable (Typeable)+import qualified Data.UUID.Types as UUID+import Data.Version (Version, parseVersion,+ showVersion)+import Data.Void (Void, absurd)+import Data.Word (Word16, Word32, Word64, Word8)+import qualified Network.HTTP.Types as H+import Numeric.Natural (Natural)+import Text.ParserCombinators.ReadP (readP_to_S)+import Text.Read (readMaybe)+import Web.Cookie (SetCookie, parseSetCookie,+ renderSetCookie) #if USE_TEXT_SHOW-import TextShow (TextShow, showt)+import TextShow (TextShow, showt) #endif -import qualified Data.UUID.Types as UUID--import Data.Typeable (Typeable)-import Data.Data (Data)-import qualified Data.ByteString.Builder as BS-import qualified Network.HTTP.Types as H--import qualified Data.Attoparsec.Text as Atto-import qualified Data.Attoparsec.Time as Atto-- -- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Text (Text)+-- >>> import Data.Word (Word8)+-- >>> import Data.Text.Read (decimal)+-- >>> import Data.Time.Compat+-- >>> import Data.Time.Calendar.Month.Compat+-- >>> import Data.Time.Calendar.Quarter.Compat+-- >>> import Data.Version+-- >>> import Web.Cookie (SetCookie) -- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) -- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p @@ -77,10 +93,10 @@ toUrlPiece = toQueryParam -- | Convert to a URL path piece, making sure to encode any special chars.- -- The default definition uses 'H.encodePathSegmentsRelative',+ -- The default definition uses @'H.urlEncodeBuilder' 'False'@ -- but this may be overriden with a more efficient version. toEncodedUrlPiece :: a -> BS.Builder- toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece+ toEncodedUrlPiece = H.urlEncodeBuilder False . encodeUtf8 . toUrlPiece -- | Convert to HTTP header value. toHeader :: a -> ByteString@@ -90,6 +106,14 @@ toQueryParam :: a -> Text toQueryParam = toUrlPiece + -- | Convert to URL query param,+ -- The default definition uses @'H.urlEncodeBuilder' 'True'@+ -- but this may be overriden with a more efficient version.+ --+ -- @since 0.5.1+ toEncodedQueryParam :: a -> BS.Builder+ toEncodedQueryParam = H.urlEncodeBuilder True . encodeUtf8 . toQueryParam+ -- | Parse value from HTTP API data. -- -- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated@@ -322,7 +346,7 @@ -- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool -- Right True ----- For case sensitive parser see 'parseBoundedEnumOfI'.+-- For case insensitive parser see 'parseBoundedEnumOfI'. parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf @@ -406,12 +430,21 @@ unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece +-- | Convert to a URL-encoded query param using 'toQueryParam'.+-- /Note/: this function does not check if the result contains unescaped characters!+--+-- @since 0.5.1+unsafeToEncodedQueryParam :: ToHttpApiData a => a -> BS.Builder+unsafeToEncodedQueryParam = BS.byteString . encodeUtf8 . toQueryParam+ -- | -- >>> toUrlPiece () -- "_" instance ToHttpApiData () where- toUrlPiece () = "_"- toEncodedUrlPiece = unsafeToEncodedUrlPiece+ toUrlPiece _ = "_"+ toHeader _ = "_"+ toEncodedUrlPiece _ = "_"+ toEncodedQueryParam _ = "_" instance ToHttpApiData Char where toUrlPiece = T.singleton@@ -422,98 +455,192 @@ instance ToHttpApiData Version where toUrlPiece = T.pack . showVersion toEncodedUrlPiece = unsafeToEncodedUrlPiece+ toEncodedQueryParam = unsafeToEncodedQueryParam -#if MIN_VERSION_base(4,8,0) instance ToHttpApiData Void where toUrlPiece = absurd-instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-#endif+instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam -instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam -instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam +-- | Note: this instance is not polykinded+instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam+ -- | -- >>> toUrlPiece (fromGregorian 2015 10 03) -- "2015-10-03" instance ToHttpApiData Day where- toUrlPiece = T.pack . show+ toUrlPiece = runTT TT.buildDay toEncodedUrlPiece = unsafeToEncodedUrlPiece--timeToUrlPiece :: FormatTime t => String -> t -> Text-timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))+ toEncodedQueryParam = unsafeToEncodedQueryParam -- | -- >>> toUrlPiece $ TimeOfDay 14 55 23.1--- "14:55:23.1"+-- "14:55:23.100" instance ToHttpApiData TimeOfDay where- toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q"+ toUrlPiece = runTT TT.buildTimeOfDay toEncodedUrlPiece = unsafeToEncodedUrlPiece+ -- no toEncodedQueryParam as : is unsafe char. -- | -- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 21.687) -- "2015-10-03T14:55:21.687" instance ToHttpApiData LocalTime where- toUrlPiece = timeToUrlPiece "%H:%M:%S%Q"+ toUrlPiece = runTT TT.buildLocalTime toEncodedUrlPiece = unsafeToEncodedUrlPiece+ -- no toEncodedQueryParam as : is unsafe char. -- | -- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc--- "2015-10-03T14:55:51.001+0000"+-- "2015-10-03T14:55:51.001Z"+--+-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) (TimeZone 120 True "EET")+-- "2015-10-03T14:55:51.001+02:00"+-- instance ToHttpApiData ZonedTime where- toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z"+ toUrlPiece = runTT TT.buildZonedTime toEncodedUrlPiece = unsafeToEncodedUrlPiece+ -- no toEncodedQueryParam as : is unsafe char. -- | -- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5--- "2015-10-03T00:14:24.5Z"+-- "2015-10-03T00:14:24.500Z" instance ToHttpApiData UTCTime where- toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"+ toUrlPiece = runTT TT.buildUTCTime toEncodedUrlPiece = unsafeToEncodedUrlPiece+ -- no toEncodedQueryParam as : is unsafe char. +-- |+-- >>> toUrlPiece Monday+-- "monday"+instance ToHttpApiData DayOfWeek where+ toUrlPiece Monday = "monday"+ toUrlPiece Tuesday = "tuesday"+ toUrlPiece Wednesday = "wednesday"+ toUrlPiece Thursday = "thursday"+ toUrlPiece Friday = "friday"+ toUrlPiece Saturday = "saturday"+ toUrlPiece Sunday = "sunday"++ toEncodedUrlPiece = unsafeToEncodedUrlPiece+ toEncodedQueryParam = unsafeToEncodedQueryParam++-- |+-- >>> toUrlPiece Q4+-- "q4"+instance ToHttpApiData QuarterOfYear where+ toUrlPiece = runTT TT.buildQuarterOfYear++ toEncodedUrlPiece = unsafeToEncodedUrlPiece+ toEncodedQueryParam = unsafeToEncodedQueryParam++-- |+-- >>> import Data.Time.Calendar.Quarter.Compat (Quarter (..))+-- >>> MkQuarter 8040+-- 2010-Q1+--+-- >>> toUrlPiece $ MkQuarter 8040+-- "2010-q1"+--+instance ToHttpApiData Quarter where+ toUrlPiece = runTT TT.buildQuarter++ toEncodedUrlPiece = unsafeToEncodedUrlPiece+ toEncodedQueryParam = unsafeToEncodedQueryParam++-- |+-- >>> import Data.Time.Calendar.Month.Compat (Month (..))+-- >>> MkMonth 24482+-- 2040-03+--+-- >>> toUrlPiece $ MkMonth 24482+-- "2040-03"+--+instance ToHttpApiData Month where+ toUrlPiece = runTT TT.buildMonth++ toEncodedUrlPiece = unsafeToEncodedUrlPiece+ toEncodedQueryParam = unsafeToEncodedQueryParam+ instance ToHttpApiData NominalDiffTime where- toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)+ toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds++ toEncodedQueryParam = unsafeToEncodedQueryParam toEncodedUrlPiece = unsafeToEncodedUrlPiece instance ToHttpApiData String where toUrlPiece = T.pack instance ToHttpApiData Text where toUrlPiece = id instance ToHttpApiData L.Text where toUrlPiece = L.toStrict -instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll-instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny; toEncodedUrlPiece = toEncodedUrlPiece . getAny+instance ToHttpApiData All where+ toUrlPiece = coerce (toUrlPiece :: Bool -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: Bool -> BS.Builder) +instance ToHttpApiData Any where+ toUrlPiece = coerce (toUrlPiece :: Bool -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: Bool -> BS.Builder)+ instance ToHttpApiData a => ToHttpApiData (Dual a) where- toUrlPiece = toUrlPiece . getDual- toEncodedUrlPiece = toEncodedUrlPiece . getDual+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder) instance ToHttpApiData a => ToHttpApiData (Sum a) where- toUrlPiece = toUrlPiece . getSum- toEncodedUrlPiece = toEncodedUrlPiece . getSum+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder) instance ToHttpApiData a => ToHttpApiData (Product a) where- toUrlPiece = toUrlPiece . getProduct- toEncodedUrlPiece = toEncodedUrlPiece . getProduct+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder) instance ToHttpApiData a => ToHttpApiData (First a) where- toUrlPiece = toUrlPiece . getFirst- toEncodedUrlPiece = toEncodedUrlPiece . getFirst+ toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: Maybe a -> BS.Builder) instance ToHttpApiData a => ToHttpApiData (Last a) where- toUrlPiece = toUrlPiece . getLast- toEncodedUrlPiece = toEncodedUrlPiece . getLast+ toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: Maybe a -> BS.Builder) +instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)++instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)++instance ToHttpApiData a => ToHttpApiData (Semi.First a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)++instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)+ -- | -- >>> toUrlPiece (Just "Hello") -- "just Hello"@@ -530,6 +657,44 @@ toUrlPiece (Left x) = "left " <> toUrlPiece x toUrlPiece (Right x) = "right " <> toUrlPiece x +-- | /Note:/ this instance works correctly for alphanumeric name and value+--+-- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie+-- >>> toUrlPiece c+-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"+--+-- >>> toHeader c+-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"+--+instance ToHttpApiData SetCookie where+ toUrlPiece = decodeUtf8With lenientDecode . toHeader+ toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie+ -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.++-- | Note: this instance is not polykinded+instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toHeader = coerce (toHeader :: a -> ByteString)+ toQueryParam = coerce (toQueryParam :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)++-- | @since 0.4.2+instance ToHttpApiData a => ToHttpApiData (Const a b) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toHeader = coerce (toHeader :: a -> ByteString)+ toQueryParam = coerce (toQueryParam :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)++-- | @since 0.4.2+instance ToHttpApiData a => ToHttpApiData (Identity a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toHeader = coerce (toHeader :: a -> ByteString)+ toQueryParam = coerce (toQueryParam :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)+ -- | -- >>> parseUrlPiece "_" :: Either Text () -- Right ()@@ -541,7 +706,7 @@ parseUrlPiece s = case T.uncons s of Just (c, s') | T.null s' -> pure c- _ -> defaultParseError s+ _ -> defaultParseError s -- | -- >>> showVersion <$> parseUrlPiece "1.2.3"@@ -552,7 +717,6 @@ ((x, ""):_) -> pure x _ -> defaultParseError s -#if MIN_VERSION_base(4,8,0) -- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors. instance FromHttpApiData Void where parseUrlPiece _ = Left "Void cannot be parsed!"@@ -563,7 +727,6 @@ if n < 0 then Left ("underflow: " <> s <> " (should be a non-negative integer)") else Right (fromInteger n)-#endif instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece@@ -584,20 +747,24 @@ instance FromHttpApiData Text where parseUrlPiece = Right instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict +-- | Note: this instance is not polykinded+instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where+ parseUrlPiece = runReader rational+ -- | -- >>> toGregorian <$> parseUrlPiece "2016-12-01" -- Right (2016,12,1)-instance FromHttpApiData Day where parseUrlPiece = runAtto Atto.day+instance FromHttpApiData Day where parseUrlPiece = runFT FT.parseDay -- | -- >>> parseUrlPiece "14:55:01.333" :: Either Text TimeOfDay -- Right 14:55:01.333-instance FromHttpApiData TimeOfDay where parseUrlPiece = runAtto Atto.timeOfDay+instance FromHttpApiData TimeOfDay where parseUrlPiece = runFT FT.parseTimeOfDay -- | -- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime -- Right 2015-10-03 14:55:01-instance FromHttpApiData LocalTime where parseUrlPiece = runAtto Atto.localTime+instance FromHttpApiData LocalTime where parseUrlPiece = runFT FT.parseLocalTime -- | -- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime@@ -605,25 +772,60 @@ -- -- >>> parseQueryParam "2016-12-31T01:00:00Z" :: Either Text ZonedTime -- Right 2016-12-31 01:00:00 +0000-instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime+instance FromHttpApiData ZonedTime where parseUrlPiece = runFT FT.parseZonedTime -- | -- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime -- Right 2015-10-03 00:14:24 UTC-instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime+instance FromHttpApiData UTCTime where parseUrlPiece = runFT FT.parseUTCTime -instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece+-- |+-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek+-- Right Monday+instance FromHttpApiData DayOfWeek where+ parseUrlPiece t = case Map.lookup (T.toLower t) m of+ Just dow -> Right dow+ Nothing -> Left $ "Incorrect DayOfWeek: " <> T.take 10 t+ where+ m :: Map.Map Text DayOfWeek+ m = Map.fromList [ (toUrlPiece dow, dow) | dow <- [Monday .. Sunday] ] -instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece-instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece -instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece-instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece-instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece-instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece-instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece -- |+-- >>> parseUrlPiece "2021-01" :: Either Text Month+-- Right 2021-01+instance FromHttpApiData Month where parseUrlPiece = runFT FT.parseMonth++-- |+-- >>> parseUrlPiece "2021-q1" :: Either Text Quarter+-- Right 2021-Q1+instance FromHttpApiData Quarter where parseUrlPiece = runFT FT.parseQuarter++-- |+-- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear+-- Right Q2+--+-- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear+-- Right Q3+instance FromHttpApiData QuarterOfYear where parseUrlPiece = runFT FT.parseQuarterOfYear++instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)+instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)++instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))++instance FromHttpApiData a => FromHttpApiData (Semi.Min a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+instance FromHttpApiData a => FromHttpApiData (Semi.Max a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+instance FromHttpApiData a => FromHttpApiData (Semi.First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+instance FromHttpApiData a => FromHttpApiData (Semi.Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)++-- | -- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int) -- Right (Just 123) instance FromHttpApiData a => FromHttpApiData (Maybe a) where@@ -664,11 +866,40 @@ parseHeader = Right . LenientData . parseHeader parseQueryParam = Right . LenientData . parseQueryParam +-- | /Note:/ this instance works correctly for alphanumeric name and value+--+-- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie+-- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing, setCookiePartitioned = False})+instance FromHttpApiData SetCookie where+ parseUrlPiece = parseHeader . encodeUtf8+ parseHeader = Right . parseSetCookie++-- | Note: this instance is not polykinded+instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where+ parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+ parseHeader = coerce (parseHeader :: ByteString -> Either Text a)+ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)++-- | @since 0.4.2+instance FromHttpApiData a => FromHttpApiData (Const a b) where+ parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+ parseHeader = coerce (parseHeader :: ByteString -> Either Text a)+ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)++-- | @since 0.4.2+instance FromHttpApiData a => FromHttpApiData (Identity a) where+ parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)+ parseHeader = coerce (parseHeader :: ByteString -> Either Text a)+ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)+ ---------------------------------------------------------------------------------- Attoparsec helpers+-- Helpers ------------------------------------------------------------------------------- -runAtto :: Atto.Parser a -> Text -> Either Text a-runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of+runTT :: (a -> Builder) -> a -> Text+runTT f x = L.toStrict (toLazyText (f x))++runFT :: (Text -> Either String a) -> Text -> Either Text a+runFT f t = case f t of Left err -> Left (T.pack err) Right x -> Right x
test/Web/Internal/FormUrlEncodedSpec.hs view
@@ -1,16 +1,10 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Web.Internal.FormUrlEncodedSpec (spec) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-import Data.Monoid-#endif- import Control.Monad ((<=<)) import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map.Strict as Map import Data.Text (Text, unpack) import Test.Hspec import Test.QuickCheck@@ -33,24 +27,24 @@ it "contains the record names" $ property $ \(x :: SimpleRec) -> do let f = unForm $ toForm x- HashMap.member "rec1" f `shouldBe` True- HashMap.member "rec2" f `shouldBe` True+ Map.member "rec1" f `shouldBe` True+ Map.member "rec2" f `shouldBe` True it "contains the correct record values" $ property $ \(x :: SimpleRec) -> do let f = unForm $ toForm x- HashMap.lookup "rec1" f `shouldBe` Just [rec1 x]- (parseQueryParams <$> HashMap.lookup "rec2" f) `shouldBe` Just (Right [rec2 x])+ Map.lookup "rec1" f `shouldBe` Just [rec1 x]+ (parseQueryParams <$> Map.lookup "rec2" f) `shouldBe` Just (Right [rec2 x]) context "FromForm" $ do it "is the right inverse of ToForm" $ property $ \x (y :: Int) -> do let f1 = fromList [("rec1", x), ("rec2", toQueryParam y)]- Right r1 = fromForm f1 :: Either Text SimpleRec- toForm r1 `shouldBe` f1+ r1 = fromForm f1 :: Either Text SimpleRec+ fmap toForm r1 `shouldBe` Right f1 it "returns the underlying error" $ do let f = fromList [("rec1", "anything"), ("rec2", "bad")]- Left e = fromForm f :: Either Text SimpleRec+ e = either id (const "no error") (fromForm f :: Either Text SimpleRec) unpack e `shouldContain` "input does not start with a digit" urlEncoding :: Spec
test/Web/Internal/HttpApiDataSpec.hs view
@@ -1,32 +1,36 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Web.Internal.HttpApiDataSpec (spec) where -import Control.Applicative-import Data.Int-import Data.Word-import Data.Time-import qualified Data.Text as T-import qualified Data.Text.Lazy as L-import qualified Data.ByteString as BS-import Data.ByteString.Builder (toLazyByteString)-import Data.Version-import qualified Data.UUID.Types as UUID -import Data.Proxy+import qualified Data.ByteString as BS+import Data.ByteString.Builder (toLazyByteString)+import Data.Char+import qualified Data.Fixed as F+import Data.Int+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as L+import Data.Time.Compat+import Data.Time.Calendar.Month.Compat (Month)+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))+import qualified Data.UUID.Types as UUID+import Data.Version+import Data.Word+import Web.Cookie (SetCookie, defaultSetCookie,+ setCookieName, setCookieValue) -#if MIN_VERSION_base(4,8,0)-import Numeric.Natural-#endif+import Data.Proxy -import Test.Hspec-import Test.Hspec.QuickCheck(prop)-import Test.QuickCheck+import Numeric.Natural -import Web.Internal.HttpApiData+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck -import Web.Internal.TestInstances+import Web.Internal.HttpApiData +import Web.Internal.TestInstances+ (<=>) :: forall a b. (Show a, Show b, Eq a) => (a -> b) -> (b -> Either T.Text a) -> a -> Property (f <=> g) x = counterexample (show lhs' ++ " : " ++ show lhs ++ " /= " ++ show rhs)@@ -39,30 +43,28 @@ encodedUrlPieceProp :: ToHttpApiData a => a -> Property encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x) +encodedQueryParamProp :: ToHttpApiData a => a -> Property+encodedQueryParamProp x = toLazyByteString (toEncodedQueryParam (toQueryParam x)) === toLazyByteString (toEncodedQueryParam x) +-- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec-checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Property)+checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a) --- | Check with given generator checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec-checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)+checkUrlPiece' gen name = describe name $ do+ prop "toUrlPiece <=> parseUrlPiece" $ forAll gen (toUrlPiece <=> parseUrlPiece :: a -> Property)+ prop "toQueryParam <=> parseQueryParam" $ forAll gen (toQueryParam <=> parseQueryParam :: a -> Property)+ prop "toHeader <=> parseHeader" $ forAll gen (toHeader <=> parseHeader :: a -> Property)+ prop "toEncodedUrlPiece encodes correctly" $ forAll gen encodedUrlPieceProp+ prop "toEncodedQueryParam encodes correctly" $ forAll gen encodedQueryParamProp -- | Check case insensitivity for @parseUrlPiece@. checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a)) --- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.-checkEncodedUrlPiece :: forall a. (Show a, ToHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec-checkEncodedUrlPiece _ = checkEncodedUrlPiece' (arbitrary :: Gen a)---- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.--- Use a given generator.-checkEncodedUrlPiece' :: forall a. (Show a, ToHttpApiData a) => Gen a -> String -> Spec-checkEncodedUrlPiece' gen name = prop name $ forAll gen encodedUrlPieceProp- spec :: Spec spec = do- describe "toUrlPiece <=> parseUrlPiece" $ do+ describe "Instances" $ do checkUrlPiece (Proxy :: Proxy ()) "()" checkUrlPiece (Proxy :: Proxy Char) "Char" checkUrlPieceI (Proxy :: Proxy Bool) "Bool"@@ -82,60 +84,35 @@ checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict" checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy" checkUrlPiece (Proxy :: Proxy Day) "Day"- checkUrlPiece' timeOfDayGen "TimeOfDay"- checkUrlPiece' localTimeGen "LocalTime"- checkUrlPiece' zonedTimeGen "ZonedTime"- checkUrlPiece' utcTimeGen "UTCTime"- checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"+ checkUrlPiece (Proxy :: Proxy TimeOfDay) "TimeOfDay"+ checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"+ checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"+ checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"+ checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"+ checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek"+ checkUrlPiece (Proxy :: Proxy Quarter) "Quarter"+ checkUrlPiece (Proxy :: Proxy QuarterOfYear) "QuarterOfYear"+ checkUrlPiece (Proxy :: Proxy Month) "Month"+ checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek" checkUrlPiece (Proxy :: Proxy Version) "Version"- checkUrlPiece' uuidGen "UUID"+ checkUrlPiece (Proxy :: Proxy UUID.UUID) "UUID"+ checkUrlPiece' setCookieGen "Cookie" + checkUrlPiece (Proxy :: Proxy F.Uni) "Uni"+ checkUrlPiece (Proxy :: Proxy F.Deci) "Deci"+ checkUrlPiece (Proxy :: Proxy F.Centi) "Centi"+ checkUrlPiece (Proxy :: Proxy F.Milli) "Milli"+ checkUrlPiece (Proxy :: Proxy F.Micro) "Micro"+ checkUrlPiece (Proxy :: Proxy F.Nano) "Nano"+ checkUrlPiece (Proxy :: Proxy F.Pico) "Pico"+ checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String" checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer" checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text" checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day" -#if MIN_VERSION_base(4,8,0) checkUrlPiece (Proxy :: Proxy Natural) "Natural"-#endif - describe "toEncodedUrlPiece encodes correctly" $ do- checkEncodedUrlPiece (Proxy :: Proxy ()) "()"- checkEncodedUrlPiece (Proxy :: Proxy Char) "Char"- checkEncodedUrlPiece (Proxy :: Proxy Bool) "Bool"- checkEncodedUrlPiece (Proxy :: Proxy Ordering) "Ordering"- checkEncodedUrlPiece (Proxy :: Proxy Int) "Int"- checkEncodedUrlPiece (Proxy :: Proxy Int8) "Int8"- checkEncodedUrlPiece (Proxy :: Proxy Int16) "Int16"- checkEncodedUrlPiece (Proxy :: Proxy Int32) "Int32"- checkEncodedUrlPiece (Proxy :: Proxy Int64) "Int64"- checkEncodedUrlPiece (Proxy :: Proxy Integer) "Integer"- checkEncodedUrlPiece (Proxy :: Proxy Word) "Word"- checkEncodedUrlPiece (Proxy :: Proxy Word8) "Word8"- checkEncodedUrlPiece (Proxy :: Proxy Word16) "Word16"- checkEncodedUrlPiece (Proxy :: Proxy Word32) "Word32"- checkEncodedUrlPiece (Proxy :: Proxy Word64) "Word64"- checkEncodedUrlPiece (Proxy :: Proxy String) "String"- checkEncodedUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"- checkEncodedUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"- checkEncodedUrlPiece (Proxy :: Proxy Day) "Day"- checkEncodedUrlPiece' timeOfDayGen "TimeOfDay"- checkEncodedUrlPiece' localTimeGen "LocalTime"- checkEncodedUrlPiece' zonedTimeGen "ZonedTime"- checkEncodedUrlPiece' utcTimeGen "UTCTime"- checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime"- checkEncodedUrlPiece (Proxy :: Proxy Version) "Version"- checkEncodedUrlPiece' uuidGen "UUID"-- checkEncodedUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"- checkEncodedUrlPiece (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"- checkEncodedUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"- checkEncodedUrlPiece (Proxy :: Proxy (Either Version Day)) "Either Version Day"--#if MIN_VERSION_base(4,8,0)- checkEncodedUrlPiece (Proxy :: Proxy Natural) "Natural"-#endif- it "bad integers are rejected" $ do parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int) @@ -146,27 +123,8 @@ it "invalid utf8 is handled" $ do parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text) --uuidGen :: Gen UUID.UUID-uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary---- TODO: this generators don't generate full range items-localTimeGen :: Gen LocalTime-localTimeGen = LocalTime <$> arbitrary <*> timeOfDayGen--timeOfDayGen :: Gen TimeOfDay-timeOfDayGen = TimeOfDay- <$> choose (0, 23)- <*> choose (0, 59)- <*> fmap (\x -> 0.1 * fromInteger x) (choose (0, 600))--zonedTimeGen :: Gen ZonedTime-zonedTimeGen = ZonedTime- <$> localTimeGen -- Note: not arbitrary!- <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))--utcTimeGen :: Gen UTCTime-utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))--nominalDiffTimeGen :: Gen NominalDiffTime-nominalDiffTimeGen = fromInteger <$> arbitrary+setCookieGen :: Gen SetCookie+setCookieGen = do+ n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary+ v <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary+ return $ defaultSetCookie { setCookieName = n, setCookieValue = v }
test/Web/Internal/TestInstances.hs view
@@ -8,11 +8,11 @@ , NoEmptyKeyForm(..) ) where -import Control.Applicative+import Control.Applicative -- for ghc < 9.6 import Data.Char-import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map.Strict as Map import qualified Data.Text as T-import Data.Time+import Data.Time.Compat import GHC.Exts (fromList) import GHC.Generics @@ -63,4 +63,4 @@ instance Arbitrary NoEmptyKeyForm where arbitrary = NoEmptyKeyForm . removeEmptyKeys <$> arbitrary where- removeEmptyKeys (Form m) = Form (HashMap.delete "" m)+ removeEmptyKeys (Form m) = Form (Map.delete "" m)
− test/doctests.hs
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Main (doctests)--- Copyright : (C) 2012-14 Edward Kmett--- License : BSD-style (see the file LICENSE)--- Maintainer : Edward Kmett <ekmett@gmail.com>--- Stability : provisional--- Portability : portable------ This module provides doctests for a project based on the actual versions--- of the packages it was built with. It requires a corresponding Setup.lhs--- to be added to the project-------------------------------------------------------------------------------module Main where--import Build_doctests (flags, pkgs, module_sources)-import Data.Foldable (traverse_)-import Test.DocTest--main :: IO ()-main = do- traverse_ putStrLn args- doctest args- where- args = flags ++ pkgs ++ module_sources