@@ -1,4 +1,3 @@
1−{-# LANGUAGE ConstraintKinds #-}
21{-# LANGUAGE CPP #-}
32{-# LANGUAGE DataKinds #-}
43{-# LANGUAGE DefaultSignatures #-}
@@ -14,54 +13,56 @@
1413{-# LANGUAGE TypeFamilies #-}
1514{-# LANGUAGE TypeOperators #-}
1615{-# LANGUAGE UndecidableInstances #-}
17−#include "overlapping-compat.h"
1816module Web.Internal.FormUrlEncoded where
1917
20−import Prelude ()
21−import Prelude.Compat
18+#if __GLASGOW_HASKELL__ < 710
19+import Control.Applicative
20+import Data.Traversable
21+#endif
22+
23+#if __GLASGOW_HASKELL__ < 800
24+import GHC.Exts (IsList (..))
25+#else
26+import GHC.Exts (IsList (..), Constraint)
27+import GHC.TypeLits
28+#endif
2229
23−import Control.Applicative (Const(Const))
2430import Control.Arrow ((***))
2531import Control.Monad ((<=<))
26−import Data.ByteString.Builder (shortByteString, toLazyByteString)
32+import Data.ByteString.Builder (toLazyByteString, shortByteString)
2733import qualified Data.ByteString.Lazy as BSL
2834import qualified Data.ByteString.Lazy.Char8 as BSL8
29−import Data.Coerce (coerce)
3035import qualified Data.Foldable as F
31−import Data.Functor.Identity (Identity(Identity))
3236import Data.Hashable (Hashable)
3337import Data.HashMap.Strict (HashMap)
3438import qualified Data.HashMap.Strict as HashMap
35−import Data.Int (Int16, Int32, Int64, Int8)
39+import Data.Int
3640import Data.IntMap (IntMap)
3741import qualified Data.IntMap as IntMap
38−import Data.List (intersperse, sortBy)
42+import Data.List (intersperse)
3943import Data.Map (Map)
4044import qualified Data.Map as Map
41−import Data.Monoid (All (..), Any (..), Dual (..),
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 (..))
45+import Data.Monoid
46+
4847import Data.Text (Text)
4948import qualified Data.Text as Text
50−import qualified Data.Text.Encoding as Text
51−import Data.Text.Encoding.Error (lenientDecode)
5249import qualified Data.Text.Lazy as Lazy
53−import Data.Time.Compat (Day, LocalTime, NominalDiffTime,
54− UTCTime, ZonedTime)
55−import Data.Time.Calendar.Month.Compat (Month)
56−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
57−import Data.Void (Void)
58−import Data.Word (Word16, Word32, Word64, Word8)
59−import GHC.Exts (Constraint, IsList (..))
50+import Data.Text.Encoding as Text
51+import Data.Text.Encoding.Error (lenientDecode)
52+
53+import Data.Time
54+import Data.Proxy
55+import Data.Word
56+
57+#if MIN_VERSION_base(4,8,0)
58+import Data.Void
59+import Numeric.Natural
60+#endif
61+
6062import GHC.Generics
61−import GHC.TypeLits
62−import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)
63−import Numeric.Natural (Natural)
64−import Web.Internal.HttpApiData
63+import URI.ByteString (urlEncodeQuery, urlDecodeQuery)
64+
65+import Web.Internal.HttpApiData
6566
6667-- $setup
6768-- >>> :set -XDeriveGeneric
@@ -70,20 +71,11 @@ import Web.Internal.HttpApiData
7071-- >>> :set -XFlexibleContexts
7172-- >>> :set -XScopedTypeVariables
7273-- >>> :set -XTypeFamilies
73−-- >>> import Data.Char (toLower)
74−--
74+-- >>> import Data.Either (isLeft)
75+-- >>> import Data.List (sort)
7576-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)
7677-- >>> instance ToForm Person
7778-- >>> instance FromForm Person
78−--
79−-- >>> data Post = Post { title :: String, subtitle :: Maybe String, comments :: [String]} deriving (Generic, Show)
80−-- >>> instance ToForm Post
81−-- >>> instance FromForm Post
82−--
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
8779
8880-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').
8981class ToFormKey k where
@@ -115,9 +107,6 @@ instance ToFormKey LocalTime where toFormKey = toQueryParam
115107instance ToFormKey ZonedTime where toFormKey = toQueryParam
116108instance ToFormKey UTCTime where toFormKey = toQueryParam
117109instance 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
121110
122111instance ToFormKey String where toFormKey = toQueryParam
123112instance ToFormKey Text where toFormKey = toQueryParam
@@ -126,26 +115,14 @@ instance ToFormKey Lazy.Text where toFormKey = toQueryParam
126115instance ToFormKey All where toFormKey = toQueryParam
127116instance ToFormKey Any where toFormKey = toQueryParam
128117
129−instance ToFormKey a => ToFormKey (Dual a) where toFormKey = coerce (toFormKey :: a -> Text)
130−instance ToFormKey a => ToFormKey (Sum a) where toFormKey = coerce (toFormKey :: a -> Text)
131−instance ToFormKey a => ToFormKey (Product a) where toFormKey = coerce (toFormKey :: a -> Text)
132−
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)
137−
138−instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey = coerce (toFormKey :: a -> Text)
139−
140−-- | @since 0.4.2
141−instance ToFormKey a => ToFormKey (Identity a) where toFormKey = coerce (toFormKey :: a -> Text)
142−
143−-- | @since 0.4.2
144−instance ToFormKey a => ToFormKey (Const a b) where
145− toFormKey = coerce (toFormKey :: a -> Text)
118+instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getDual
119+instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum
120+instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
146121
122+#if MIN_VERSION_base(4,8,0)
147123instance ToFormKey Void where toFormKey = toQueryParam
148124instance ToFormKey Natural where toFormKey = toQueryParam
125+#endif
149126
150127-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
151128class FromFormKey k where
@@ -177,9 +154,6 @@ instance FromFormKey LocalTime where parseFormKey = parseQueryParam
177154instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
178155instance FromFormKey UTCTime where parseFormKey = parseQueryParam
179156instance 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
183157
184158instance FromFormKey String where parseFormKey = parseQueryParam
185159instance FromFormKey Text where parseFormKey = parseQueryParam
@@ -188,48 +162,30 @@ instance FromFormKey Lazy.Text where parseFormKey = parseQueryParam
188162instance FromFormKey All where parseFormKey = parseQueryParam
189163instance FromFormKey Any where parseFormKey = parseQueryParam
190164
191−instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
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)
194−
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)
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)
199−
200−instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
201−
202−-- | @since 0.4.2
203−instance FromFormKey a => FromFormKey (Identity a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
204−
205−-- | @since 0.4.2
206−instance FromFormKey a => FromFormKey (Const a b) where
207− parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
165+instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . parseFormKey
166+instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey
167+instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
208168
169+#if MIN_VERSION_base(4,8,0)
209170instance FromFormKey Void where parseFormKey = parseQueryParam
210171instance FromFormKey Natural where parseFormKey = parseQueryParam
172+#endif
211173
212174-- | The contents of a form, not yet URL-encoded.
213175--
214176-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
215177newtype Form = Form { unForm :: HashMap Text [Text] }
216− deriving (Eq, Read, Generic, Semigroup, Monoid)
178+ deriving (Eq, Read, Generic, Monoid)
217179
218180instance Show Form where
219181 showsPrec d form = showParen (d > 10) $
220− showString "fromList " . shows (toListStable form)
182+ showString "fromList " . shows (toList form)
221183
222−-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).
223−-- For a stable conversion use 'toListStable'.
224184instance IsList Form where
225185 type Item Form = (Text, Text)
226186 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
227187 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
228188
229−-- | A stable version of 'toList'.
230−toListStable :: Form -> [(Text, Text)]
231−toListStable = sortOn fst . toList
232−
233189-- | Convert a value into 'Form'.
234190--
235191-- An example type and instance:
@@ -266,6 +222,7 @@ toListStable = sortOn fst . toList
266222-- @
267223--
268224-- The default implementation of 'toForm' is 'genericToForm'.
225+-- It only works for records and it will use 'toQueryParam' for each field's value.
269226class ToForm a where
270227 -- | Convert a value into 'Form'.
271228 toForm :: a -> Form
@@ -297,8 +254,6 @@ data Proxy3 a b c = Proxy3
297254
298255type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where
299256#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" = ()
302257#else
303258 NotSupported cls a reason = TypeError
304259 ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$:
@@ -318,30 +273,6 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint
318273-- , age :: Int
319274-- } deriving ('Generic')
320275-- @
321−--
322−-- In this implementation each field's value gets encoded using `toQueryParam`.
323−-- Two field types are exceptions:
324−--
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';
327−--
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';
330−--
331−-- Here's an example:
332−--
333−-- @
334−-- data Post = Post
335−-- { title :: String
336−-- , subtitle :: Maybe String
337−-- , comments :: [String]
338−-- } deriving ('Generic', 'Show')
339−--
340−-- instance 'ToForm' Post
341−-- @
342−--
343−-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
344−-- "comments=Nice%20post%21&comments=%2B1&title=Test"
345276genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
346277genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
347278
@@ -357,25 +288,7 @@ instance (GToForm t f) => GToForm t (M1 D x f) where
357288instance (GToForm t f) => GToForm t (M1 C x f) where
358289 gToForm p opts (M1 a) = gToForm p opts a
359290
360−instance OVERLAPPABLE_ (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where
361− gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]
362− where
363− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
364−
365−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i (Maybe c))) where
366− gToForm _ opts (M1 (K1 c)) =
367− case c of
368− Nothing -> mempty
369− Just x -> fromList [(key, toQueryParam x)]
370− where
371− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
372−
373−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i [c])) where
374− gToForm _ opts (M1 (K1 cs)) = fromList (map (\c -> (key, toQueryParam c)) cs)
375− where
376− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
377−
378−instance OVERLAPPING_ (Selector s) => GToForm t (M1 S s (K1 i String)) where
291+instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where
379292 gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]
380293 where
381294 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
@@ -392,9 +305,9 @@ instance NotSupported ToForm t "is a sum type" => GToForm t (f :+: g) where gToF
392305-- , age :: Int }
393306--
394307-- instance 'FromForm' Person where
395−-- 'fromForm' f = Person
396−-- '<$>' 'parseUnique' "name" f
397−-- '<*>' 'parseUnique' "age" f
308+-- 'fromForm' (Form m) = Person
309+-- '<$>' 'parseUnique' "name" m
310+-- '<*>' 'parseUnique' "age" m
398311-- @
399312--
400313-- Instead of manually writing @'FromForm'@ instances you can
@@ -425,7 +338,6 @@ class FromForm a where
425338
426339instance FromForm Form where fromForm = pure
427340
428−-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).
429341instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
430342 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
431343
@@ -440,22 +352,13 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where
440352
441353-- | Parse a 'Form' into a list of entries groupped by key.
442354--
443−-- _NOTE:_ this conversion is unstable and may result in different key order
444−-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.
355+-- >>> toEntriesByKey [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
356+-- Right [("color",["red","white"]),("name",["Nick"])]
445357toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
446358toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
447359 where
448360 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
449361
450−-- | Parse a 'Form' into a list of entries groupped by key.
451−--
452−-- >>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
453−-- Right [("color",["red","white"]),("name",["Nick"])]
454−--
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
458−
459362-- | A 'Generic'-based implementation of 'fromForm'.
460363-- This is used as a default implementation in 'FromForm'.
461364--
@@ -467,29 +370,6 @@ toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey
467370-- , age :: Int
468371-- } deriving ('Generic')
469372-- @
470−--
471−-- In this implementation each field's value gets decoded using `parseQueryParam`.
472−-- Two field types are exceptions:
473−--
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';
476−--
477−-- - for values of type @[a]@ (except @['Char']@) all entries are parsed to produce a list of parsed values;
478−--
479−-- Here's an example:
480−--
481−-- @
482−-- data Post = Post
483−-- { title :: String
484−-- , subtitle :: Maybe String
485−-- , comments :: [String]
486−-- } deriving ('Generic', 'Show')
487−--
488−-- instance 'FromForm' Post
489−-- @
490−--
491−-- >>> urlDecodeAsForm "comments=Nice%20post%21&comments=%2B1&title=Test" :: Either Text Post
492−-- Right (Post {title = "Test", subtitle = Nothing, comments = ["Nice post!","+1"]})
493373genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a
494374genericFromForm opts f = to <$> gFromForm (Proxy :: Proxy a) opts f
495375
@@ -499,83 +379,54 @@ class GFromForm t (f :: * -> *) where
499379instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where
500380 gFromForm p opts f = (:*:) <$> gFromForm p opts f <*> gFromForm p opts f
501381
502−instance GFromForm t f => GFromForm t (M1 D x f) where
503− gFromForm p opts f = M1 <$> gFromForm p opts f
504−
505−instance GFromForm t f => GFromForm t (M1 C x f) where
506− gFromForm p opts f = M1 <$> gFromForm p opts f
507−
508−instance OVERLAPPABLE_ (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where
382+instance (Selector s, FromHttpApiData f) => GFromForm t (M1 S s (K1 i f)) where
509383 gFromForm _ opts form = M1 . K1 <$> parseUnique key form
510384 where
511385 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
512386
513−instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i (Maybe c))) where
514− gFromForm _ opts form = M1 . K1 <$> parseMaybe key form
515− where
516− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
517−
518−instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i [c])) where
519− gFromForm _ opts form = M1 . K1 <$> parseAll key form
520− where
521− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
387+instance GFromForm t f => GFromForm t (M1 D x f) where
388+ gFromForm p opts f = M1 <$> gFromForm p opts f
522389
523−instance OVERLAPPING_ (Selector s) => GFromForm t (M1 S s (K1 i String)) where
524− gFromForm _ opts form = M1 . K1 <$> parseUnique key form
525− where
526− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
390+instance GFromForm t f => GFromForm t (M1 C x f) where
391+ gFromForm p opts f = M1 <$> gFromForm p opts f
527392
528393instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm = error "impossible"
529394
530395-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
531396--
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
536−
537−-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
538−--
539−-- For an unstable (but faster) encoding see 'urlEncodeForm'.
540−--
541397-- Key-value pairs get encoded to @key=value@ and separated by @&@:
542398--
543−-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
399+-- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")]
544400-- "lastname=Arni&name=Julian"
545401--
546402-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
547403--
548−-- >>> urlEncodeFormStable [("is_test", "")]
404+-- >>> urlEncodeForm [("is_test", "")]
549405-- "is_test"
550406--
551407-- Empty keys are allowed too:
552408--
553−-- >>> urlEncodeFormStable [("", "foobar")]
409+-- >>> urlEncodeForm [("", "foobar")]
554410-- "=foobar"
555411--
556−-- However, if both key and value are empty, the key-value pair is ignored.
557−-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).
412+-- However, if not key and value are empty, the key-value pair is ignored.
413+-- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism).
558414--
559−-- >>> urlEncodeFormStable [("", "")]
415+-- >>> urlEncodeForm [("", "")]
560416-- ""
561417--
562418-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
563419--
564−-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]
420+-- >>> urlEncodeForm [("fullname", "Andres Löh")]
565421-- "fullname=Andres%20L%C3%B6h"
566−urlEncodeFormStable :: Form -> BSL.ByteString
567−urlEncodeFormStable = urlEncodeParams . sortOn fst . toList
568−
569−-- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
570−--
571−-- See also 'urlEncodeFormStable'.
572−urlEncodeParams :: [(Text, Text)] -> BSL.ByteString
573−urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair
422+urlEncodeForm :: Form -> BSL.ByteString
423+urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . toList
574424 where
575− escape = urlEncodeBuilder True . Text.encodeUtf8
425+ escape = urlEncodeQuery . Text.encodeUtf8
576426
577427 encodePair (k, "") = escape k
578− encodePair (k, v) = escape k <> shortByteString "=" <> escape v
428+ encodePair (k, v) = escape k <> shortByteString "=" <> escape v
429+
579430
580431-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
581432--
@@ -609,17 +460,11 @@ urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&")
609460-- >>> urlDecodeForm "this=has=too=many=equals"
610461-- Left "not a valid pair: this=has=too=many=equals"
611462urlDecodeForm :: BSL.ByteString -> Either Text Form
612−urlDecodeForm = fmap toForm . urlDecodeParams
613−
614−-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a list of key-value pairs.
615−--
616−-- See also 'urlDecodeForm'.
617−urlDecodeParams :: BSL.ByteString -> Either Text [(Text, Text)]
618−urlDecodeParams bs = traverse parsePair pairs
463+urlDecodeForm bs = toForm <$> traverse parsePair pairs
619464 where
620465 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
621466
622− unescape = Text.decodeUtf8With lenientDecode . urlDecode True . BSL.toStrict
467+ unescape = Text.decodeUtf8With lenientDecode . urlDecodeQuery . BSL.toStrict
623468
624469 parsePair p =
625470 case map unescape p of
@@ -627,7 +472,6 @@ urlDecodeParams bs = traverse parsePair pairs
627472 [k] -> return (k, "")
628473 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
629474
630−
631475-- | This is a convenience function for decoding a
632476-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
633477-- that has an instance of 'FromForm'.
@@ -645,22 +489,11 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm
645489--
646490-- This is effectively @'urlEncodeForm' . 'toForm'@.
647491--
648−-- _NOTE:_ this encoding is unstable and may result in different key order
649−-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.
492+-- >>> urlEncodeAsForm Person {name = "Dennis", age = 22}
493+-- "age=22&name=Dennis"
650494urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
651495urlEncodeAsForm = urlEncodeForm . toForm
652496
653−-- | This is a convenience function for encoding a datatype that has instance
654−-- of 'ToForm' directly to a @application/x-www-form-urlencoded@
655−-- 'BSL.ByteString'.
656−--
657−-- This is effectively @'urlEncodeFormStable' . 'toForm'@.
658−--
659−-- >>> urlEncodeAsFormStable Person {name = "Dennis", age = 22}
660−-- "age=22&name=Dennis"
661−urlEncodeAsFormStable :: ToForm a => a -> BSL.ByteString
662−urlEncodeAsFormStable = urlEncodeFormStable . toForm
663−
664497-- | Find all values corresponding to a given key in a 'Form'.
665498--
666499-- >>> lookupAll "name" []
@@ -672,22 +505,6 @@ urlEncodeAsFormStable = urlEncodeFormStable . toForm
672505lookupAll :: Text -> Form -> [Text]
673506lookupAll key = F.concat . HashMap.lookup key . unForm
674507
675−-- | Lookup an optional value for a key.
676−-- Fail if there is more than one value.
677−--
678−-- >>> lookupMaybe "name" []
679−-- Right Nothing
680−-- >>> lookupMaybe "name" [("name", "Oleg")]
681−-- Right (Just "Oleg")
682−-- >>> lookupMaybe "name" [("name", "Oleg"), ("name", "David")]
683−-- Left "Duplicate key \"name\""
684−lookupMaybe :: Text -> Form -> Either Text (Maybe Text)
685−lookupMaybe key form =
686− case lookupAll key form of
687− [] -> pure Nothing
688− [v] -> pure (Just v)
689− _ -> Left $ "Duplicate key " <> Text.pack (show key)
690−
691508-- | Lookup a unique value for a key.
692509-- Fail if there is zero or more than one value.
693510--
@@ -698,11 +515,11 @@ lookupMaybe key form =
698515-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]
699516-- Left "Duplicate key \"name\""
700517lookupUnique :: Text -> Form -> Either Text Text
701−lookupUnique key form = do
702− mv <- lookupMaybe key form
703− case mv of
704− Just v -> pure v
705− Nothing -> Left $ "Could not find key " <> Text.pack (show key)
518+lookupUnique key form =
519+ case lookupAll key form of
520+ [v] -> pure v
521+ [] -> Left $ "Could not find key " <> Text.pack (show key)
522+ _ -> Left $ "Duplicate key " <> Text.pack (show key)
706523
707524-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.
708525--
@@ -717,22 +534,6 @@ lookupUnique key form = do
717534parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]
718535parseAll key = parseQueryParams . lookupAll key
719536
720−-- | Lookup an optional value for a given key and parse it with 'parseQueryParam'.
721−-- Fail if there is more than one value for the key.
722−--
723−-- >>> parseMaybe "age" [] :: Either Text (Maybe Word8)
724−-- Right Nothing
725−-- >>> parseMaybe "age" [("age", "12"), ("age", "25")] :: Either Text (Maybe Word8)
726−-- Left "Duplicate key \"age\""
727−-- >>> parseMaybe "age" [("age", "seven")] :: Either Text (Maybe Word8)
728−-- Left "could not parse: `seven' (input does not start with a digit)"
729−-- >>> parseMaybe "age" [("age", "777")] :: Either Text (Maybe Word8)
730−-- Left "out of bounds: `777' (should be between 0 and 255)"
731−-- >>> parseMaybe "age" [("age", "7")] :: Either Text (Maybe Word8)
732−-- Right (Just 7)
733−parseMaybe :: FromHttpApiData v => Text -> Form -> Either Text (Maybe v)
734−parseMaybe key = parseQueryParams <=< lookupMaybe key
735−
736537-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.
737538-- Fail if there is zero or more than one value for the key.
738539--
@@ -750,31 +551,6 @@ parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v
750551parseUnique key form = lookupUnique key form >>= parseQueryParam
751552
752553-- | 'Generic'-based deriving options for 'ToForm' and 'FromForm'.
753−--
754−-- A common use case for non-default 'FormOptions'
755−-- is to strip a prefix off of field labels:
756−--
757−-- @
758−-- data Project = Project
759−-- { projectName :: String
760−-- , projectSize :: Int
761−-- } deriving ('Generic', 'Show')
762−--
763−-- myOptions :: 'FormOptions'
764−-- myOptions = 'FormOptions'
765−-- { 'fieldLabelModifier' = 'map' 'toLower' . 'drop' ('length' \"project\") }
766−--
767−-- instance 'ToForm' Project where
768−-- 'toForm' = 'genericToForm' myOptions
769−--
770−-- instance 'FromForm' Project where
771−-- 'fromForm' = 'genericFromForm' myOptions
772−-- @
773−--
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})
778554data FormOptions = FormOptions
779555 { -- | Function applied to field labels. Handy for removing common record prefixes for example.
780556 fieldLabelModifier :: String -> String
@@ -791,6 +567,3 @@ defaultFormOptions :: FormOptions
791567defaultFormOptions = FormOptions
792568 { fieldLabelModifier = id
793569 }
794−
795−sortOn :: Ord b => (a -> b) -> [a] -> [a]
796−sortOn f = sortBy (comparing f)