@@ -1,67 +1,52 @@
1−{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
3−{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
6{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9{-# LANGUAGE KindSignatures #-}
7{-# LANGUAGE KindSignatures #-}
10−{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
12{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE PolyKinds #-}
13{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE TypeOperators #-}
12{-# LANGUAGE TypeOperators #-}
16−{-# LANGUAGE UndecidableInstances #-}
17−#include "overlapping-compat.h"
18module Web.Internal.FormUrlEncoded where
13module Web.Internal.FormUrlEncoded where
20−import Prelude ()
15+#if __GLASGOW_HASKELL__ < 710
21−import Prelude.Compat
16+import Control.Applicative
17+import Data.Traversable
23−import Control.Applicative (Const(Const))
24import Control.Arrow ((***))
20import Control.Arrow ((***))
25import Control.Monad ((<=<))
21import Control.Monad ((<=<))
26−import Data.ByteString.Builder (shortByteString, toLazyByteString)
27import qualified Data.ByteString.Lazy as BSL
22import qualified Data.ByteString.Lazy as BSL
28import qualified Data.ByteString.Lazy.Char8 as BSL8
23import qualified Data.ByteString.Lazy.Char8 as BSL8
29−import Data.Coerce (coerce)
30import qualified Data.Foldable as F
24import qualified Data.Foldable as F
31−import Data.Functor.Identity (Identity(Identity))
32import Data.Hashable (Hashable)
25import Data.Hashable (Hashable)
33import Data.HashMap.Strict (HashMap)
26import Data.HashMap.Strict (HashMap)
34import qualified Data.HashMap.Strict as HashMap
27import qualified Data.HashMap.Strict as HashMap
35−import Data.Int (Int16, Int32, Int64, Int8)
28+import Data.Int
36import Data.IntMap (IntMap)
29import Data.IntMap (IntMap)
37import qualified Data.IntMap as IntMap
30import qualified Data.IntMap as IntMap
38−import Data.List (intersperse, sortBy)
39import Data.Map (Map)
31import Data.Map (Map)
40import qualified Data.Map as Map
32import qualified Data.Map as Map
41−import Data.Monoid (All (..), Any (..), Dual (..),
33+import Data.Monoid
42− Product (..), Sum (..))
34+
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)
35import Data.Text (Text)
49import qualified Data.Text as Text
36import qualified Data.Text as Text
50−import qualified Data.Text.Encoding as Text
51−import Data.Text.Encoding.Error (lenientDecode)
52import qualified Data.Text.Lazy as Lazy
37import qualified Data.Text.Lazy as Lazy
53−import Data.Time.Compat (Day, LocalTime, NominalDiffTime,
38+import Data.Text.Encoding as Text
54− UTCTime, ZonedTime)
39+import Data.Text.Encoding.Error (lenientDecode)
55−import Data.Time.Calendar.Month.Compat (Month)
40+
56−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
41+import Data.Time
57−import Data.Void (Void)
58−import Data.Word (Word16, Word32, Word64, Word8)
42+import Data.Word
59−import GHC.Exts (Constraint, IsList (..))
44+import GHC.Exts (IsList (..))
60import GHC.Generics
45import GHC.Generics
61−import GHC.TypeLits
46+import Network.URI (escapeURIString, isUnreserved,
62−import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)
47+ unEscapeString)
63−import Numeric.Natural (Natural)
48+
64−import Web.Internal.HttpApiData
49+import Web.Internal.HttpApiData
67-- >>> :set -XDeriveGeneric
52-- >>> :set -XDeriveGeneric
@@ -70,20 +55,11 @@ import Web.Internal.HttpApiData
70-- >>> :set -XFlexibleContexts
55-- >>> :set -XFlexibleContexts
71-- >>> :set -XScopedTypeVariables
56-- >>> :set -XScopedTypeVariables
72-- >>> :set -XTypeFamilies
57-- >>> :set -XTypeFamilies
73−-- >>> import Data.Char (toLower)
58+-- >>> import Data.Either (isLeft)
74−--
59+-- >>> import Data.List (sort)
75-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)
60-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)
76-- >>> instance ToForm Person
61-- >>> instance ToForm Person
77-- >>> instance FromForm Person
62-- >>> 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
88-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').
64-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').
89class ToFormKey k where
65class ToFormKey k where
@@ -115,9 +91,6 @@ instance ToFormKey LocalTime where toFormKey = toQueryParam
115instance ToFormKey ZonedTime where toFormKey = toQueryParam
91instance ToFormKey ZonedTime where toFormKey = toQueryParam
116instance ToFormKey UTCTime where toFormKey = toQueryParam
92instance ToFormKey UTCTime where toFormKey = toQueryParam
117instance ToFormKey NominalDiffTime where toFormKey = toQueryParam
93instance 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
122instance ToFormKey String where toFormKey = toQueryParam
95instance ToFormKey String where toFormKey = toQueryParam
123instance ToFormKey Text where toFormKey = toQueryParam
96instance ToFormKey Text where toFormKey = toQueryParam
@@ -126,26 +99,9 @@ instance ToFormKey Lazy.Text where toFormKey = toQueryParam
126instance ToFormKey All where toFormKey = toQueryParam
99instance ToFormKey All where toFormKey = toQueryParam
127instance ToFormKey Any where toFormKey = toQueryParam
100instance ToFormKey Any where toFormKey = toQueryParam
129−instance ToFormKey a => ToFormKey (Dual a) where toFormKey = coerce (toFormKey :: a -> Text)
102+instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getDual
130−instance ToFormKey a => ToFormKey (Sum a) where toFormKey = coerce (toFormKey :: a -> Text)
103+instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum
131−instance ToFormKey a => ToFormKey (Product a) where toFormKey = coerce (toFormKey :: a -> Text)
104+instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
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)
147−instance ToFormKey Void where toFormKey = toQueryParam
148−instance ToFormKey Natural where toFormKey = toQueryParam
150-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
106-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
151class FromFormKey k where
107class FromFormKey k where
@@ -177,9 +133,6 @@ instance FromFormKey LocalTime where parseFormKey = parseQueryParam
177instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
133instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
178instance FromFormKey UTCTime where parseFormKey = parseQueryParam
134instance FromFormKey UTCTime where parseFormKey = parseQueryParam
179instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam
135instance 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
184instance FromFormKey String where parseFormKey = parseQueryParam
137instance FromFormKey String where parseFormKey = parseQueryParam
185instance FromFormKey Text where parseFormKey = parseQueryParam
138instance FromFormKey Text where parseFormKey = parseQueryParam
@@ -188,48 +141,25 @@ instance FromFormKey Lazy.Text where parseFormKey = parseQueryParam
188instance FromFormKey All where parseFormKey = parseQueryParam
141instance FromFormKey All where parseFormKey = parseQueryParam
189instance FromFormKey Any where parseFormKey = parseQueryParam
142instance FromFormKey Any where parseFormKey = parseQueryParam
191−instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
144+instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . parseFormKey
192−instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
145+instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey
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)
197−instance FromFormKey a => FromFormKey (Semi.First a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
146+instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
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)
209−instance FromFormKey Void where parseFormKey = parseQueryParam
210−instance FromFormKey Natural where parseFormKey = parseQueryParam
212-- | The contents of a form, not yet URL-encoded.
148-- | The contents of a form, not yet URL-encoded.
214-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
150-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
215newtype Form = Form { unForm :: HashMap Text [Text] }
151newtype Form = Form { unForm :: HashMap Text [Text] }
216− deriving (Eq, Read, Generic, Semigroup, Monoid)
152+ deriving (Eq, Read, Generic, Monoid)
218instance Show Form where
154instance Show Form where
219 showsPrec d form = showParen (d > 10) $
155 showsPrec d form = showParen (d > 10) $
220− showString "fromList " . shows (toListStable form)
156+ showString "fromList " . shows (toList form)
222−-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).
223−-- For a stable conversion use 'toListStable'.
224instance IsList Form where
158instance IsList Form where
225 type Item Form = (Text, Text)
159 type Item Form = (Text, Text)
226 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
160 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
227 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
161 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
233-- | Convert a value into 'Form'.
163-- | Convert a value into 'Form'.
235-- An example type and instance:
165-- An example type and instance:
@@ -265,12 +195,12 @@ toListStable = sortOn fst . toList
265-- instance 'ToForm' Person
195-- instance 'ToForm' Person
268−-- The default implementation of 'toForm' is 'genericToForm'.
198+-- The default implementation will use 'toQueryParam' for each field's value.
269class ToForm a where
199class ToForm a where
270 -- | Convert a value into 'Form'.
200 -- | Convert a value into 'Form'.
271 toForm :: a -> Form
201 toForm :: a -> Form
272− default toForm :: (Generic a, GToForm a (Rep a)) => a -> Form
202+ default toForm :: (Generic a, GToForm (Rep a)) => a -> Form
273− toForm = genericToForm defaultFormOptions
203+ toForm = genericToForm
275instance ToForm Form where toForm = id
205instance ToForm Form where toForm = id
@@ -287,100 +217,34 @@ instance ToHttpApiData v => ToForm (IntMap [v]) where
287 toForm = fromEntriesByKey . IntMap.toList
217 toForm = fromEntriesByKey . IntMap.toList
289-- | Convert a list of entries groupped by key into a 'Form'.
219-- | Convert a list of entries groupped by key into a 'Form'.
291−-- >>> fromEntriesByKey [("name",["Nick"]),("color",["red","blue"])]
292−-- fromList [("color","red"),("color","blue"),("name","Nick")]
293fromEntriesByKey :: (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
220fromEntriesByKey :: (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
294fromEntriesByKey = Form . HashMap.fromListWith (<>) . map (toFormKey *** map toQueryParam)
221fromEntriesByKey = Form . HashMap.fromListWith (<>) . map (toFormKey *** map toQueryParam)
296−data Proxy3 a b c = Proxy3
298−type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where
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" = ()
303− NotSupported cls a reason = TypeError
304− ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$:
305− 'ShowType a ':<>: 'Text " " ':<>: 'Text reason ':<>: 'Text "," ':$$:
306− 'Text "but Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instances can be derived only for records" ':$$:
307− 'Text "(i.e. product types with named fields)." )
310-- | A 'Generic'-based implementation of 'toForm'.
223-- | A 'Generic'-based implementation of 'toForm'.
311-- This is used as a default implementation in 'ToForm'.
224-- This is used as a default implementation in 'ToForm'.
313−-- Note that this only works for records (i.e. product data types with named fields):
316−-- data Person = Person
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"
345−genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
225+genericToForm :: (Generic a, GToForm (Rep a)) => a -> Form
346−genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
226+genericToForm = gToForm . from
348−class GToForm t (f :: * -> *) where
349− gToForm :: Proxy t -> FormOptions -> f x -> Form
351−instance (GToForm t f, GToForm t g) => GToForm t (f :*: g) where
228+class GToForm (f :: * -> *) where
352− gToForm p opts (a :*: b) = gToForm p opts a <> gToForm p opts b
229+ gToForm :: f x -> Form
354−instance (GToForm t f) => GToForm t (M1 D x f) where
231+instance (GToForm f, GToForm g) => GToForm (f :*: g) where
355− gToForm p opts (M1 a) = gToForm p opts a
232+ gToForm (a :*: b) = gToForm a <> gToForm b
357−instance (GToForm t f) => GToForm t (M1 C x f) where
234+instance (GToForm f, GToForm g) => GToForm (f :+: g) where
358− gToForm p opts (M1 a) = gToForm p opts a
235+ gToForm (L1 a) = gToForm a
236+ gToForm (R1 a) = gToForm a
360−instance OVERLAPPABLE_ (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where
238+instance (GToForm f) => GToForm (M1 D x f) where
361− gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]
239+ gToForm (M1 a) = gToForm a
363− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
365−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i (Maybe c))) where
241+instance (GToForm f) => GToForm (M1 C x f) where
366− gToForm _ opts (M1 (K1 c)) =
242+ gToForm (M1 a) = gToForm a
369− Just x -> fromList [(key, toQueryParam x)]
371− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
373−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i [c])) where
244+instance (Selector s, ToHttpApiData c) => GToForm (M1 S s (K1 i c)) where
374− gToForm _ opts (M1 (K1 cs)) = fromList (map (\c -> (key, toQueryParam c)) cs)
245+ gToForm (M1 (K1 c)) = fromList [(key, toQueryParam c)]
376− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
378−instance OVERLAPPING_ (Selector s) => GToForm t (M1 S s (K1 i String)) where
379− gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]
381− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
247+ key = Text.pack $ selName (Proxy3 :: Proxy3 s g p)
383−instance NotSupported ToForm t "is a sum type" => GToForm t (f :+: g) where gToForm = error "impossible"
385-- | Parse 'Form' into a value.
249-- | Parse 'Form' into a value.
@@ -392,9 +256,9 @@ instance NotSupported ToForm t "is a sum type" => GToForm t (f :+: g) where gToF
392-- , age :: Int }
256-- , age :: Int }
394-- instance 'FromForm' Person where
258-- instance 'FromForm' Person where
395−-- 'fromForm' f = Person
259+-- 'fromForm' (Form m) = Person
396−-- '<$>' 'parseUnique' "name" f
260+-- '<$>' 'parseUnique' "name" m
397−-- '<*>' 'parseUnique' "age" f
261+-- '<*>' 'parseUnique' "age" m
400-- Instead of manually writing @'FromForm'@ instances you can
264-- Instead of manually writing @'FromForm'@ instances you can
@@ -415,17 +279,16 @@ instance NotSupported ToForm t "is a sum type" => GToForm t (f :+: g) where gToF
415-- instance 'FromForm' Person
279-- instance 'FromForm' Person
418−-- The default implementation of 'fromForm' is 'genericFromForm'.
419−-- It only works for records and it will use 'parseQueryParam' for each field's value.
282+-- The default implementation will use 'parseQueryParam' for each field's value.
420class FromForm a where
283class FromForm a where
421 -- | Parse 'Form' into a value.
284 -- | Parse 'Form' into a value.
422 fromForm :: Form -> Either Text a
285 fromForm :: Form -> Either Text a
423− default fromForm :: (Generic a, GFromForm a (Rep a)) => Form -> Either Text a
286+ default fromForm :: (Generic a, GFromForm (Rep a))
287+ => Form -> Either Text a
424− fromForm = genericFromForm defaultFormOptions
288+ fromForm = genericFromForm
426instance FromForm Form where fromForm = pure
290instance FromForm Form where fromForm = pure
428−-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).
429instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
292instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
430 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
293 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
@@ -439,143 +302,77 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where
439 fromForm = fmap (IntMap.fromListWith (<>)) . toEntriesByKey
302 fromForm = fmap (IntMap.fromListWith (<>)) . toEntriesByKey
441-- | Parse a 'Form' into a list of entries groupped by key.
304-- | Parse a 'Form' into a list of entries groupped by key.
443−-- _NOTE:_ this conversion is unstable and may result in different key order
444−-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.
445toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
305toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
446toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
306toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
448 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
308 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
459-- | A 'Generic'-based implementation of 'fromForm'.
310-- | A 'Generic'-based implementation of 'fromForm'.
460-- This is used as a default implementation in 'FromForm'.
311-- This is used as a default implementation in 'FromForm'.
462−-- Note that this only works for records (i.e. product data types with named fields):
465−-- data Person = Person
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"]})
493−genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a
312+genericFromForm :: (Generic a, GFromForm (Rep a))
313+ => Form -> Either Text a
494−genericFromForm opts f = to <$> gFromForm (Proxy :: Proxy a) opts f
314+genericFromForm f = to <$> gFromForm f
496−class GFromForm t (f :: * -> *) where
497− gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (f x)
499−instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where
500− gFromForm p opts f = (:*:) <$> gFromForm p opts f <*> gFromForm p opts f
502−instance GFromForm t f => GFromForm t (M1 D x f) where
316+class GFromForm (f :: * -> *) where
503− gFromForm p opts f = M1 <$> gFromForm p opts f
317+ gFromForm :: Form -> Either Text (f x)
505−instance GFromForm t f => GFromForm t (M1 C x f) where
319+instance (GFromForm f, GFromForm g) => GFromForm (f :*: g) where
506− gFromForm p opts f = M1 <$> gFromForm p opts f
320+ gFromForm f = (:*:) <$> gFromForm f <*> gFromForm f
508−instance OVERLAPPABLE_ (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where
322+instance (GFromForm f, GFromForm g) => GFromForm (f :+: g) where
509− gFromForm _ opts form = M1 . K1 <$> parseUnique key form
323+ gFromForm f
324+ = fmap L1 (gFromForm f)
325+ <!> fmap R1 (gFromForm f)
511− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
327+ Left _ <!> y = y
513−instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i (Maybe c))) where
330+instance (Selector s, FromHttpApiData f) => GFromForm (M1 S s (K1 i f)) where
514− gFromForm _ opts form = M1 . K1 <$> parseMaybe key form
331+ gFromForm form = M1 . K1 <$> parseUnique key form
516− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
333+ key = Text.pack $ selName (Proxy3 :: Proxy3 s g p)
518−instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i [c])) where
335+instance (GFromForm f) => GFromForm (M1 D x f) where
519− gFromForm _ opts form = M1 . K1 <$> parseAll key form
336+ gFromForm f = M1 <$> gFromForm f
521− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
523−instance OVERLAPPING_ (Selector s) => GFromForm t (M1 S s (K1 i String)) where
338+instance (GFromForm f) => GFromForm (M1 C x f) where
524− gFromForm _ opts form = M1 . K1 <$> parseUnique key form
339+ gFromForm f = M1 <$> gFromForm f
526− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
528−instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm = error "impossible"
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'.
341-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
539−-- For an unstable (but faster) encoding see 'urlEncodeForm'.
541-- Key-value pairs get encoded to @key=value@ and separated by @&@:
343-- Key-value pairs get encoded to @key=value@ and separated by @&@:
543−-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
345+-- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")]
544-- "lastname=Arni&name=Julian"
346-- "lastname=Arni&name=Julian"
546-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
348-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
548−-- >>> urlEncodeFormStable [("is_test", "")]
350+-- >>> urlEncodeForm [("is_test", "")]
549-- "is_test"
351-- "is_test"
551-- Empty keys are allowed too:
353-- Empty keys are allowed too:
553−-- >>> urlEncodeFormStable [("", "foobar")]
355+-- >>> urlEncodeForm [("", "foobar")]
554-- "=foobar"
356-- "=foobar"
556−-- However, if both key and value are empty, the key-value pair is ignored.
358+-- However, if not key and value are empty, the key-value pair is ignored.
557−-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).
359+-- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism).
559−-- >>> urlEncodeFormStable [("", "")]
361+-- >>> urlEncodeForm [("", "")]
562-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
364-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
564−-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]
366+-- >>> urlEncodeForm [("fullname", "Andres Löh")]
565-- "fullname=Andres%20L%C3%B6h"
367-- "fullname=Andres%20L%C3%B6h"
566−urlEncodeFormStable :: Form -> BSL.ByteString
368+urlEncodeForm :: Form -> BSL.ByteString
567−urlEncodeFormStable = urlEncodeParams . sortOn fst . toList
369+urlEncodeForm xs = BSL.intercalate "&" $ map (BSL.fromStrict . encodePair) $ toList xs
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
573−urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair
575− escape = urlEncodeBuilder True . Text.encodeUtf8
371+ escape = Text.encodeUtf8 . Text.pack . escapeURIString isUnreserved . Text.unpack
577 encodePair (k, "") = escape k
373 encodePair (k, "") = escape k
578− encodePair (k, v) = escape k <> shortByteString "=" <> escape v
374+ encodePair (k, v) = escape k <> "=" <> escape v
580-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
377-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
@@ -609,24 +406,20 @@ urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&")
609-- >>> urlDecodeForm "this=has=too=many=equals"
406-- >>> urlDecodeForm "this=has=too=many=equals"
610-- Left "not a valid pair: this=has=too=many=equals"
407-- Left "not a valid pair: this=has=too=many=equals"
611urlDecodeForm :: BSL.ByteString -> Either Text Form
408urlDecodeForm :: 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)]
618−urlDecodeParams bs = traverse parsePair pairs
409+urlDecodeForm bs = toForm <$> traverse parsePair pairs
620− pairs = map (BSL8.split '=') (BSL8.split '&' bs)
411+ pairs = map (Text.decodeUtf8With lenientDecode . BSL.toStrict) (BSL8.split '&' bs)
622− unescape = Text.decodeUtf8With lenientDecode . urlDecode True . BSL.toStrict
413+ unescape = Text.pack . unEscapeString . Text.unpack . Text.replace "+" "%20"
415+ parsePair :: Text -> Either Text (Text, Text)
624 parsePair p =
416 parsePair p =
625− case map unescape p of
417+ case Text.splitOn "=" p of
626− [k, v] -> return (k, v)
418+ [k, v] -> return (unescape k, unescape v)
627− [k] -> return (k, "")
419+ [k] -> return (unescape k, "" )
628− xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
420+ _ -> Left $ "not a valid pair: " <> p
422+data Proxy3 a b c = Proxy3
631-- | This is a convenience function for decoding a
424-- | This is a convenience function for decoding a
632-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
425-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
@@ -645,48 +438,21 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm
646-- This is effectively @'urlEncodeForm' . 'toForm'@.
439-- This is effectively @'urlEncodeForm' . 'toForm'@.
648−-- _NOTE:_ this encoding is unstable and may result in different key order
441+-- >>> urlEncodeAsForm Person {name = "Dennis", age = 22}
649−-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.
442+-- "age=22&name=Dennis"
650urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
443urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
651urlEncodeAsForm = urlEncodeForm . toForm
444urlEncodeAsForm = 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
664-- | Find all values corresponding to a given key in a 'Form'.
446-- | Find all values corresponding to a given key in a 'Form'.
666−-- >>> lookupAll "name" []
448+-- >>> lookupKey "name" []
668−-- >>> lookupAll "name" [("name", "Oleg")]
450+-- >>> lookupKey "name" [("name", "Oleg")]
669-- ["Oleg"]
451-- ["Oleg"]
670−-- >>> lookupAll "name" [("name", "Oleg"), ("name", "David")]
452+-- >>> lookupKey "name" [("name", "Oleg"), ("name", "David")]
671-- ["Oleg","David"]
453-- ["Oleg","David"]
672−lookupAll :: Text -> Form -> [Text]
454+lookupKey :: Text -> Form -> [Text]
673−lookupAll key = F.concat . HashMap.lookup key . unForm
455+lookupKey key = F.concat . HashMap.lookup key . unForm
675−-- | Lookup an optional value for a key.
676−-- Fail if there is more than one value.
678−-- >>> lookupMaybe "name" []
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
688− [v] -> pure (Just v)
689− _ -> Left $ "Duplicate key " <> Text.pack (show key)
691-- | Lookup a unique value for a key.
457-- | Lookup a unique value for a key.
692-- Fail if there is zero or more than one value.
458-- Fail if there is zero or more than one value.
@@ -698,43 +464,13 @@ lookupMaybe key form =
698-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]
464-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]
699-- Left "Duplicate key \"name\""
465-- Left "Duplicate key \"name\""
700lookupUnique :: Text -> Form -> Either Text Text
466lookupUnique :: Text -> Form -> Either Text Text
701−lookupUnique key form = do
467+lookupUnique key form =
702− mv <- lookupMaybe key form
703− case mv of
468+ case lookupKey key form of
704− Just v -> pure v
469+ [v] -> pure v
705− Nothing -> Left $ "Could not find key " <> Text.pack (show key)
470+ [] -> Left $ "Could not find key " <> Text.pack (show key)
707−-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.
709−-- >>> parseAll "age" [] :: Either Text [Word8]
711−-- >>> parseAll "age" [("age", "8"), ("age", "seven")] :: Either Text [Word8]
712−-- Left "could not parse: `seven' (input does not start with a digit)"
713−-- >>> parseAll "age" [("age", "8"), ("age", "777")] :: Either Text [Word8]
714−-- Left "out of bounds: `777' (should be between 0 and 255)"
715−-- >>> parseAll "age" [("age", "12"), ("age", "25")] :: Either Text [Word8]
717−parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]
718−parseAll key = parseQueryParams . lookupAll key
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.
723−-- >>> parseMaybe "age" [] :: Either Text (Maybe Word8)
725−-- >>> parseMaybe "age" [("age", "12"), ("age", "25")] :: Either Text (Maybe Word8)
726−-- Left "Duplicate key \"age\""
471+ _ -> Left $ "Duplicate key " <> Text.pack (show key)
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)
733−parseMaybe :: FromHttpApiData v => Text -> Form -> Either Text (Maybe v)
734−parseMaybe key = parseQueryParams <=< lookupMaybe key
736-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.
473-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.
737−-- Fail if there is zero or more than one value for the key.
739-- >>> parseUnique "age" [] :: Either Text Word8
475-- >>> parseUnique "age" [] :: Either Text Word8
740-- Left "Could not find key \"age\""
476-- Left "Could not find key \"age\""
@@ -749,48 +485,16 @@ parseMaybe key = parseQueryParams <=< lookupMaybe key
749parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v
485parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v
750parseUnique key form = lookupUnique key form >>= parseQueryParam
486parseUnique key form = lookupUnique key form >>= parseQueryParam
752−-- | 'Generic'-based deriving options for 'ToForm' and 'FromForm'.
488+-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.
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})
778−data FormOptions = FormOptions
779− { -- | Function applied to field labels. Handy for removing common record prefixes for example.
780− fieldLabelModifier :: String -> String
783−-- | Default encoding 'FormOptions'.
785−-- @
490+-- >>> parseAll "age" [] :: Either Text [Word8]
786−-- 'FormOptions'
491+-- Right []
787−-- { 'fieldLabelModifier' = id
492+-- >>> parseAll "age" [("age", "8"), ("age", "seven")] :: Either Text [Word8]
788−-- }
493+-- Left "could not parse: `seven' (input does not start with a digit)"
789−-- @
494+-- >>> parseAll "age" [("age", "8"), ("age", "777")] :: Either Text [Word8]
790−defaultFormOptions :: FormOptions
495+-- Left "out of bounds: `777' (should be between 0 and 255)"
791−defaultFormOptions = FormOptions
496+-- >>> parseAll "age" [("age", "12"), ("age", "25")] :: Either Text [Word8]
792− { fieldLabelModifier = id
497+-- Right [12,25]
793− }
498+parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]
499+parseAll key = parseQueryParams . lookupKey key
795−sortOn :: Ord b => (a -> b) -> [a] -> [a]
796−sortOn f = sortBy (comparing f)