http-api-data-0.4: Converting to/from HTTP API data like URL pieces, headers and query parameters.

Safe HaskellNone
LanguageHaskell2010

Web.Internal.FormUrlEncoded

Synopsis

Documentation

>>> :set -XDeriveGeneric
>>> :set -XOverloadedLists
>>> :set -XOverloadedStrings
>>> :set -XFlexibleContexts
>>> :set -XScopedTypeVariables
>>> :set -XTypeFamilies
>>> import Data.Char (toLower)
>>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)
>>> instance ToForm Person
>>> instance FromForm Person
>>> data Post = Post { title :: String, subtitle :: Maybe String, comments :: [String]} deriving (Generic, Show)
>>> instance ToForm Post
>>> instance FromForm Post
>>> data Project = Project { projectName :: String, projectSize :: Int } deriving (Generic, Show)
>>> let myOptions = FormOptions { fieldLabelModifier = map toLower . drop (length ("project" :: String)) }
>>> instance ToForm Project where toForm = genericToForm myOptions
>>> instance FromForm Project where fromForm = genericFromForm myOptions

class ToFormKey k where Source #

Typeclass for types that can be used as keys in a Form-like container (like Map).

Methods

toFormKey :: k -> Text Source #

Render a key for a Form.

Instances
ToFormKey Bool Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Bool -> Text Source #

ToFormKey Char Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Char -> Text Source #

ToFormKey Double Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Float Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Float -> Text Source #

ToFormKey Int Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Int -> Text Source #

ToFormKey Int8 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Int8 -> Text Source #

ToFormKey Int16 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Int16 -> Text Source #

ToFormKey Int32 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Int32 -> Text Source #

ToFormKey Int64 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Int64 -> Text Source #

ToFormKey Integer Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Natural Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Ordering Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Word Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Word -> Text Source #

ToFormKey Word8 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Word8 -> Text Source #

ToFormKey Word16 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Word32 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Word64 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey () Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: () -> Text Source #

ToFormKey Text Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Text -> Text0 Source #

ToFormKey Text Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Text -> Text Source #

ToFormKey String Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Void Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Void -> Text Source #

ToFormKey All Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: All -> Text Source #

ToFormKey Any Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Any -> Text Source #

ToFormKey UTCTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey ZonedTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey LocalTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey NominalDiffTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToFormKey Day Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Day -> Text Source #

ToFormKey a => ToFormKey (Min a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Min a -> Text Source #

ToFormKey a => ToFormKey (Max a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Max a -> Text Source #

ToFormKey a => ToFormKey (First a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: First a -> Text Source #

ToFormKey a => ToFormKey (Last a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Last a -> Text Source #

ToFormKey a => ToFormKey (Dual a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Dual a -> Text Source #

ToFormKey a => ToFormKey (Sum a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Sum a -> Text Source #

ToFormKey a => ToFormKey (Product a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Product a -> Text Source #

ToFormKey a => ToFormKey (Tagged b a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toFormKey :: Tagged b a -> Text Source #

class FromFormKey k where Source #

Typeclass for types that can be parsed from keys of a Form. This is the reverse of ToFormKey.

Methods

parseFormKey :: Text -> Either Text k Source #

Parse a key of a Form.

Instances
FromFormKey Bool Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Char Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Double Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Float Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Int Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Int8 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Int16 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Int32 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Int64 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Integer Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Natural Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Ordering Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Word Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Word8 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Word16 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Word32 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Word64 Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey () Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Text Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Text Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey String Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Void Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey All Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Any Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey UTCTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey ZonedTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey LocalTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey NominalDiffTime Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey Day Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (Min a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (Max a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (First a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (Last a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (Dual a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (Sum a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (Product a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

FromFormKey a => FromFormKey (Tagged b a) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

newtype Form Source #

The contents of a form, not yet URL-encoded.

Form can be URL-encoded with urlEncodeForm and URL-decoded with urlDecodeForm.

Constructors

Form 

Fields

Instances
IsList Form Source #

_NOTE:_ toList is unstable and may result in different key order (but not values). For a stable conversion use toListStable.

Instance details

Defined in Web.Internal.FormUrlEncoded

Associated Types

type Item Form :: Type #

Methods

fromList :: [Item Form] -> Form #

fromListN :: Int -> [Item Form] -> Form #

toList :: Form -> [Item Form] #

Eq Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

(==) :: Form -> Form -> Bool #

(/=) :: Form -> Form -> Bool #

Read Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Show Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

showsPrec :: Int -> Form -> ShowS #

show :: Form -> String #

showList :: [Form] -> ShowS #

Generic Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Associated Types

type Rep Form :: Type -> Type #

Methods

from :: Form -> Rep Form x #

to :: Rep Form x -> Form #

Semigroup Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

(<>) :: Form -> Form -> Form #

sconcat :: NonEmpty Form -> Form #

stimes :: Integral b => b -> Form -> Form #

Monoid Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

mempty :: Form #

mappend :: Form -> Form -> Form #

mconcat :: [Form] -> Form #

FromForm Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

ToForm Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toForm :: Form -> Form Source #

type Rep Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

type Rep Form = D1 (MetaData "Form" "Web.Internal.FormUrlEncoded" "http-api-data-0.4-2eCIIi897xRFO453YwHv2X" True) (C1 (MetaCons "Form" PrefixI True) (S1 (MetaSel (Just "unForm") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (HashMap Text [Text]))))
type Item Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

type Item Form = (Text, Text)

toListStable :: Form -> [(Text, Text)] Source #

A stable version of toList.

class ToForm a where Source #

Convert a value into Form.

An example type and instance:

{-# LANGUAGE OverloadedLists #-}

data Person = Person
  { name :: String
  , age  :: Int }

instance ToForm Person where
  toForm person =
    [ ("name", toQueryParam (name person))
    , ("age", toQueryParam (age person)) ]

Instead of manually writing ToForm instances you can use a default generic implementation of toForm.

To do that, simply add deriving Generic clause to your datatype and declare a ToForm instance for your datatype without giving definition for toForm.

For instance, the previous example can be simplified into this:

data Person = Person
  { name :: String
  , age  :: Int
  } deriving (Generic)

instance ToForm Person

The default implementation of toForm is genericToForm.

Minimal complete definition

Nothing

Methods

toForm :: a -> Form Source #

Convert a value into Form.

toForm :: (Generic a, GToForm a (Rep a)) => a -> Form Source #

Convert a value into Form.

Instances
ToForm Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toForm :: Form -> Form Source #

(ToFormKey k, ToHttpApiData v) => ToForm [(k, v)] Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toForm :: [(k, v)] -> Form Source #

ToHttpApiData v => ToForm (IntMap [v]) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toForm :: IntMap [v] -> Form Source #

(ToFormKey k, ToHttpApiData v) => ToForm (Map k [v]) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toForm :: Map k [v] -> Form Source #

(ToFormKey k, ToHttpApiData v) => ToForm (HashMap k [v]) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

toForm :: HashMap k [v] -> Form Source #

fromEntriesByKey :: (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form Source #

Convert a list of entries groupped by key into a Form.

>>> fromEntriesByKey [("name",["Nick"]),("color",["red","blue"])]
fromList [("color","red"),("color","blue"),("name","Nick")]

data Proxy3 a b c Source #

Constructors

Proxy3 

type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where ... Source #

Equations

NotSupported cls a reason = TypeError (((((((Text "Cannot derive a Generic-based " :<>: ShowType cls) :<>: Text " instance for ") :<>: ShowType a) :<>: Text ".") :$$: (((ShowType a :<>: Text " ") :<>: Text reason) :<>: Text ",")) :$$: ((Text "but Generic-based " :<>: ShowType cls) :<>: Text " instances can be derived only for records")) :$$: Text "(i.e. product types with named fields).") 

genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form Source #

A Generic-based implementation of toForm. This is used as a default implementation in ToForm.

Note that this only works for records (i.e. product data types with named fields):

data Person = Person
  { name :: String
  , age  :: Int
  } deriving (Generic)

In this implementation each field's value gets encoded using toQueryParam. Two field types are exceptions:

  • for values of type Maybe a an entry is added to the Form only when it is Just x and the encoded value is toQueryParam x; Nothing values are omitted from the Form;
  • for values of type [a] (except [Char]) an entry is added for every item in the list; if the list is empty no entries are added to the Form;

Here's an example:

data Post = Post
  { title    :: String
  , subtitle :: Maybe String
  , comments :: [String]
  } deriving (Generic, Show)

instance ToForm Post
>>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
"comments=Nice%20post%21&comments=%2B1&title=Test"

class GToForm t (f :: * -> *) where Source #

Methods

gToForm :: Proxy t -> FormOptions -> f x -> Form Source #

Instances
(GToForm t f, GToForm t g) => GToForm (t :: k) (f :*: g) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> (f :*: g) x -> Form Source #

NotSupported ToForm t "is a sum type" => GToForm (t :: k) (f :+: g) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> (f :+: g) x -> Form Source #

Selector s => GToForm (t :: k) (M1 S s (K1 i String :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> M1 S s (K1 i String) x -> Form Source #

(Selector s, ToHttpApiData c) => GToForm (t :: k) (M1 S s (K1 i [c] :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> M1 S s (K1 i [c]) x -> Form Source #

(Selector s, ToHttpApiData c) => GToForm (t :: k) (M1 S s (K1 i (Maybe c) :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> M1 S s (K1 i (Maybe c)) x -> Form Source #

(Selector s, ToHttpApiData c) => GToForm (t :: k) (M1 S s (K1 i c :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> M1 S s (K1 i c) x -> Form Source #

GToForm t f => GToForm (t :: k) (M1 C x f) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> M1 C x f x0 -> Form Source #

GToForm t f => GToForm (t :: k) (M1 D x f) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gToForm :: Proxy t -> FormOptions -> M1 D x f x0 -> Form Source #

class FromForm a where Source #

Parse Form into a value.

An example type and instance:

data Person = Person
  { name :: String
  , age  :: Int }

instance FromForm Person where
  fromForm f = Person
    <$> parseUnique "name" f
    <*> parseUnique "age"  f

Instead of manually writing FromForm instances you can use a default generic implementation of fromForm.

To do that, simply add deriving Generic clause to your datatype and declare a FromForm instance for your datatype without giving definition for fromForm.

For instance, the previous example can be simplified into this:

data Person = Person
  { name :: String
  , age  :: Int
  } deriving (Generic)

instance FromForm Person

The default implementation of fromForm is genericFromForm. It only works for records and it will use parseQueryParam for each field's value.

Minimal complete definition

Nothing

Methods

fromForm :: Form -> Either Text a Source #

Parse Form into a value.

fromForm :: (Generic a, GFromForm a (Rep a)) => Form -> Either Text a Source #

Parse Form into a value.

Instances
FromForm Form Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

(FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] Source #

_NOTE:_ this conversion is unstable and may result in different key order (but not values).

Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

fromForm :: Form -> Either Text [(k, v)] Source #

FromHttpApiData v => FromForm (IntMap [v]) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

fromForm :: Form -> Either Text (IntMap [v]) Source #

(Ord k, FromFormKey k, FromHttpApiData v) => FromForm (Map k [v]) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

fromForm :: Form -> Either Text (Map k [v]) Source #

(Eq k, Hashable k, FromFormKey k, FromHttpApiData v) => FromForm (HashMap k [v]) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

fromForm :: Form -> Either Text (HashMap k [v]) Source #

toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])] Source #

Parse a Form into a list of entries groupped by key.

_NOTE:_ this conversion is unstable and may result in different key order (but not values). For a stable encoding see toEntriesByKeyStable.

toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])] Source #

Parse a Form into a list of entries groupped by key.

>>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
Right [("color",["red","white"]),("name",["Nick"])]

For an unstable (but faster) conversion see toEntriesByKey.

genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a Source #

A Generic-based implementation of fromForm. This is used as a default implementation in FromForm.

Note that this only works for records (i.e. product data types with named fields):

data Person = Person
  { name :: String
  , age  :: Int
  } deriving (Generic)

In this implementation each field's value gets decoded using parseQueryParam. Two field types are exceptions:

  • for values of type Maybe a an entry is parsed if present in the Form and the is decoded with parseQueryParam; if no entry is present result is Nothing;
  • for values of type [a] (except [Char]) all entries are parsed to produce a list of parsed values;

Here's an example:

data Post = Post
  { title    :: String
  , subtitle :: Maybe String
  , comments :: [String]
  } deriving (Generic, Show)

instance FromForm Post
>>> urlDecodeAsForm "comments=Nice%20post%21&comments=%2B1&title=Test" :: Either Text Post
Right (Post {title = "Test", subtitle = Nothing, comments = ["Nice post!","+1"]})

class GFromForm t (f :: * -> *) where Source #

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (f x) Source #

Instances
(GFromForm t f, GFromForm t g) => GFromForm (t :: k) (f :*: g) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text ((f :*: g) x) Source #

NotSupported FromForm t "is a sum type" => GFromForm (t :: k) (f :+: g) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text ((f :+: g) x) Source #

Selector s => GFromForm (t :: k) (M1 S s (K1 i String :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (M1 S s (K1 i String) x) Source #

(Selector s, FromHttpApiData c) => GFromForm (t :: k) (M1 S s (K1 i [c] :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (M1 S s (K1 i [c]) x) Source #

(Selector s, FromHttpApiData c) => GFromForm (t :: k) (M1 S s (K1 i (Maybe c) :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (M1 S s (K1 i (Maybe c)) x) Source #

(Selector s, FromHttpApiData c) => GFromForm (t :: k) (M1 S s (K1 i c :: Type -> Type)) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (M1 S s (K1 i c) x) Source #

GFromForm t f => GFromForm (t :: k) (M1 C x f) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (M1 C x f x0) Source #

GFromForm t f => GFromForm (t :: k) (M1 D x f) Source # 
Instance details

Defined in Web.Internal.FormUrlEncoded

Methods

gFromForm :: Proxy t -> FormOptions -> Form -> Either Text (M1 D x f x0) Source #

urlEncodeForm :: Form -> ByteString Source #

Encode a Form to an application/x-www-form-urlencoded ByteString.

_NOTE:_ this encoding is unstable and may result in different key order (but not values). For a stable encoding see urlEncodeFormStable.

urlEncodeFormStable :: Form -> ByteString Source #

Encode a Form to an application/x-www-form-urlencoded ByteString.

For an unstable (but faster) encoding see urlEncodeForm.

Key-value pairs get encoded to key=value and separated by &:

>>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
"lastname=Arni&name=Julian"

Keys with empty values get encoded to just key (without the = sign):

>>> urlEncodeFormStable [("is_test", "")]
"is_test"

Empty keys are allowed too:

>>> urlEncodeFormStable [("", "foobar")]
"=foobar"

However, if both key and value are empty, the key-value pair is ignored. (This prevents urlDecodeForm . urlEncodeFormStable from being a true isomorphism).

>>> urlEncodeFormStable [("", "")]
""

Everything is escaped with escapeURIString isUnreserved:

>>> urlEncodeFormStable [("fullname", "Andres Löh")]
"fullname=Andres%20L%C3%B6h"

urlEncodeParams :: [(Text, Text)] -> ByteString Source #

Encode a list of key-value pairs to an application/x-www-form-urlencoded ByteString.

See also urlEncodeFormStable.

urlDecodeForm :: ByteString -> Either Text Form Source #

Decode an application/x-www-form-urlencoded ByteString to a Form.

Key-value pairs get decoded normally:

>>> urlDecodeForm "name=Greg&lastname=Weber"
Right (fromList [("lastname","Weber"),("name","Greg")])

Keys with no values get decoded to pairs with empty values.

>>> urlDecodeForm "is_test"
Right (fromList [("is_test","")])

Empty keys are allowed:

>>> urlDecodeForm "=foobar"
Right (fromList [("","foobar")])

The empty string gets decoded into an empty Form:

>>> urlDecodeForm ""
Right (fromList [])

Everything is un-escaped with unEscapeString:

>>> urlDecodeForm "fullname=Andres%20L%C3%B6h"
Right (fromList [("fullname","Andres L\246h")])

Improperly formed strings result in an error:

>>> urlDecodeForm "this=has=too=many=equals"
Left "not a valid pair: this=has=too=many=equals"

urlDecodeParams :: ByteString -> Either Text [(Text, Text)] Source #

Decode an application/x-www-form-urlencoded ByteString to a list of key-value pairs.

See also urlDecodeForm.

urlDecodeAsForm :: FromForm a => ByteString -> Either Text a Source #

This is a convenience function for decoding a application/x-www-form-urlencoded ByteString directly to a datatype that has an instance of FromForm.

This is effectively fromForm <=< urlDecodeForm.

>>> urlDecodeAsForm "name=Dennis&age=22" :: Either Text Person
Right (Person {name = "Dennis", age = 22})

urlEncodeAsForm :: ToForm a => a -> ByteString Source #

This is a convenience function for encoding a datatype that has instance of ToForm directly to a application/x-www-form-urlencoded ByteString.

This is effectively urlEncodeForm . toForm.

_NOTE:_ this encoding is unstable and may result in different key order (but not values). For a stable encoding see urlEncodeAsFormStable.

urlEncodeAsFormStable :: ToForm a => a -> ByteString Source #

This is a convenience function for encoding a datatype that has instance of ToForm directly to a application/x-www-form-urlencoded ByteString.

This is effectively urlEncodeFormStable . toForm.

>>> urlEncodeAsFormStable Person {name = "Dennis", age = 22}
"age=22&name=Dennis"

lookupAll :: Text -> Form -> [Text] Source #

Find all values corresponding to a given key in a Form.

>>> lookupAll "name" []
[]
>>> lookupAll "name" [("name", "Oleg")]
["Oleg"]
>>> lookupAll "name" [("name", "Oleg"), ("name", "David")]
["Oleg","David"]

lookupMaybe :: Text -> Form -> Either Text (Maybe Text) Source #

Lookup an optional value for a key. Fail if there is more than one value.

>>> lookupMaybe "name" []
Right Nothing
>>> lookupMaybe "name" [("name", "Oleg")]
Right (Just "Oleg")
>>> lookupMaybe "name" [("name", "Oleg"), ("name", "David")]
Left "Duplicate key \"name\""

lookupUnique :: Text -> Form -> Either Text Text Source #

Lookup a unique value for a key. Fail if there is zero or more than one value.

>>> lookupUnique "name" []
Left "Could not find key \"name\""
>>> lookupUnique "name" [("name", "Oleg")]
Right "Oleg"
>>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]
Left "Duplicate key \"name\""

parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v] Source #

Lookup all values for a given key in a Form and parse them with parseQueryParams.

>>> parseAll "age" [] :: Either Text [Word8]
Right []
>>> parseAll "age" [("age", "8"), ("age", "seven")] :: Either Text [Word8]
Left "could not parse: `seven' (input does not start with a digit)"
>>> parseAll "age" [("age", "8"), ("age", "777")] :: Either Text [Word8]
Left "out of bounds: `777' (should be between 0 and 255)"
>>> parseAll "age" [("age", "12"), ("age", "25")] :: Either Text [Word8]
Right [12,25]

parseMaybe :: FromHttpApiData v => Text -> Form -> Either Text (Maybe v) Source #

Lookup an optional value for a given key and parse it with parseQueryParam. Fail if there is more than one value for the key.

>>> parseMaybe "age" [] :: Either Text (Maybe Word8)
Right Nothing
>>> parseMaybe "age" [("age", "12"), ("age", "25")] :: Either Text (Maybe Word8)
Left "Duplicate key \"age\""
>>> parseMaybe "age" [("age", "seven")] :: Either Text (Maybe Word8)
Left "could not parse: `seven' (input does not start with a digit)"
>>> parseMaybe "age" [("age", "777")] :: Either Text (Maybe Word8)
Left "out of bounds: `777' (should be between 0 and 255)"
>>> parseMaybe "age" [("age", "7")] :: Either Text (Maybe Word8)
Right (Just 7)

parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v Source #

Lookup a unique value for a given key and parse it with parseQueryParam. Fail if there is zero or more than one value for the key.

>>> parseUnique "age" [] :: Either Text Word8
Left "Could not find key \"age\""
>>> parseUnique "age" [("age", "12"), ("age", "25")] :: Either Text Word8
Left "Duplicate key \"age\""
>>> parseUnique "age" [("age", "seven")] :: Either Text Word8
Left "could not parse: `seven' (input does not start with a digit)"
>>> parseUnique "age" [("age", "777")] :: Either Text Word8
Left "out of bounds: `777' (should be between 0 and 255)"
>>> parseUnique "age" [("age", "7")] :: Either Text Word8
Right 7

data FormOptions Source #

Generic-based deriving options for ToForm and FromForm.

A common use case for non-default FormOptions is to strip a prefix off of field labels:

data Project = Project
  { projectName :: String
  , projectSize :: Int
  } deriving (Generic, Show)

myOptions :: FormOptions
myOptions = FormOptions
 { fieldLabelModifier = map toLower . drop (length "project") }

instance ToForm Project where
  toForm = genericToForm myOptions

instance FromForm Project where
  fromForm = genericFromForm myOptions
>>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 }
"name=http-api-data&size=172"
>>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
Right (Project {projectName = "http-api-data", projectSize = 172})

Constructors

FormOptions 

Fields

sortOn :: Ord b => (a -> b) -> [a] -> [a] Source #