Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- class ToFormKey k where
- class FromFormKey k where
- parseFormKey :: Text -> Either Text k
- newtype Form = Form {}
- toListStable :: Form -> [(Text, Text)]
- class ToForm a where
- fromEntriesByKey :: (ToFormKey k, ToHttpApiData v) => [(k, [v])] -> Form
- data Proxy3 a b c = Proxy3
- type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where ...
- genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
- class GToForm t (f :: * -> *) where
- gToForm :: Proxy t -> FormOptions -> f x -> Form
- class FromForm a where
- toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
- toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
- genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a
- class GFromForm t (f :: * -> *) where
- urlEncodeForm :: Form -> ByteString
- urlEncodeFormStable :: Form -> ByteString
- urlEncodeParams :: [(Text, Text)] -> ByteString
- urlDecodeForm :: ByteString -> Either Text Form
- urlDecodeParams :: ByteString -> Either Text [(Text, Text)]
- urlDecodeAsForm :: FromForm a => ByteString -> Either Text a
- urlEncodeAsForm :: ToForm a => a -> ByteString
- urlEncodeAsFormStable :: ToForm a => a -> ByteString
- lookupAll :: Text -> Form -> [Text]
- lookupMaybe :: Text -> Form -> Either Text (Maybe Text)
- lookupUnique :: Text -> Form -> Either Text Text
- parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]
- parseMaybe :: FromHttpApiData v => Text -> Form -> Either Text (Maybe v)
- parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v
- data FormOptions = FormOptions {
- fieldLabelModifier :: String -> String
- defaultFormOptions :: FormOptions
- sortOn :: Ord b => (a -> b) -> [a] -> [a]
Documentation
>>>
:set -XDeriveGeneric -XOverloadedLists -XOverloadedStrings -XFlexibleContexts -XScopedTypeVariables -XTypeFamilies
>>>
import GHC.Generics (Generic)
>>>
import Data.Char (toLower)
>>>
import Data.Text (Text)
>>>
import Data.Word (Word8)
>>>
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 #
Instances
class FromFormKey k where Source #
Instances
The contents of a form, not yet URL-encoded.
Form
can be URL-encoded with urlEncodeForm
and URL-decoded with urlDecodeForm
.
Instances
Monoid Form Source # | |
Semigroup Form Source # | |
IsList Form Source # | _NOTE:_ |
Generic Form Source # | |
Read Form Source # | |
Show Form Source # | |
Eq Form Source # | |
FromForm Form Source # | |
ToForm Form Source # | |
type Item Form Source # | |
Defined in Web.Internal.FormUrlEncoded | |
type Rep Form Source # | |
Defined in Web.Internal.FormUrlEncoded |
Convert a value into Form
.
An example type and instance:
{-# LANGUAGE OverloadedLists #-} data Person = Person { name :: String , age :: Int } instanceToForm
Person wheretoForm
person = [ ("name",toQueryParam
(name person)) , ("age",toQueryParam
(age person)) ]
Instead of manually writing
instances you can
use a default generic implementation of ToForm
.toForm
To do that, simply add deriving
clause to your datatype
and declare a Generic
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
) instanceToForm
Person
The default implementation of toForm
is genericToForm
.
Nothing
Convert a value into Form
.
Instances
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")]
type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where ... Source #
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
an entry is added to theMaybe
aForm
only when it is
and the encoded value isJust
x
;toQueryParam
xNothing
values are omitted from theForm
; - for values of type
[a]
(except[
) an entry is added for every item in the list; if the list is empty no entries are added to theChar
]Form
;
Here's an example:
data Post = Post { title :: String , subtitle :: Maybe String , comments :: [String] } deriving (Generic
,Show
) instanceToForm
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 #
Instances
(GToForm t f, GToForm t g) => GToForm (t :: k) (f :*: g) Source # | |
Defined in Web.Internal.FormUrlEncoded | |
NotSupported ToForm t "is a sum type" => GToForm (t :: k) (f :+: g) Source # | |
Defined in Web.Internal.FormUrlEncoded | |
GToForm t f => GToForm (t :: k) (M1 C x f) Source # | |
Defined in Web.Internal.FormUrlEncoded | |
GToForm t f => GToForm (t :: k) (M1 D x f) Source # | |
Defined in Web.Internal.FormUrlEncoded | |
Selector s => GToForm (t :: k) (M1 S s (K1 i String :: Type -> Type)) Source # | |
(Selector s, ToHttpApiData c) => GToForm (t :: k) (M1 S s (K1 i (Maybe c) :: Type -> Type)) Source # | |
(Selector s, ToHttpApiData c) => GToForm (t :: k) (M1 S s (K1 i [c] :: Type -> Type)) Source # | |
Defined in Web.Internal.FormUrlEncoded | |
(Selector s, ToHttpApiData c) => GToForm (t :: k) (M1 S s (K1 i c :: Type -> Type)) Source # | |
Defined in Web.Internal.FormUrlEncoded |
class FromForm a where Source #
Parse Form
into a value.
An example type and instance:
data Person = Person { name :: String , age :: Int } instanceFromForm
Person wherefromForm
f = Person<$>
parseUnique
"name" f<*>
parseUnique
"age" f
Instead of manually writing
instances you can
use a default generic implementation of FromForm
.fromForm
To do that, simply add deriving
clause to your datatype
and declare a Generic
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
) instanceFromForm
Person
The default implementation of fromForm
is genericFromForm
.
It only works for records and it will use parseQueryParam
for each field's value.
Nothing
Instances
FromForm Form Source # | |
FromHttpApiData v => FromForm (IntMap [v]) Source # | |
(FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] Source # | _NOTE:_ this conversion is unstable and may result in different key order (but not values). |
(Ord k, FromFormKey k, FromHttpApiData v) => FromForm (Map k [v]) Source # | |
(Eq k, Hashable k, FromFormKey k, FromHttpApiData v) => FromForm (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
an entry is parsed if present in theMaybe
aForm
and the is decoded withparseQueryParam
; if no entry is present result isNothing
; - for values of type
[a]
(except[
) all entries are parsed to produce a list of parsed values;Char
]
Here's an example:
data Post = Post { title :: String , subtitle :: Maybe String , comments :: [String] } deriving (Generic
,Show
) instanceFromForm
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 #
Instances
(GFromForm t f, GFromForm t g) => GFromForm (t :: k) (f :*: g) Source # | |
Defined in Web.Internal.FormUrlEncoded | |
NotSupported FromForm t "is a sum type" => GFromForm (t :: k) (f :+: g) Source # | |
Defined in Web.Internal.FormUrlEncoded | |
GFromForm t f => GFromForm (t :: k) (M1 C x f) Source # | |
GFromForm t f => GFromForm (t :: k) (M1 D x f) Source # | |
Selector s => GFromForm (t :: k) (M1 S s (K1 i String :: Type -> Type)) Source # | |
(Selector s, FromHttpApiData c) => GFromForm (t :: k) (M1 S s (K1 i (Maybe c) :: Type -> Type)) Source # | |
(Selector s, FromHttpApiData c) => GFromForm (t :: k) (M1 S s (K1 i [c] :: Type -> Type)) Source # | |
(Selector s, FromHttpApiData c) => GFromForm (t :: k) (M1 S s (K1 i c :: Type -> Type)) 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
from being a true isomorphism).urlDecodeForm
. urlEncodeFormStable
>>>
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") } instanceToForm
Project wheretoForm
=genericToForm
myOptions instanceFromForm
Project wherefromForm
=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})
FormOptions | |
|
defaultFormOptions :: FormOptions Source #
Default encoding FormOptions
.
FormOptions
{fieldLabelModifier
= id }