@@ -16,6 +16,7 @@ module Web.Internal.FormUrlEncoded where
16import Control.Applicative
16import Control.Applicative
19+import Control.Arrow ((***))
19import Control.Monad ((<=<))
20import Control.Monad ((<=<))
20import qualified Data.ByteString.Lazy as BSL
21import qualified Data.ByteString.Lazy as BSL
21import qualified Data.ByteString.Lazy.Char8 as BSL8
22import qualified Data.ByteString.Lazy.Char8 as BSL8
@@ -194,10 +195,14 @@ class ToForm a where
194 default toForm :: (Generic a, GToForm (Rep a)) => a -> Form
195 default toForm :: (Generic a, GToForm (Rep a)) => a -> Form
195 toForm = genericToForm
196 toForm = genericToForm
197−instance ToForm [(Text, Text)] where toForm = fromList
198−instance ToForm (Map Text [Text]) where toForm = Form . Map.filter (not . null)
199instance ToForm Form where toForm = id
198instance ToForm Form where toForm = id
200+instance (ToFormKey k, ToHttpApiData v) => ToForm [(k, v)] where
201+ toForm = fromList . map (toFormKey *** toQueryParam)
203+instance (ToFormKey k, ToHttpApiData v) => ToForm (Map k [v]) where
204+ toForm = Form . Map.fromListWith (<>) . map (toFormKey *** map toQueryParam) . Map.toList
201-- | A 'Generic'-based implementation of 'toForm'.
206-- | A 'Generic'-based implementation of 'toForm'.
202-- This is used as a default implementation in 'ToForm'.
207-- This is used as a default implementation in 'ToForm'.
203genericToForm :: (Generic a, GToForm (Rep a)) => a -> Form
208genericToForm :: (Generic a, GToForm (Rep a)) => a -> Form
@@ -235,8 +240,8 @@ instance (Selector s, ToHttpApiData c) => GToForm (M1 S s (K1 i c)) where
236-- instance 'FromForm' Person where
241-- instance 'FromForm' Person where
237-- 'fromForm' (Form m) = Person
242-- 'fromForm' (Form m) = Person
238−-- '\<$\>' maybe (Left "key \"name\" not found") 'parseQueryParam' (lookup "name" m)
243+-- '<$>' maybe (Left "key \"name\" not found") 'parseQueryParam' (lookup "name" m)
239−-- '\<*\>' maybe (Left "key \"age\" not found") 'parseQueryParam' (lookup "name" m)
244+-- '<*>' maybe (Left "key \"age\" not found") 'parseQueryParam' (lookup "name" m)
242-- Instead of manually writing @'FromForm'@ instances you can
247-- Instead of manually writing @'FromForm'@ instances you can
@@ -265,9 +270,19 @@ class FromForm a where
265 => Form -> Either Text a
270 => Form -> Either Text a
266 fromForm = genericFromForm
271 fromForm = genericFromForm
268−instance FromForm Form where fromForm = return
273+instance FromForm Form where fromForm = pure
275+instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
276+ fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . entriesByKey
269−instance FromForm (Map Text [Text]) where fromForm = return . unForm
278+instance (Ord k, FromFormKey k, FromHttpApiData v) => FromForm (Map k [v]) where
270−instance FromForm [(Text, Text)] where fromForm = return . toList
279+ fromForm = fmap (Map.fromListWith (<>)) . entriesByKey
281+-- | Parse a 'Form' into a list of entries groupped by key.
282+entriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
283+entriesByKey = traverse parseGroup . Map.toList . unForm
285+ parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
272-- | A 'Generic'-based implementation of 'fromForm'.
287-- | A 'Generic'-based implementation of 'fromForm'.
273-- This is used as a default implementation in 'FromForm'.
288-- This is used as a default implementation in 'FromForm'.