http-api-data 0.3.10 → 0.4
raw patch · 5 files changed
+212/−159 lines, 5 filesdep +base-compatdep +natsdep +taggeddep ~attoparsec-iso8601dep ~bytestringdep ~hspec
Dependencies added: base-compat, nats, tagged, void
Dependency ranges changed: attoparsec-iso8601, bytestring, hspec, http-types
Files
- CHANGELOG.md +7/−0
- http-api-data.cabal +19/−10
- src/Web/Internal/FormUrlEncoded.hs +36/−31
- src/Web/Internal/HttpApiData.hs +119/−61
- test/Web/Internal/HttpApiDataSpec.hs +31/−57
CHANGELOG.md view
@@ -1,3 +1,10 @@+0.4+---++* `NominalDiffTime` instances preserve precision (roundtrip)+* Add `Semigroup.Min`, `Max`, `First`, `Last` instances+* Add `Tagged b a` instances+ 0.3.10 ---
http-api-data.cabal view
@@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: http-api-data-version: 0.3.10+version: 0.4 synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters. category: Web@@ -22,13 +22,14 @@ 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.3,- GHC==8.6.1+ GHC==8.4.4,+ GHC==8.6.2 custom-setup setup-depends:@@ -55,14 +56,21 @@ -- other-dependencies build-depends: attoparsec >= 0.13.2.2 && < 0.14- , attoparsec-iso8601 >= 1.0.0.0 && < 1.1+ , attoparsec-iso8601 >= 1.0.1.0 && < 1.1+ , base-compat >= 0.10.5 && < 0.11 , cookie >= 0.4.3 && < 0.4.5 , hashable >= 1.2.7.0 && < 1.3- , http-types >= 0.12.1 && < 0.13+ , http-types >= 0.12.2 && < 0.13+ , tagged >= 0.8.5 && < 0.9 , time-locale-compat >= 0.1.1.5 && < 0.2 , unordered-containers >= 0.2.9.0 && < 0.3 , uuid-types >= 1.0.3 && <1.1 + if !impl(ghc >= 7.10)+ build-depends:+ nats >= 1.1.2 && < 1.2,+ void >= 0.7.2 && < 0.8+ if !impl(ghc >= 8.0) build-depends: semigroups >= 0.18.5 && < 0.19 @@ -88,21 +96,22 @@ hs-source-dirs: test ghc-options: -Wall default-language: Haskell2010- build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.6+ build-tool-depends: hspec-discover:hspec-discover >= 2.6.0 && <2.7 -- inherited depndencies build-depends: base+ , base-compat , bytestring- , unordered-containers+ , cookie , http-api-data+ , nats , text , time- , bytestring+ , unordered-containers , uuid-types- , cookie build-depends: HUnit >= 1.6.0.0 && <1.7- , hspec >= 2.5.5 && <2.6+ , hspec >= 2.6.0 && <2.7 , QuickCheck >= 2.11.3 && <2.13 , quickcheck-instances >= 0.3.19 && <0.4
src/Web/Internal/FormUrlEncoded.hs view
@@ -17,51 +17,46 @@ #include "overlapping-compat.h" module Web.Internal.FormUrlEncoded where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-import Data.Traversable-#endif-+import Prelude ()+import Prelude.Compat import Control.Arrow ((***)) import Control.Monad ((<=<)) 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.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap-import Data.Int+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 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 Data.Text.Encoding as Text+import qualified Data.Text.Encoding as Text import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as Lazy--import Data.Proxy-import Data.Time-import Data.Word--#if MIN_VERSION_base(4,8,0)-import Data.Void-import Numeric.Natural-#endif-+import Data.Time (Day, LocalTime, NominalDiffTime,+ UTCTime, ZonedTime)+import Data.Void (Void)+import Data.Word (Word16, Word32, Word64, Word8) import GHC.Exts (Constraint, IsList (..)) import GHC.Generics import GHC.TypeLits import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)-+import Numeric.Natural (Natural) import Web.Internal.HttpApiData -- $setup@@ -124,14 +119,19 @@ 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)+ 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@@ -171,20 +171,25 @@ 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)+ 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)+ deriving (Eq, Read, Generic, Semigroup, Monoid) instance Show Form where showsPrec d form = showParen (d > 10) $
src/Web/Internal/HttpApiData.hs view
@@ -13,67 +13,70 @@ -- 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 Prelude ()+import Prelude.Compat import Control.Arrow (left, (&&&)) import Control.Monad ((<=<))-+import qualified Data.Attoparsec.Text as Atto+import qualified Data.Attoparsec.Time as Atto 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.Monoid-+import Data.Coerce (coerce)+import Data.Data (Data) import qualified Data.Fixed as F-import Data.Int-import Data.Word-+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Monoid (All (..), Any (..), Dual (..),+ First (..), Last (..),+ Product (..), Sum (..))+import Data.Semigroup (Semigroup (..))+import qualified Data.Semigroup as Semi+import Data.Tagged (Tagged (..)) import Data.Text (Text) import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf8With, decodeUtf8', encodeUtf8)+import Data.Text.Encoding (decodeUtf8', decodeUtf8With,+ encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as L import Data.Text.Read (Reader, decimal, rational, signed)--import Data.Time-#if __GLASGOW_HASKELL__ < 710-import Data.Time.Locale.Compat-#endif-import Data.Version--#if MIN_VERSION_base(4,8,0)-import Data.Void-import Numeric.Natural-#endif-+import Data.Time (Day, FormatTime, LocalTime,+ NominalDiffTime, TimeOfDay,+ UTCTime, ZonedTime, formatTime)+import Data.Time.Locale.Compat (defaultTimeLocale,+ iso8601DateFormat)+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 MIN_VERSION_time(1,9,1)+import Data.Time (nominalDiffTimeToSeconds,+ secondsToNominalDiffTime)+#endif+ #if USE_TEXT_SHOW import TextShow (TextShow, showt) #endif -import qualified Data.UUID.Types as UUID -import qualified Data.ByteString.Builder as BS-import Data.Data (Data)-import Data.Typeable (Typeable)-import qualified Network.HTTP.Types as H -import qualified Data.Attoparsec.Text as Atto-import qualified Data.Attoparsec.Time as Atto -import Web.Cookie (SetCookie, parseSetCookie,- renderSetCookie)-- -- $setup -- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) -- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p+-- >>> import Data.Time+-- >>> import Data.Version -- | Convert value to HTTP API data. --@@ -432,10 +435,8 @@ toUrlPiece = T.pack . showVersion toEncodedUrlPiece = unsafeToEncodedUrlPiece -#if MIN_VERSION_base(4,8,0) instance ToHttpApiData Void where toUrlPiece = absurd instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece-#endif instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece@@ -494,37 +495,78 @@ toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ" toEncodedUrlPiece = unsafeToEncodedUrlPiece +-- The CPP in both this function and the function after it are to avoid+-- exporting @nominalDiffTimeToSeconds@ and @secondsToNominalDiffTime@,+-- since these names are already used by @Data.Time@ from the @time@ library+-- starting in version @1.9.1@.+nominalDiffTimeToSecs :: NominalDiffTime -> F.Pico+nominalDiffTimeToSecs =+#if !MIN_VERSION_time(1,9,1)+ realToFrac+#else+ nominalDiffTimeToSeconds+#endif++secsToNominalDiffTime :: F.Pico -> NominalDiffTime+secsToNominalDiffTime =+#if !MIN_VERSION_time(1,9,1)+ realToFrac+#else+ secondsToNominalDiffTime+#endif+ instance ToHttpApiData NominalDiffTime where- toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)+ toUrlPiece = toUrlPiece . nominalDiffTimeToSecs 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) +instance ToHttpApiData Any where+ toUrlPiece = coerce (toUrlPiece :: Bool -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: 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) instance ToHttpApiData a => ToHttpApiData (Sum a) where- toUrlPiece = toUrlPiece . getSum- toEncodedUrlPiece = toEncodedUrlPiece . getSum+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: 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) 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) 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) +instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)++instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)++instance ToHttpApiData a => ToHttpApiData (Semi.First a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)++instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ -- | -- >>> toUrlPiece (Just "Hello") -- "just Hello"@@ -555,6 +597,12 @@ toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie -- toEncodedUrlPiece = renderSetCookie -- doesn't do things. +instance ToHttpApiData a => ToHttpApiData (Tagged b a) where+ toUrlPiece = coerce (toUrlPiece :: a -> Text)+ toHeader = coerce (toHeader :: a -> ByteString)+ toQueryParam = coerce (toQueryParam :: a -> Text)+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)+ -- | -- >>> parseUrlPiece "_" :: Either Text () -- Right ()@@ -566,7 +614,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"@@ -577,7 +625,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!"@@ -588,7 +635,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@@ -640,17 +686,22 @@ -- Right 2015-10-03 00:14:24 UTC instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime -instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secsToNominalDiffTime . parseUrlPiece -instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece-instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece+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 = 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 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)@@ -700,6 +751,11 @@ parseUrlPiece = parseHeader . encodeUtf8 parseHeader = Right . parseSetCookie +instance FromHttpApiData a => FromHttpApiData (Tagged b 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 -------------------------------------------------------------------------------@@ -708,3 +764,5 @@ runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of Left err -> Left (T.pack err) Right x -> Right x++
test/Web/Internal/HttpApiDataSpec.hs view
@@ -1,36 +1,37 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Web.Internal.HttpApiDataSpec (spec) where -import Control.Applicative-import qualified Data.Fixed as F-import Data.Int-import Data.Char-import Data.Word-import Data.Time-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-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 Web.Cookie (SetCookie, defaultSetCookie, setCookieName, setCookieValue) -import Data.Proxy+import Prelude ()+import Prelude.Compat -#if MIN_VERSION_base(4,8,0)-import Numeric.Natural-#endif+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+import qualified Data.UUID.Types as UUID+import Data.Version+import Data.Word+import Web.Cookie (SetCookie, defaultSetCookie,+ setCookieName, setCookieValue) -import Test.Hspec-import Test.Hspec.QuickCheck(prop)-import Test.QuickCheck+import Data.Proxy -import Web.Internal.HttpApiData+import Numeric.Natural -import Web.Internal.TestInstances+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck +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)@@ -80,13 +81,13 @@ 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 Version) "Version"- checkUrlPiece' uuidGen "UUID"+ checkUrlPiece (Proxy :: Proxy UUID.UUID) "UUID" checkUrlPiece' setCookieGen "Cookie" checkUrlPiece (Proxy :: Proxy F.Uni) "Uni"@@ -102,9 +103,7 @@ 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 it "bad integers are rejected" $ do parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)@@ -115,31 +114,6 @@ 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