@@ -1,3 +1,4 @@
1+{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DefaultSignatures #-}
4{-# LANGUAGE DefaultSignatures #-}
@@ -16,54 +17,51 @@
16#include "overlapping-compat.h"
17#include "overlapping-compat.h"
17module Web.Internal.FormUrlEncoded where
18module Web.Internal.FormUrlEncoded where
19−#if __GLASGOW_HASKELL__ < 710
20+import Prelude ()
20−import Control.Applicative
21+import Prelude.Compat
21−import Data.Traversable
24−#if __GLASGOW_HASKELL__ < 800
25−import GHC.Exts (IsList (..))
27−import GHC.Exts (IsList (..), Constraint)
23+import Control.Applicative (Const(Const))
31import Control.Arrow ((***))
24import Control.Arrow ((***))
32import Control.Monad ((<=<))
25import Control.Monad ((<=<))
33−import Data.ByteString.Builder (toLazyByteString, shortByteString)
26+import Data.ByteString.Builder (shortByteString, toLazyByteString)
34import qualified Data.ByteString.Lazy as BSL
27import qualified Data.ByteString.Lazy as BSL
35import qualified Data.ByteString.Lazy.Char8 as BSL8
28import qualified Data.ByteString.Lazy.Char8 as BSL8
29+import Data.Coerce (coerce)
36import qualified Data.Foldable as F
30import qualified Data.Foldable as F
31+import Data.Functor.Identity (Identity(Identity))
37import Data.Hashable (Hashable)
32import Data.Hashable (Hashable)
38import Data.HashMap.Strict (HashMap)
33import Data.HashMap.Strict (HashMap)
39import qualified Data.HashMap.Strict as HashMap
34import qualified Data.HashMap.Strict as HashMap
40−import Data.Int
35+import Data.Int (Int16, Int32, Int64, Int8)
41import Data.IntMap (IntMap)
36import Data.IntMap (IntMap)
42import qualified Data.IntMap as IntMap
37import qualified Data.IntMap as IntMap
43−import Data.List (intersperse)
38+import Data.List (intersperse, sortBy)
44import Data.Map (Map)
39import Data.Map (Map)
45import qualified Data.Map as Map
40import qualified Data.Map as Map
46−import Data.Monoid
41+import Data.Monoid (All (..), Any (..), Dual (..),
47−
42+ Product (..), Sum (..))
43+import Data.Ord (comparing)
44+import Data.Proxy (Proxy (..))
45+import Data.Semigroup (Semigroup (..))
46+import qualified Data.Semigroup as Semi
47+import Data.Tagged (Tagged (..))
48import Data.Text (Text)
48import Data.Text (Text)
49import qualified Data.Text as Text
49import qualified Data.Text as Text
50−import qualified Data.Text.Lazy as Lazy
50+import qualified Data.Text.Encoding as Text
51−import Data.Text.Encoding as Text
52import Data.Text.Encoding.Error (lenientDecode)
51import Data.Text.Encoding.Error (lenientDecode)
53−
52+import qualified Data.Text.Lazy as Lazy
53+import Data.Time.Compat (Day, LocalTime, NominalDiffTime,
55+import Data.Time.Calendar.Month.Compat (Month)
54−import Data.Time
56+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
55−import Data.Proxy
57+import Data.Void (Void)
56−import Data.Word
58+import Data.Word (Word16, Word32, Word64, Word8)
57−
59+import GHC.Exts (Constraint, IsList (..))
58−#if MIN_VERSION_base(4,8,0)
60−import Numeric.Natural
63import GHC.Generics
60import GHC.Generics
64−import URI.ByteString (urlEncodeQuery, urlDecodeQuery)
61+import GHC.TypeLits
65−
62+import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)
63+import Numeric.Natural (Natural)
66−import Web.Internal.HttpApiData
64+import Web.Internal.HttpApiData
69-- >>> :set -XDeriveGeneric
67-- >>> :set -XDeriveGeneric
@@ -72,11 +70,20 @@ import Web.Internal.HttpApiData
72-- >>> :set -XFlexibleContexts
70-- >>> :set -XFlexibleContexts
73-- >>> :set -XScopedTypeVariables
71-- >>> :set -XScopedTypeVariables
74-- >>> :set -XTypeFamilies
72-- >>> :set -XTypeFamilies
75−-- >>> import Data.Either (isLeft)
73+-- >>> import Data.Char (toLower)
76−-- >>> import Data.List (sort)
74+--
77-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)
75-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)
78-- >>> instance ToForm Person
76-- >>> instance ToForm Person
79-- >>> instance FromForm Person
77-- >>> instance FromForm Person
79+-- >>> data Post = Post { title :: String, subtitle :: Maybe String, comments :: [String]} deriving (Generic, Show)
80+-- >>> instance ToForm Post
81+-- >>> instance FromForm Post
83+-- >>> data Project = Project { projectName :: String, projectSize :: Int } deriving (Generic, Show)
84+-- >>> let myOptions = FormOptions { fieldLabelModifier = map toLower . drop (length ("project" :: String)) }
85+-- >>> instance ToForm Project where toForm = genericToForm myOptions
86+-- >>> instance FromForm Project where fromForm = genericFromForm myOptions
81-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').
88-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').
82class ToFormKey k where
89class ToFormKey k where
@@ -108,6 +115,9 @@ instance ToFormKey LocalTime where toFormKey = toQueryParam
108instance ToFormKey ZonedTime where toFormKey = toQueryParam
115instance ToFormKey ZonedTime where toFormKey = toQueryParam
109instance ToFormKey UTCTime where toFormKey = toQueryParam
116instance ToFormKey UTCTime where toFormKey = toQueryParam
110instance ToFormKey NominalDiffTime where toFormKey = toQueryParam
117instance ToFormKey NominalDiffTime where toFormKey = toQueryParam
118+instance ToFormKey Quarter where toFormKey = toQueryParam
119+instance ToFormKey QuarterOfYear where toFormKey = toQueryParam
120+instance ToFormKey Month where toFormKey = toQueryParam
112instance ToFormKey String where toFormKey = toQueryParam
122instance ToFormKey String where toFormKey = toQueryParam
113instance ToFormKey Text where toFormKey = toQueryParam
123instance ToFormKey Text where toFormKey = toQueryParam
@@ -116,14 +126,26 @@ instance ToFormKey Lazy.Text where toFormKey = toQueryParam
116instance ToFormKey All where toFormKey = toQueryParam
126instance ToFormKey All where toFormKey = toQueryParam
117instance ToFormKey Any where toFormKey = toQueryParam
127instance ToFormKey Any where toFormKey = toQueryParam
119−instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getDual
129+instance ToFormKey a => ToFormKey (Dual a) where toFormKey = coerce (toFormKey :: a -> Text)
120−instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum
130+instance ToFormKey a => ToFormKey (Sum a) where toFormKey = coerce (toFormKey :: a -> Text)
121−instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
131+instance ToFormKey a => ToFormKey (Product a) where toFormKey = coerce (toFormKey :: a -> Text)
133+instance ToFormKey a => ToFormKey (Semi.Min a) where toFormKey = coerce (toFormKey :: a -> Text)
134+instance ToFormKey a => ToFormKey (Semi.Max a) where toFormKey = coerce (toFormKey :: a -> Text)
135+instance ToFormKey a => ToFormKey (Semi.First a) where toFormKey = coerce (toFormKey :: a -> Text)
136+instance ToFormKey a => ToFormKey (Semi.Last a) where toFormKey = coerce (toFormKey :: a -> Text)
138+instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey = coerce (toFormKey :: a -> Text)
141+instance ToFormKey a => ToFormKey (Identity a) where toFormKey = coerce (toFormKey :: a -> Text)
144+instance ToFormKey a => ToFormKey (Const a b) where
145+ toFormKey = coerce (toFormKey :: a -> Text)
123−#if MIN_VERSION_base(4,8,0)
124instance ToFormKey Void where toFormKey = toQueryParam
147instance ToFormKey Void where toFormKey = toQueryParam
125instance ToFormKey Natural where toFormKey = toQueryParam
148instance ToFormKey Natural where toFormKey = toQueryParam
128-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
150-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
129class FromFormKey k where
151class FromFormKey k where
@@ -155,6 +177,9 @@ instance FromFormKey LocalTime where parseFormKey = parseQueryParam
155instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
177instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
156instance FromFormKey UTCTime where parseFormKey = parseQueryParam
178instance FromFormKey UTCTime where parseFormKey = parseQueryParam
157instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam
179instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam
180+instance FromFormKey Quarter where parseFormKey = parseQueryParam
181+instance FromFormKey QuarterOfYear where parseFormKey = parseQueryParam
182+instance FromFormKey Month where parseFormKey = parseQueryParam
159instance FromFormKey String where parseFormKey = parseQueryParam
184instance FromFormKey String where parseFormKey = parseQueryParam
160instance FromFormKey Text where parseFormKey = parseQueryParam
185instance FromFormKey Text where parseFormKey = parseQueryParam
@@ -163,30 +188,48 @@ instance FromFormKey Lazy.Text where parseFormKey = parseQueryParam
163instance FromFormKey All where parseFormKey = parseQueryParam
188instance FromFormKey All where parseFormKey = parseQueryParam
164instance FromFormKey Any where parseFormKey = parseQueryParam
189instance FromFormKey Any where parseFormKey = parseQueryParam
166−instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . parseFormKey
191+instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
167−instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey
192+instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
193+instance FromFormKey a => FromFormKey (Product a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
195+instance FromFormKey a => FromFormKey (Semi.Min a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
196+instance FromFormKey a => FromFormKey (Semi.Max a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
168−instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
197+instance FromFormKey a => FromFormKey (Semi.First a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
198+instance FromFormKey a => FromFormKey (Semi.Last a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
200+instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
203+instance FromFormKey a => FromFormKey (Identity a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
206+instance FromFormKey a => FromFormKey (Const a b) where
207+ parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
170−#if MIN_VERSION_base(4,8,0)
171instance FromFormKey Void where parseFormKey = parseQueryParam
209instance FromFormKey Void where parseFormKey = parseQueryParam
172instance FromFormKey Natural where parseFormKey = parseQueryParam
210instance FromFormKey Natural where parseFormKey = parseQueryParam
175-- | The contents of a form, not yet URL-encoded.
212-- | The contents of a form, not yet URL-encoded.
177-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
214-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
178newtype Form = Form { unForm :: HashMap Text [Text] }
215newtype Form = Form { unForm :: HashMap Text [Text] }
179− deriving (Eq, Read, Generic, Monoid)
216+ deriving (Eq, Read, Generic, Semigroup, Monoid)
181instance Show Form where
218instance Show Form where
182 showsPrec d form = showParen (d > 10) $
219 showsPrec d form = showParen (d > 10) $
183− showString "fromList " . shows (toList form)
220+ showString "fromList " . shows (toListStable form)
222+-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).
223+-- For a stable conversion use 'toListStable'.
185instance IsList Form where
224instance IsList Form where
186 type Item Form = (Text, Text)
225 type Item Form = (Text, Text)
187 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
226 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
188 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
227 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
229+-- | A stable version of 'toList'.
230+toListStable :: Form -> [(Text, Text)]
231+toListStable = sortOn fst . toList
190-- | Convert a value into 'Form'.
233-- | Convert a value into 'Form'.
192-- An example type and instance:
235-- An example type and instance:
@@ -223,7 +266,6 @@ instance IsList Form where
225-- The default implementation of 'toForm' is 'genericToForm'.
268-- The default implementation of 'toForm' is 'genericToForm'.
226−-- It only works for records and it will use 'toQueryParam' for each field's value.
227class ToForm a where
269class ToForm a where
228 -- | Convert a value into 'Form'.
270 -- | Convert a value into 'Form'.
229 toForm :: a -> Form
271 toForm :: a -> Form
@@ -255,6 +297,8 @@ data Proxy3 a b c = Proxy3
256type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where
298type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where
257#if __GLASGOW_HASKELL__ < 800
299#if __GLASGOW_HASKELL__ < 800
300+ -- this is just a placeholder case for older GHCs to not freak out on an empty closed type family
301+ NotSupported cls a "this type family is actually empty" = ()
259 NotSupported cls a reason = TypeError
303 NotSupported cls a reason = TypeError
260 ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$:
304 ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$:
@@ -274,6 +318,30 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint
274-- , age :: Int
318-- , age :: Int
275-- } deriving ('Generic')
319-- } deriving ('Generic')
322+-- In this implementation each field's value gets encoded using `toQueryParam`.
323+-- Two field types are exceptions:
325+-- - for values of type @'Maybe' a@ an entry is added to the 'Form' only when it is @'Just' x@
326+-- and the encoded value is @'toQueryParam' x@; 'Nothing' values are omitted from the 'Form';
328+-- - for values of type @[a]@ (except @['Char']@) an entry is added for every item in the list;
329+-- if the list is empty no entries are added to the 'Form';
331+-- Here's an example:
336+-- , subtitle :: Maybe String
337+-- , comments :: [String]
338+-- } deriving ('Generic', 'Show')
340+-- instance 'ToForm' Post
343+-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
344+-- "comments=Nice%20post%21&comments=%2B1&title=Test"
277genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
345genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
278genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
346genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
@@ -324,9 +392,9 @@ instance NotSupported ToForm t "is a sum type" => GToForm t (f :+: g) where gToF
324-- , age :: Int }
392-- , age :: Int }
326-- instance 'FromForm' Person where
394-- instance 'FromForm' Person where
327−-- 'fromForm' (Form m) = Person
395+-- 'fromForm' f = Person
328−-- '<$>' 'parseUnique' "name" m
396+-- '<$>' 'parseUnique' "name" f
329−-- '<*>' 'parseUnique' "age" m
397+-- '<*>' 'parseUnique' "age" f
332-- Instead of manually writing @'FromForm'@ instances you can
400-- Instead of manually writing @'FromForm'@ instances you can
@@ -357,6 +425,7 @@ class FromForm a where
358instance FromForm Form where fromForm = pure
426instance FromForm Form where fromForm = pure
428+-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).
360instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
429instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
361 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
430 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
@@ -371,13 +440,22 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where
372-- | Parse a 'Form' into a list of entries groupped by key.
441-- | Parse a 'Form' into a list of entries groupped by key.
374−-- >>> toEntriesByKey [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
443+-- _NOTE:_ this conversion is unstable and may result in different key order
375−-- Right [("color",["red","white"]),("name",["Nick"])]
444+-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.
376toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
445toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
377toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
446toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
379 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
448 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
450+-- | Parse a 'Form' into a list of entries groupped by key.
452+-- >>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
453+-- Right [("color",["red","white"]),("name",["Nick"])]
455+-- For an unstable (but faster) conversion see 'toEntriesByKey'.
456+toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
457+toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey
381-- | A 'Generic'-based implementation of 'fromForm'.
459-- | A 'Generic'-based implementation of 'fromForm'.
382-- This is used as a default implementation in 'FromForm'.
460-- This is used as a default implementation in 'FromForm'.
@@ -389,6 +467,29 @@ toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
389-- , age :: Int
467-- , age :: Int
390-- } deriving ('Generic')
468-- } deriving ('Generic')
471+-- In this implementation each field's value gets decoded using `parseQueryParam`.
472+-- Two field types are exceptions:
474+-- - for values of type @'Maybe' a@ an entry is parsed if present in the 'Form'
475+-- and the is decoded with 'parseQueryParam'; if no entry is present result is 'Nothing';
477+-- - for values of type @[a]@ (except @['Char']@) all entries are parsed to produce a list of parsed values;
479+-- Here's an example:
484+-- , subtitle :: Maybe String
485+-- , comments :: [String]
486+-- } deriving ('Generic', 'Show')
488+-- instance 'FromForm' Post
491+-- >>> urlDecodeAsForm "comments=Nice%20post%21&comments=%2B1&title=Test" :: Either Text Post
492+-- Right (Post {title = "Test", subtitle = Nothing, comments = ["Nice post!","+1"]})
392genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a
493genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a
393genericFromForm opts f = to <$> gFromForm (Proxy :: Proxy a) opts f
494genericFromForm opts f = to <$> gFromForm (Proxy :: Proxy a) opts f
@@ -428,39 +529,53 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where
429-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
530-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
532+-- _NOTE:_ this encoding is unstable and may result in different key order
533+-- (but not values). For a stable encoding see 'urlEncodeFormStable'.
534+urlEncodeForm :: Form -> BSL.ByteString
535+urlEncodeForm = urlEncodeParams . toList
537+-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
539+-- For an unstable (but faster) encoding see 'urlEncodeForm'.
431-- Key-value pairs get encoded to @key=value@ and separated by @&@:
541-- Key-value pairs get encoded to @key=value@ and separated by @&@:
433−-- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")]
543+-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
434-- "lastname=Arni&name=Julian"
544-- "lastname=Arni&name=Julian"
436-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
546-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
438−-- >>> urlEncodeForm [("is_test", "")]
548+-- >>> urlEncodeFormStable [("is_test", "")]
439-- "is_test"
549-- "is_test"
441-- Empty keys are allowed too:
551-- Empty keys are allowed too:
443−-- >>> urlEncodeForm [("", "foobar")]
553+-- >>> urlEncodeFormStable [("", "foobar")]
444-- "=foobar"
554-- "=foobar"
446−-- However, if not key and value are empty, the key-value pair is ignored.
556+-- However, if both key and value are empty, the key-value pair is ignored.
447−-- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism).
557+-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).
449−-- >>> urlEncodeForm [("", "")]
559+-- >>> urlEncodeFormStable [("", "")]
452-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
562-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
454−-- >>> urlEncodeForm [("fullname", "Andres Löh")]
564+-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]
455-- "fullname=Andres%20L%C3%B6h"
565-- "fullname=Andres%20L%C3%B6h"
456−urlEncodeForm :: Form -> BSL.ByteString
566+urlEncodeFormStable :: Form -> BSL.ByteString
567+urlEncodeFormStable = urlEncodeParams . sortOn fst . toList
569+-- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
571+-- See also 'urlEncodeFormStable'.
572+urlEncodeParams :: [(Text, Text)] -> BSL.ByteString
457−urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . toList
573+urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair
459− escape = urlEncodeQuery . Text.encodeUtf8
575+ escape = urlEncodeBuilder True . Text.encodeUtf8
461 encodePair (k, "") = escape k
577 encodePair (k, "") = escape k
462− encodePair (k, v) = escape k <> shortByteString "=" <> escape v
578+ encodePair (k, v) = escape k <> shortByteString "=" <> escape v
465-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
580-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
@@ -494,11 +609,17 @@ urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") .
494-- >>> urlDecodeForm "this=has=too=many=equals"
609-- >>> urlDecodeForm "this=has=too=many=equals"
495-- Left "not a valid pair: this=has=too=many=equals"
610-- Left "not a valid pair: this=has=too=many=equals"
496urlDecodeForm :: BSL.ByteString -> Either Text Form
611urlDecodeForm :: BSL.ByteString -> Either Text Form
612+urlDecodeForm = fmap toForm . urlDecodeParams
614+-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a list of key-value pairs.
616+-- See also 'urlDecodeForm'.
617+urlDecodeParams :: BSL.ByteString -> Either Text [(Text, Text)]
497−urlDecodeForm bs = toForm <$> traverse parsePair pairs
618+urlDecodeParams bs = traverse parsePair pairs
499 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
620 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
501− unescape = Text.decodeUtf8With lenientDecode . urlDecodeQuery . BSL.toStrict
622+ unescape = Text.decodeUtf8With lenientDecode . urlDecode True . BSL.toStrict
503 parsePair p =
624 parsePair p =
504 case map unescape p of
625 case map unescape p of
@@ -506,6 +627,7 @@ urlDecodeForm bs = toForm <$> traverse parsePair pairs
506 [k] -> return (k, "")
627 [k] -> return (k, "")
507 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
628 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
509-- | This is a convenience function for decoding a
631-- | This is a convenience function for decoding a
510-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
632-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
511-- that has an instance of 'FromForm'.
633-- that has an instance of 'FromForm'.
@@ -523,11 +645,22 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm
524-- This is effectively @'urlEncodeForm' . 'toForm'@.
646-- This is effectively @'urlEncodeForm' . 'toForm'@.
526−-- >>> urlEncodeAsForm Person {name = "Dennis", age = 22}
648+-- _NOTE:_ this encoding is unstable and may result in different key order
527−-- "age=22&name=Dennis"
649+-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.
528urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
650urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
529urlEncodeAsForm = urlEncodeForm . toForm
651urlEncodeAsForm = urlEncodeForm . toForm
653+-- | This is a convenience function for encoding a datatype that has instance
654+-- of 'ToForm' directly to a @application/x-www-form-urlencoded@
657+-- This is effectively @'urlEncodeFormStable' . 'toForm'@.
659+-- >>> urlEncodeAsFormStable Person {name = "Dennis", age = 22}
660+-- "age=22&name=Dennis"
661+urlEncodeAsFormStable :: ToForm a => a -> BSL.ByteString
662+urlEncodeAsFormStable = urlEncodeFormStable . toForm
531-- | Find all values corresponding to a given key in a 'Form'.
664-- | Find all values corresponding to a given key in a 'Form'.
533-- >>> lookupAll "name" []
666-- >>> lookupAll "name" []
@@ -617,6 +750,31 @@ parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v
617parseUnique key form = lookupUnique key form >>= parseQueryParam
750parseUnique key form = lookupUnique key form >>= parseQueryParam
619-- | 'Generic'-based deriving options for 'ToForm' and 'FromForm'.
752-- | 'Generic'-based deriving options for 'ToForm' and 'FromForm'.
754+-- A common use case for non-default 'FormOptions'
755+-- is to strip a prefix off of field labels:
758+-- data Project = Project
759+-- { projectName :: String
760+-- , projectSize :: Int
761+-- } deriving ('Generic', 'Show')
763+-- myOptions :: 'FormOptions'
764+-- myOptions = 'FormOptions'
765+-- { 'fieldLabelModifier' = 'map' 'toLower' . 'drop' ('length' \"project\") }
767+-- instance 'ToForm' Project where
768+-- 'toForm' = 'genericToForm' myOptions
770+-- instance 'FromForm' Project where
771+-- 'fromForm' = 'genericFromForm' myOptions
774+-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 }
775+-- "name=http-api-data&size=172"
776+-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
777+-- Right (Project {projectName = "http-api-data", projectSize = 172})
620data FormOptions = FormOptions
778data FormOptions = FormOptions
621 { -- | Function applied to field labels. Handy for removing common record prefixes for example.
779 { -- | Function applied to field labels. Handy for removing common record prefixes for example.
622 fieldLabelModifier :: String -> String
780 fieldLabelModifier :: String -> String
@@ -633,3 +791,6 @@ defaultFormOptions :: FormOptions
633defaultFormOptions = FormOptions
791defaultFormOptions = FormOptions
634 { fieldLabelModifier = id
792 { fieldLabelModifier = id
795+sortOn :: Ord b => (a -> b) -> [a] -> [a]
796+sortOn f = sortBy (comparing f)