git.iko.soy/typeable/http-api-data
on master help sign in
Allow duplicate keys in Form
5322053Nickolay Kudasov
src/Web/Internal/FormUrlEncoded.hs+9−8
compare with master
unifiedsplit
@@ -51,7 +51,7 @@ import Web.Internal.HttpApiData
51-- | The contents of a form, not yet URL-encoded.
51-- | The contents of a form, not yet URL-encoded.
52--
52--
53-- 'Form' can be URL-encoded with 'encodeForm' and URL-decoded with 'decodeForm'.
53-- 'Form' can be URL-encoded with 'encodeForm' and URL-decoded with 'decodeForm'.
54−newtype Form = Form { unForm :: Map Text Text }
54+newtype Form = Form { unForm :: Map Text [Text] }
55 deriving (Eq, Read, Generic, Monoid)
55 deriving (Eq, Read, Generic, Monoid)
56
56
57instance Show Form where
57instance Show Form where
@@ -60,8 +60,8 @@ instance Show Form where
60
60
61instance IsList Form where
61instance IsList Form where
62 type Item Form = (Text, Text)
62 type Item Form = (Text, Text)
63− fromList = Form . Map.fromList
63+ fromList = Form . Map.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
64− toList = Map.toList . unForm
64+ toList = concatMap (\(k, vs) -> map ((,) k) vs) . Map.toList . unForm
65
65
66-- | Convert a value into 'Form'.
66-- | Convert a value into 'Form'.
67--
67--
@@ -106,7 +106,7 @@ class ToForm a where
106 toForm = genericToForm
106 toForm = genericToForm
107
107
108instance ToForm [(Text, Text)] where toForm = fromList
108instance ToForm [(Text, Text)] where toForm = fromList
109−instance ToForm (Map Text Text) where toForm = Form
109+instance ToForm (Map Text [Text]) where toForm = Form . Map.filter (not . null)
110instance ToForm Form where toForm = id
110instance ToForm Form where toForm = id
111
111
112-- | A 'Generic'-based implementation of 'toForm'.
112-- | A 'Generic'-based implementation of 'toForm'.
@@ -177,8 +177,8 @@ class FromForm a where
177 fromForm = genericFromForm
177 fromForm = genericFromForm
178
178
179instance FromForm Form where fromForm = return
179instance FromForm Form where fromForm = return
180+instance FromForm (Map Text [Text]) where fromForm = return . unForm
180instance FromForm [(Text, Text)] where fromForm = return . toList
181instance FromForm [(Text, Text)] where fromForm = return . toList
181−instance FromForm (Map Text Text) where fromForm = return . unForm
182
182
183-- | A 'Generic'-based implementation of 'fromForm'.
183-- | A 'Generic'-based implementation of 'fromForm'.
184-- This is used as a default implementation in 'FromForm'.
184-- This is used as a default implementation in 'FromForm'.
@@ -202,9 +202,10 @@ instance (GFromForm f, GFromForm g) => GFromForm (f :+: g) where
202
202
203instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
203instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
204 gFromForm f =
204 gFromForm f =
205− case Map.lookup key (unForm f) of
205+ case concat (Map.lookup key (unForm f)) of
206− Nothing -> Left $ "Could not find key " <> Text.pack (show key)
207− Just v -> M1 . K1 <$> parseQueryParam v
206+ [v] -> M1 . K1 <$> parseQueryParam v
207+ [] -> Left $ "Could not find key " <> Text.pack (show key)
208+ _ -> Left $ "Duplicate key " <> Text.pack (show key)
208 where
209 where
209 key = Text.pack $ selName (Proxy3 :: Proxy3 s g p)
210 key = Text.pack $ selName (Proxy3 :: Proxy3 s g p)
210
211
test/Web/Internal/FormUrlEncodedSpec.hs+11−9
@@ -14,6 +14,8 @@ import Data.Text (Text, unpack)
14import Test.Hspec
14import Test.Hspec
15import Test.QuickCheck
15import Test.QuickCheck
16
16
17+import GHC.Exts (fromList)
18+
17import Web.Internal.FormUrlEncoded
19import Web.Internal.FormUrlEncoded
18import Web.Internal.HttpApiData
20import Web.Internal.HttpApiData
19import Web.Internal.TestInstances
21import Web.Internal.TestInstances
@@ -35,8 +37,8 @@ genericSpec = describe "Default (generic) instances" $ do
35
37
36 it "contains the correct record values" $ property $ \(x :: SimpleRec) -> do
38 it "contains the correct record values" $ property $ \(x :: SimpleRec) -> do
37 let f = unForm $ toForm x
39 let f = unForm $ toForm x
38− M.lookup "rec1" f `shouldBe` Just (rec1 x)
40+ M.lookup "rec1" f `shouldBe` Just [rec1 x]
39− (parseUrlPiece <$> M.lookup "rec2" f) `shouldBe` Just (Right $ rec2 x)
41+ (parseQueryParams <$> M.lookup "rec2" f) `shouldBe` Just (Right [rec2 x])
40
42
41 context "for sum types" $ do
43 context "for sum types" $ do
42
44
@@ -44,11 +46,11 @@ genericSpec = describe "Default (generic) instances" $ do
44 let f = unForm $ toForm x
46 let f = unForm $ toForm x
45 case x of
47 case x of
46 SSRLeft _ _ -> do
48 SSRLeft _ _ -> do
47− parseUrlPiece <$> M.lookup "left1" f `shouldBe` Just (Right $ left1 x)
49+ parseQueryParams <$> M.lookup "left1" f `shouldBe` Just (Right [left1 x])
48− parseUrlPiece <$> M.lookup "left2" f `shouldBe` Just (Right $ left2 x)
50+ parseQueryParams <$> M.lookup "left2" f `shouldBe` Just (Right [left2 x])
49 SSRRight _ _ -> do
51 SSRRight _ _ -> do
50− parseUrlPiece <$> M.lookup "right1" f `shouldBe` Just (Right $ right1 x)
52+ parseQueryParams <$> M.lookup "right1" f `shouldBe` Just (Right [right1 x])
51− parseUrlPiece <$> M.lookup "right2" f `shouldBe` Just (Right $ right2 x)
53+ parseQueryParams <$> M.lookup "right2" f `shouldBe` Just (Right [right2 x])
52
54
53
55
54 context "FromForm" $ do
56 context "FromForm" $ do
@@ -59,15 +61,15 @@ genericSpec = describe "Default (generic) instances" $ do
59 fromForm (toForm y) `shouldBe` Right y
61 fromForm (toForm y) `shouldBe` Right y
60
62
61 it "is the right inverse of ToForm" $ property $ \x (y :: Int) -> do
63 it "is the right inverse of ToForm" $ property $ \x (y :: Int) -> do
62− let f1 = Form $ M.fromList [("rec1", x), ("rec2", toUrlPiece y)]
64+ let f1 = fromList [("rec1", x), ("rec2", toQueryParam y)]
63 Right r1 = fromForm f1 :: Either Text SimpleRec
65 Right r1 = fromForm f1 :: Either Text SimpleRec
64 toForm r1 `shouldBe` f1
66 toForm r1 `shouldBe` f1
65− let f2 = Form $ M.fromList [("right1", x), ("right2", toUrlPiece y)]
67+ let f2 = fromList [("right1", x), ("right2", toQueryParam y)]
66 Right r2 = fromForm f2 :: Either Text SimpleSumRec
68 Right r2 = fromForm f2 :: Either Text SimpleSumRec
67 toForm r2 `shouldBe` f2
69 toForm r2 `shouldBe` f2
68
70
69 it "returns the underlying error" $ do
71 it "returns the underlying error" $ do
70− let f = Form $ M.fromList [("rec1", "anything"), ("rec2", "bad")]
72+ let f = fromList [("rec1", "anything"), ("rec2", "bad")]
71 Left e = fromForm f :: Either Text SimpleRec
73 Left e = fromForm f :: Either Text SimpleRec
72 unpack e `shouldContain` "input does not start with a digit"
74 unpack e `shouldContain` "input does not start with a digit"
73
75
test/Web/Internal/TestInstances.hs+3−1
@@ -112,4 +112,6 @@ newtype NoEmptyKeyForm =
112 deriving Show
112 deriving Show
113
113
114instance Arbitrary NoEmptyKeyForm where
114instance Arbitrary NoEmptyKeyForm where
115− arbitrary = NoEmptyKeyForm . Form . M.delete "" . M.fromList <$> arbitrary
115+ arbitrary = NoEmptyKeyForm . removeEmptyKeys <$> arbitrary
116+ where
117+ removeEmptyKeys (Form m) = Form (M.delete "" m)