git.iko.soy/typeable/http-api-data
on master help sign in
Allow duplicate keys in Form
commit5322053538f379debdc3fb421de5efb8fc875115 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateMon 29 Aug 2016, 23:41 (10 years ago) parentd04cfba
3 files changed+23−18
compare with master
unifiedsplit
src/Web/Internal/FormUrlEncoded.hs+9−8 test/Web/Internal/FormUrlEncodedSpec.hs+11−9 test/Web/Internal/TestInstances.hs+3−1
src/Web/Internal/FormUrlEncoded.hs+9−8
@@ -51,7 +51,7 @@ import Web.Internal.HttpApiData
5151-- | The contents of a form, not yet URL-encoded.
5252--
5353-- '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] }
5555 deriving (Eq, Read, Generic, Monoid)
5656
5757instance Show Form where
@@ -60,8 +60,8 @@ instance Show Form where
6060
6161instance IsList Form where
6262 type Item Form = (Text, Text)
63− fromList = Form . Map.fromList
64− toList = Map.toList . unForm
63+ fromList = Form . Map.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
64+ toList = concatMap (\(k, vs) -> map ((,) k) vs) . Map.toList . unForm
6565
6666-- | Convert a value into 'Form'.
6767--
@@ -106,7 +106,7 @@ class ToForm a where
106106 toForm = genericToForm
107107
108108instance 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)
110110instance ToForm Form where toForm = id
111111
112112-- | A 'Generic'-based implementation of 'toForm'.
@@ -177,8 +177,8 @@ class FromForm a where
177177 fromForm = genericFromForm
178178
179179instance FromForm Form where fromForm = return
180+instance FromForm (Map Text [Text]) where fromForm = return . unForm
180181instance FromForm [(Text, Text)] where fromForm = return . toList
181−instance FromForm (Map Text Text) where fromForm = return . unForm
182182
183183-- | A 'Generic'-based implementation of 'fromForm'.
184184-- This is used as a default implementation in 'FromForm'.
@@ -202,9 +202,10 @@ instance (GFromForm f, GFromForm g) => GFromForm (f :+: g) where
202202
203203instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
204204 gFromForm f =
205− case Map.lookup key (unForm f) of
206− Nothing -> Left $ "Could not find key " <> Text.pack (show key)
207− Just v -> M1 . K1 <$> parseQueryParam v
205+ case concat (Map.lookup key (unForm f)) of
206+ [v] -> M1 . K1 <$> parseQueryParam v
207+ [] -> Left $ "Could not find key " <> Text.pack (show key)
208+ _ -> Left $ "Duplicate key " <> Text.pack (show key)
208209 where
209210 key = Text.pack $ selName (Proxy3 :: Proxy3 s g p)
210211
test/Web/Internal/FormUrlEncodedSpec.hs+11−9
@@ -14,6 +14,8 @@ import Data.Text (Text, unpack)
1414import Test.Hspec
1515import Test.QuickCheck
1616
17+import GHC.Exts (fromList)
18+
1719import Web.Internal.FormUrlEncoded
1820import Web.Internal.HttpApiData
1921import Web.Internal.TestInstances
@@ -35,8 +37,8 @@ genericSpec = describe "Default (generic) instances" $ do
3537
3638 it "contains the correct record values" $ property $ \(x :: SimpleRec) -> do
3739 let f = unForm $ toForm x
38− M.lookup "rec1" f `shouldBe` Just (rec1 x)
39− (parseUrlPiece <$> M.lookup "rec2" f) `shouldBe` Just (Right $ rec2 x)
40+ M.lookup "rec1" f `shouldBe` Just [rec1 x]
41+ (parseQueryParams <$> M.lookup "rec2" f) `shouldBe` Just (Right [rec2 x])
4042
4143 context "for sum types" $ do
4244
@@ -44,11 +46,11 @@ genericSpec = describe "Default (generic) instances" $ do
4446 let f = unForm $ toForm x
4547 case x of
4648 SSRLeft _ _ -> do
47− parseUrlPiece <$> M.lookup "left1" f `shouldBe` Just (Right $ left1 x)
48− parseUrlPiece <$> M.lookup "left2" f `shouldBe` Just (Right $ left2 x)
49+ parseQueryParams <$> M.lookup "left1" f `shouldBe` Just (Right [left1 x])
50+ parseQueryParams <$> M.lookup "left2" f `shouldBe` Just (Right [left2 x])
4951 SSRRight _ _ -> do
50− parseUrlPiece <$> M.lookup "right1" f `shouldBe` Just (Right $ right1 x)
51− parseUrlPiece <$> M.lookup "right2" f `shouldBe` Just (Right $ right2 x)
52+ parseQueryParams <$> M.lookup "right1" f `shouldBe` Just (Right [right1 x])
53+ parseQueryParams <$> M.lookup "right2" f `shouldBe` Just (Right [right2 x])
5254
5355
5456 context "FromForm" $ do
@@ -59,15 +61,15 @@ genericSpec = describe "Default (generic) instances" $ do
5961 fromForm (toForm y) `shouldBe` Right y
6062
6163 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)]
6365 Right r1 = fromForm f1 :: Either Text SimpleRec
6466 toForm r1 `shouldBe` f1
65− let f2 = Form $ M.fromList [("right1", x), ("right2", toUrlPiece y)]
67+ let f2 = fromList [("right1", x), ("right2", toQueryParam y)]
6668 Right r2 = fromForm f2 :: Either Text SimpleSumRec
6769 toForm r2 `shouldBe` f2
6870
6971 it "returns the underlying error" $ do
70− let f = Form $ M.fromList [("rec1", "anything"), ("rec2", "bad")]
72+ let f = fromList [("rec1", "anything"), ("rec2", "bad")]
7173 Left e = fromForm f :: Either Text SimpleRec
7274 unpack e `shouldContain` "input does not start with a digit"
7375
test/Web/Internal/TestInstances.hs+3−1
@@ -112,4 +112,6 @@ newtype NoEmptyKeyForm =
112112 deriving Show
113113
114114instance 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)