git.iko.soy/typeable/http-api-data
on master help sign in
Use quickcheck-instances, nats and void for compat
commit94210bcc61be608f75636407a7ccda3a248cce9a authorOleg Grenrus <oleg.grenrus@iki.fi> dateTue 13 Nov 2018, 11:48 (8 years ago) parent283c747
4 files changed+26−68
compare with master
unifiedsplit
http-api-data.cabal+13−7 src/Web/Internal/FormUrlEncoded.hs+2−11 src/Web/Internal/HttpApiData.hs+5−15 test/Web/Internal/HttpApiDataSpec.hs+6−35
http-api-data.cabal+13−7
@@ -55,14 +55,20 @@ library
5555 -- other-dependencies
5656 build-depends:
5757 attoparsec >= 0.13.2.2 && < 0.14
58− , attoparsec-iso8601 >= 1.0.0.0 && < 1.1
58+ , attoparsec-iso8601 >= 1.0.1.0 && < 1.1
59+ , base-compat >= 0.10.5 && < 0.11
5960 , cookie >= 0.4.3 && < 0.4.5
6061 , hashable >= 1.2.7.0 && < 1.3
61− , http-types >= 0.12.1 && < 0.13
62+ , http-types >= 0.12.2 && < 0.13
6263 , time-locale-compat >= 0.1.1.5 && < 0.2
6364 , unordered-containers >= 0.2.9.0 && < 0.3
6465 , uuid-types >= 1.0.3 && <1.1
6566
67+ if !impl(ghc >= 7.10)
68+ build-depends:
69+ nats >= 1.1.2 && < 1.2,
70+ void >= 0.7.2 && < 0.8
71+
6672 if !impl(ghc >= 8.0)
6773 build-depends: semigroups >= 0.18.5 && < 0.19
6874
@@ -88,21 +94,21 @@ test-suite spec
8894 hs-source-dirs: test
8995 ghc-options: -Wall
9096 default-language: Haskell2010
91− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.6
97+ build-tool-depends: hspec-discover:hspec-discover >= 2.6.0 && <2.7
9298 -- inherited depndencies
9399 build-depends:
94100 base
95101 , bytestring
96− , unordered-containers
102+ , cookie
97103 , http-api-data
104+ , nats
98105 , text
99106 , time
100− , bytestring
107+ , unordered-containers
101108 , uuid-types
102− , cookie
103109
104110 build-depends: HUnit >= 1.6.0.0 && <1.7
105− , hspec >= 2.5.5 && <2.6
111+ , hspec >= 2.6.0 && <2.7
106112 , QuickCheck >= 2.11.3 && <2.13
107113 , quickcheck-instances >= 0.3.19 && <0.4
108114
src/Web/Internal/FormUrlEncoded.hs+2−11
@@ -17,11 +17,8 @@
1717#include "overlapping-compat.h"
1818module Web.Internal.FormUrlEncoded where
1919
20−#if __GLASGOW_HASKELL__ < 710
21−import Control.Applicative
22−import Data.Traversable
23−#endif
24−
20+import Prelude ()
21+import Prelude.Compat
2522
2623import Control.Arrow ((***))
2724import Control.Monad ((<=<))
@@ -52,10 +49,8 @@ import Data.Proxy
5249import Data.Time
5350import Data.Word
5451
55−#if MIN_VERSION_base(4,8,0)
5652import Data.Void
5753import Numeric.Natural
58−#endif
5954
6055import GHC.Exts (Constraint, IsList (..))
6156import GHC.Generics
@@ -128,10 +123,8 @@ instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getD
128123instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum
129124instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
130125
131−#if MIN_VERSION_base(4,8,0)
132126instance ToFormKey Void where toFormKey = toQueryParam
133127instance ToFormKey Natural where toFormKey = toQueryParam
134−#endif
135128
136129-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
137130class FromFormKey k where
@@ -175,10 +168,8 @@ instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual
175168instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey
176169instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
177170
178−#if MIN_VERSION_base(4,8,0)
179171instance FromFormKey Void where parseFormKey = parseQueryParam
180172instance FromFormKey Natural where parseFormKey = parseQueryParam
181−#endif
182173
183174-- | The contents of a form, not yet URL-encoded.
184175--
src/Web/Internal/HttpApiData.hs+5−15
@@ -13,11 +13,8 @@
1313-- such as URL pieces, headers and query parameters.
1414module Web.Internal.HttpApiData where
1515
16−#if __GLASGOW_HASKELL__ < 710
17−import Control.Applicative
18−import Data.Foldable (Foldable)
19−import Data.Traversable (Traversable (traverse))
20−#endif
16+import Prelude ()
17+import Prelude.Compat
2118
2219import Control.Arrow (left, (&&&))
2320import Control.Monad ((<=<))
@@ -33,22 +30,19 @@ import Data.Word
3330
3431import Data.Text (Text)
3532import qualified Data.Text as T
36−import Data.Text.Encoding (decodeUtf8With, decodeUtf8', encodeUtf8)
33+import Data.Text.Encoding (decodeUtf8', decodeUtf8With,
34+ encodeUtf8)
3735import Data.Text.Encoding.Error (lenientDecode)
3836import qualified Data.Text.Lazy as L
3937import Data.Text.Read (Reader, decimal, rational,
4038 signed)
4139
4240import Data.Time
43−#if __GLASGOW_HASKELL__ < 710
4441import Data.Time.Locale.Compat
45−#endif
4642import Data.Version
4743
48−#if MIN_VERSION_base(4,8,0)
4944import Data.Void
5045import Numeric.Natural
51−#endif
5246
5347import Text.ParserCombinators.ReadP (readP_to_S)
5448import Text.Read (readMaybe)
@@ -432,10 +426,8 @@ instance ToHttpApiData Version where
432426 toUrlPiece = T.pack . showVersion
433427 toEncodedUrlPiece = unsafeToEncodedUrlPiece
434428
435−#if MIN_VERSION_base(4,8,0)
436429instance ToHttpApiData Void where toUrlPiece = absurd
437430instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
438−#endif
439431
440432instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
441433instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
@@ -566,7 +558,7 @@ instance FromHttpApiData Char where
566558 parseUrlPiece s =
567559 case T.uncons s of
568560 Just (c, s') | T.null s' -> pure c
569− _ -> defaultParseError s
561+ _ -> defaultParseError s
570562
571563-- |
572564-- >>> showVersion <$> parseUrlPiece "1.2.3"
@@ -577,7 +569,6 @@ instance FromHttpApiData Version where
577569 ((x, ""):_) -> pure x
578570 _ -> defaultParseError s
579571
580−#if MIN_VERSION_base(4,8,0)
581572-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
582573instance FromHttpApiData Void where
583574 parseUrlPiece _ = Left "Void cannot be parsed!"
@@ -588,7 +579,6 @@ instance FromHttpApiData Natural where
588579 if n < 0
589580 then Left ("underflow: " <> s <> " (should be a non-negative integer)")
590581 else Right (fromInteger n)
591−#endif
592582
593583instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
594584instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
test/Web/Internal/HttpApiDataSpec.hs+6−35
@@ -19,9 +19,7 @@ import Web.Cookie (SetCookie, defaultSetCookie, setCookieName, setCookieValue)
1919
2020import Data.Proxy
2121
22−#if MIN_VERSION_base(4,8,0)
2322import Numeric.Natural
24−#endif
2523
2624import Test.Hspec
2725import Test.Hspec.QuickCheck(prop)
@@ -80,13 +78,13 @@ spec = do
8078 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
8179 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
8280 checkUrlPiece (Proxy :: Proxy Day) "Day"
83− checkUrlPiece' timeOfDayGen "TimeOfDay"
84− checkUrlPiece' localTimeGen "LocalTime"
85− checkUrlPiece' zonedTimeGen "ZonedTime"
86− checkUrlPiece' utcTimeGen "UTCTime"
87− checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"
81+ checkUrlPiece (Proxy :: Proxy TimeOfDay) "TimeOfDay"
82+ checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"
83+ checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"
84+ checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"
85+ checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"
8886 checkUrlPiece (Proxy :: Proxy Version) "Version"
89− checkUrlPiece' uuidGen "UUID"
87+ checkUrlPiece (Proxy :: Proxy UUID.UUID) "UUID"
9088 checkUrlPiece' setCookieGen "Cookie"
9189
9290 checkUrlPiece (Proxy :: Proxy F.Uni) "Uni"
@@ -102,9 +100,7 @@ spec = do
102100 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
103101 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
104102
105−#if MIN_VERSION_base(4,8,0)
106103 checkUrlPiece (Proxy :: Proxy Natural) "Natural"
107−#endif
108104
109105 it "bad integers are rejected" $ do
110106 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
@@ -116,31 +112,6 @@ spec = do
116112 it "invalid utf8 is handled" $ do
117113 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)
118114
119−
120−uuidGen :: Gen UUID.UUID
121−uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
122−
123−-- TODO: this generators don't generate full range items
124−localTimeGen :: Gen LocalTime
125−localTimeGen = LocalTime <$> arbitrary <*> timeOfDayGen
126−
127−timeOfDayGen :: Gen TimeOfDay
128−timeOfDayGen = TimeOfDay
129− <$> choose (0, 23)
130− <*> choose (0, 59)
131− <*> fmap (\x -> 0.1 * fromInteger x) (choose (0, 600))
132−
133−zonedTimeGen :: Gen ZonedTime
134−zonedTimeGen = ZonedTime
135− <$> localTimeGen -- Note: not arbitrary!
136− <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
137−
138−utcTimeGen :: Gen UTCTime
139−utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
140−
141−nominalDiffTimeGen :: Gen NominalDiffTime
142−nominalDiffTimeGen = fromInteger <$> arbitrary
143−
144115setCookieGen :: Gen SetCookie
145116setCookieGen = do
146117 n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary