git.iko.soy/typeable/http-api-data
on master help sign in
Remove Generic support for sum types
5a448b3Nickolay Kudasov
src/Web/Internal/FormUrlEncoded.hs−12
compare with master
unifiedsplit
@@ -232,10 +232,6 @@ class GToForm (f :: * -> *) where
232instance (GToForm f, GToForm g) => GToForm (f :*: g) where
232instance (GToForm f, GToForm g) => GToForm (f :*: g) where
233 gToForm (a :*: b) = gToForm a <> gToForm b
233 gToForm (a :*: b) = gToForm a <> gToForm b
234
234
235−instance (GToForm f, GToForm g) => GToForm (f :+: g) where
236− gToForm (L1 a) = gToForm a
237− gToForm (R1 a) = gToForm a
238−
239instance (GToForm f) => GToForm (M1 D x f) where
235instance (GToForm f) => GToForm (M1 D x f) where
240 gToForm (M1 a) = gToForm a
236 gToForm (M1 a) = gToForm a
241
237
@@ -320,14 +316,6 @@ class GFromForm (f :: * -> *) where
320instance (GFromForm f, GFromForm g) => GFromForm (f :*: g) where
316instance (GFromForm f, GFromForm g) => GFromForm (f :*: g) where
321 gFromForm f = (:*:) <$> gFromForm f <*> gFromForm f
317 gFromForm f = (:*:) <$> gFromForm f <*> gFromForm f
322
318
323−instance (GFromForm f, GFromForm g) => GFromForm (f :+: g) where
324− gFromForm f
325− = fmap L1 (gFromForm f)
326− <!> fmap R1 (gFromForm f)
327− where
328− Left _ <!> y = y
329− x <!> _ = x
330−
331instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
319instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
332 gFromForm form = M1 . K1 <$> parseUnique key form
320 gFromForm form = M1 . K1 <$> parseUnique key form
333 where
321 where
test/Web/Internal/FormUrlEncodedSpec.hs−21
@@ -41,33 +41,12 @@ genericSpec = describe "Default (generic) instances" $ do
41 HashMap.lookup "rec1" f `shouldBe` Just [rec1 x]
41 HashMap.lookup "rec1" f `shouldBe` Just [rec1 x]
42 (parseQueryParams <$> HashMap.lookup "rec2" f) `shouldBe` Just (Right [rec2 x])
42 (parseQueryParams <$> HashMap.lookup "rec2" f) `shouldBe` Just (Right [rec2 x])
43
43
44− context "for sum types" $ do
45−
46− it "contains the correct records" $ property $ \x -> do
47− let f = unForm $ toForm x
48− case x of
49− SSRLeft _ _ -> do
50− parseQueryParams <$> HashMap.lookup "left1" f `shouldBe` Just (Right [left1 x])
51− parseQueryParams <$> HashMap.lookup "left2" f `shouldBe` Just (Right [left2 x])
52− SSRRight _ _ -> do
53− parseQueryParams <$> HashMap.lookup "right1" f `shouldBe` Just (Right [right1 x])
54− parseQueryParams <$> HashMap.lookup "right2" f `shouldBe` Just (Right [right2 x])
55−
56−
57 context "FromForm" $ do
44 context "FromForm" $ do
58
45
59− it "is the left inverse of ToForm" $ property $
60− \(x :: SimpleRec, y :: SimpleSumRec) -> do
61− fromForm (toForm x) `shouldBe` Right x
62− fromForm (toForm y) `shouldBe` Right y
63−
64 it "is the right inverse of ToForm" $ property $ \x (y :: Int) -> do
46 it "is the right inverse of ToForm" $ property $ \x (y :: Int) -> do
65 let f1 = fromList [("rec1", x), ("rec2", toQueryParam y)]
47 let f1 = fromList [("rec1", x), ("rec2", toQueryParam y)]
66 Right r1 = fromForm f1 :: Either Text SimpleRec
48 Right r1 = fromForm f1 :: Either Text SimpleRec
67 toForm r1 `shouldBe` f1
49 toForm r1 `shouldBe` f1
68− let f2 = fromList [("right1", x), ("right2", toQueryParam y)]
69− Right r2 = fromForm f2 :: Either Text SimpleSumRec
70− toForm r2 `shouldBe` f2
71
50
72 it "returns the underlying error" $ do
51 it "returns the underlying error" $ do
73 let f = fromList [("rec1", "anything"), ("rec2", "bad")]
52 let f = fromList [("rec1", "anything"), ("rec2", "bad")]
test/Web/Internal/TestInstances.hs−15
@@ -5,7 +5,6 @@
5module Web.Internal.TestInstances
5module Web.Internal.TestInstances
6 ( RandomCase(..)
6 ( RandomCase(..)
7 , SimpleRec(..)
7 , SimpleRec(..)
8− , SimpleSumRec(..)
9 , NoEmptyKeyForm(..)
8 , NoEmptyKeyForm(..)
10 ) where
9 ) where
11
10
@@ -93,20 +92,6 @@ instance FromForm SimpleRec
93instance Arbitrary SimpleRec where
92instance Arbitrary SimpleRec where
94 arbitrary = SimpleRec <$> arbitrary <*> arbitrary
93 arbitrary = SimpleRec <$> arbitrary <*> arbitrary
95
94
96−data SimpleSumRec
97− = SSRLeft { left1 :: Int, left2 :: Bool }
98− | SSRRight { right1 :: T.Text, right2 :: Int}
99− deriving (Eq, Show, Read, Generic)
100−
101−instance ToForm SimpleSumRec
102−instance FromForm SimpleSumRec
103−
104−instance Arbitrary SimpleSumRec where
105− arbitrary = oneof
106− [ SSRLeft <$> arbitrary <*> arbitrary
107− , SSRRight <$> arbitrary <*> arbitrary
108− ]
109−
110newtype NoEmptyKeyForm =
95newtype NoEmptyKeyForm =
111 NoEmptyKeyForm { unNoEmptyKeyForm :: Form }
96 NoEmptyKeyForm { unNoEmptyKeyForm :: Form }
112 deriving Show
97 deriving Show