@@ -35,10 +35,11 @@ import qualified Data.HashMap.Strict as HashMap
35import Data.Int
35import Data.Int
36import Data.IntMap (IntMap)
36import Data.IntMap (IntMap)
37import qualified Data.IntMap as IntMap
37import qualified Data.IntMap as IntMap
38−import Data.List (intersperse)
38+import Data.List (intersperse, sortBy)
39import Data.Map (Map)
39import Data.Map (Map)
40import qualified Data.Map as Map
40import qualified Data.Map as Map
41import Data.Monoid
41import Data.Monoid
42+import Data.Ord (comparing)
43import Data.Text (Text)
44import Data.Text (Text)
44import qualified Data.Text as Text
45import qualified Data.Text as Text
@@ -186,13 +187,19 @@ newtype Form = Form { unForm :: HashMap Text [Text] }
187instance Show Form where
188instance Show Form where
188 showsPrec d form = showParen (d > 10) $
189 showsPrec d form = showParen (d > 10) $
189− showString "fromList " . shows (toList form)
190+ showString "fromList " . shows (toListStable form)
192+-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).
193+-- For a stable conversion use 'toListStable'.
191instance IsList Form where
194instance IsList Form where
192 type Item Form = (Text, Text)
195 type Item Form = (Text, Text)
193 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
196 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
194 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
197 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
199+-- | A stable version of 'toList'.
200+toListStable :: Form -> [(Text, Text)]
201+toListStable = sortOn fst . toList
196-- | Convert a value into 'Form'.
203-- | Convert a value into 'Form'.
198-- An example type and instance:
205-- An example type and instance:
@@ -303,7 +310,7 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint
303-- instance 'ToForm' Post
310-- instance 'ToForm' Post
306−-- >>> urlEncodeAsForm Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
313+-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
307-- "comments=Nice%20post%21&comments=%2B1&title=Test"
314-- "comments=Nice%20post%21&comments=%2B1&title=Test"
308genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
315genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
309genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
316genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
@@ -388,6 +395,7 @@ class FromForm a where
389instance FromForm Form where fromForm = pure
396instance FromForm Form where fromForm = pure
398+-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).
391instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
399instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
392 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
400 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
@@ -402,13 +410,22 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where
403-- | Parse a 'Form' into a list of entries groupped by key.
411-- | Parse a 'Form' into a list of entries groupped by key.
405−-- >>> toEntriesByKey [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
413+-- _NOTE:_ this conversion is unstable and may result in different key order
406−-- Right [("color",["red","white"]),("name",["Nick"])]
414+-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.
407toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
415toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
408toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
416toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
410 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
418 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
420+-- | Parse a 'Form' into a list of entries groupped by key.
422+-- >>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
423+-- Right [("color",["red","white"]),("name",["Nick"])]
425+-- For an unstable (but faster) conversion see 'toEntriesByKey'.
426+toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
427+toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey
412-- | A 'Generic'-based implementation of 'fromForm'.
429-- | A 'Generic'-based implementation of 'fromForm'.
413-- This is used as a default implementation in 'FromForm'.
430-- This is used as a default implementation in 'FromForm'.
@@ -482,40 +499,54 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where
483-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
500-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
502+-- _NOTE:_ this encoding is unstable and may result in different key order
503+-- (but not values). For a stable encoding see 'urlEncodeFormStable'.
504+urlEncodeForm :: Form -> BSL.ByteString
505+urlEncodeForm = urlEncodeParams . toList
507+-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
509+-- For an unstable (but faster) encoding see 'urlEncodeForm'.
485-- Key-value pairs get encoded to @key=value@ and separated by @&@:
511-- Key-value pairs get encoded to @key=value@ and separated by @&@:
487−-- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")]
513+-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
488-- "lastname=Arni&name=Julian"
514-- "lastname=Arni&name=Julian"
490-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
516-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
492−-- >>> urlEncodeForm [("is_test", "")]
518+-- >>> urlEncodeFormStable [("is_test", "")]
493-- "is_test"
519-- "is_test"
495-- Empty keys are allowed too:
521-- Empty keys are allowed too:
497−-- >>> urlEncodeForm [("", "foobar")]
523+-- >>> urlEncodeFormStable [("", "foobar")]
498-- "=foobar"
524-- "=foobar"
500−-- However, if not key and value are empty, the key-value pair is ignored.
526+-- However, if both key and value are empty, the key-value pair is ignored.
501−-- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism).
527+-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).
503−-- >>> urlEncodeForm [("", "")]
529+-- >>> urlEncodeFormStable [("", "")]
506-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
532-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
508−-- >>> urlEncodeForm [("fullname", "Andres Löh")]
534+-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]
509-- "fullname=Andres%20L%C3%B6h"
535-- "fullname=Andres%20L%C3%B6h"
510−urlEncodeForm :: Form -> BSL.ByteString
536+urlEncodeFormStable :: Form -> BSL.ByteString
537+urlEncodeFormStable = urlEncodeParams . sortOn fst . toList
539+-- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
541+-- See also 'urlEncodeFormStable'.
542+urlEncodeParams :: [(Text, Text)] -> BSL.ByteString
511−urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . toList
543+urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair
513 escape = urlEncodeQuery . Text.encodeUtf8
545 escape = urlEncodeQuery . Text.encodeUtf8
515 encodePair (k, "") = escape k
547 encodePair (k, "") = escape k
516 encodePair (k, v) = escape k <> shortByteString "=" <> escape v
548 encodePair (k, v) = escape k <> shortByteString "=" <> escape v
519-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
550-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
521-- Key-value pairs get decoded normally:
552-- Key-value pairs get decoded normally:
@@ -548,7 +579,13 @@ urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") .
548-- >>> urlDecodeForm "this=has=too=many=equals"
579-- >>> urlDecodeForm "this=has=too=many=equals"
549-- Left "not a valid pair: this=has=too=many=equals"
580-- Left "not a valid pair: this=has=too=many=equals"
550urlDecodeForm :: BSL.ByteString -> Either Text Form
581urlDecodeForm :: BSL.ByteString -> Either Text Form
582+urlDecodeForm = fmap toForm . urlDecodeParams
584+-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a list of key-value pairs.
586+-- See also 'urlDecodeForm'.
587+urlDecodeParams :: BSL.ByteString -> Either Text [(Text, Text)]
551−urlDecodeForm bs = toForm <$> traverse parsePair pairs
588+urlDecodeParams bs = traverse parsePair pairs
553 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
590 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
@@ -560,6 +597,7 @@ urlDecodeForm bs = toForm <$> traverse parsePair pairs
560 [k] -> return (k, "")
597 [k] -> return (k, "")
561 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
598 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
563-- | This is a convenience function for decoding a
601-- | This is a convenience function for decoding a
564-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
602-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
565-- that has an instance of 'FromForm'.
603-- that has an instance of 'FromForm'.
@@ -577,11 +615,22 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm
578-- This is effectively @'urlEncodeForm' . 'toForm'@.
616-- This is effectively @'urlEncodeForm' . 'toForm'@.
580−-- >>> urlEncodeAsForm Person {name = "Dennis", age = 22}
618+-- _NOTE:_ this encoding is unstable and may result in different key order
581−-- "age=22&name=Dennis"
619+-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.
582urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
620urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
583urlEncodeAsForm = urlEncodeForm . toForm
621urlEncodeAsForm = urlEncodeForm . toForm
623+-- | This is a convenience function for encoding a datatype that has instance
624+-- of 'ToForm' directly to a @application/x-www-form-urlencoded@
627+-- This is effectively @'urlEncodeFormStable' . 'toForm'@.
629+-- >>> urlEncodeAsFormStable Person {name = "Dennis", age = 22}
630+-- "age=22&name=Dennis"
631+urlEncodeAsFormStable :: ToForm a => a -> BSL.ByteString
632+urlEncodeAsFormStable = urlEncodeFormStable . toForm
585-- | Find all values corresponding to a given key in a 'Form'.
634-- | Find all values corresponding to a given key in a 'Form'.
587-- >>> lookupAll "name" []
636-- >>> lookupAll "name" []
@@ -692,8 +741,8 @@ parseUnique key form = lookupUnique key form >>= parseQueryParam
692-- 'fromForm' = 'genericFromForm' myOptions
741-- 'fromForm' = 'genericFromForm' myOptions
695−-- >>> urlEncodeAsForm Project { projectName = "http-api-data", projectSize = 172 }
744+-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 }
696−-- "size=172&name=http-api-data"
745+-- "name=http-api-data&size=172"
697-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
746-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
698-- Right (Project {projectName = "http-api-data", projectSize = 172})
747-- Right (Project {projectName = "http-api-data", projectSize = 172})
699data FormOptions = FormOptions
748data FormOptions = FormOptions
@@ -712,3 +761,6 @@ defaultFormOptions :: FormOptions
712defaultFormOptions = FormOptions
761defaultFormOptions = FormOptions
713 { fieldLabelModifier = id
762 { fieldLabelModifier = id
765+sortOn :: Ord b => (a -> b) -> [a] -> [a]
766+sortOn f = sortBy (comparing f)