{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}

module Web.Hyperbole.Forms
  ( FormFields (..)
  , InputType (..)
  , Label
  , Invalid
  , Input (..)
  , field
  , label
  , input
  , form
  , placeholder
  , submit
  , parseForm
  , formField
  , Form (..)
  , defaultFormOptions
  , FormOptions (..)
  , genericFromForm
  , Validation (..)
  , FormField (..)
  , lookupInvalid
  , invalidStyle
  , invalidText
  , validate
  , validation

    -- * Re-exports
  , FromHttpApiData
  , Generic
  )
where

import Data.Functor.Identity (Identity)
import Data.Kind (Type)
import Data.Maybe (catMaybes)
import Data.Text
import Effectful
import GHC.Generics
import Text.Casing (kebab)
import Web.FormUrlEncoded qualified as FE
import Web.HttpApiData (FromHttpApiData (..))
import Web.Hyperbole.Effect
import Web.Hyperbole.HyperView (HyperView (..), Param (..), dataTarget)
import Web.Internal.FormUrlEncoded (FormOptions (..), GFromForm, defaultFormOptions, genericFromForm)
import Web.View hiding (form, input, label)


-- | The only time we can use Fields is inside a form
data FormFields id = FormFields id Validation


instance (Param id) => Param (FormFields id) where
  parseParam :: Text -> Maybe (FormFields id)
parseParam Text
t = do
    id
i <- Text -> Maybe id
forall a. Param a => Text -> Maybe a
parseParam Text
t
    FormFields id -> Maybe (FormFields id)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormFields id -> Maybe (FormFields id))
-> FormFields id -> Maybe (FormFields id)
forall a b. (a -> b) -> a -> b
$ id -> Validation -> FormFields id
forall id. id -> Validation -> FormFields id
FormFields id
i Validation
forall a. Monoid a => a
mempty
  toParam :: FormFields id -> Text
toParam (FormFields id
i Validation
_) = id -> Text
forall a. Param a => a -> Text
toParam id
i


instance (HyperView id, Param id) => HyperView (FormFields id) where
  type Action (FormFields id) = Action id


-- | Choose one for 'input's to give the browser autocomplete hints
data InputType
  = -- TODO: there are many more of these: https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/autocomplete
    NewPassword
  | CurrentPassword
  | Username
  | Email
  | Number
  | TextInput
  | Name
  | OneTimeCode
  | Organization
  | StreetAddress
  | Country
  | CountryName
  | PostalCode
  | Search
  deriving (Int -> InputType -> ShowS
[InputType] -> ShowS
InputType -> String
(Int -> InputType -> ShowS)
-> (InputType -> String)
-> ([InputType] -> ShowS)
-> Show InputType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputType -> ShowS
showsPrec :: Int -> InputType -> ShowS
$cshow :: InputType -> String
show :: InputType -> String
$cshowList :: [InputType] -> ShowS
showList :: [InputType] -> ShowS
Show)


{- | Validation results for a 'form'

@
validateUser :: User -> Age -> Validation
validateUser (User u) (Age a) =
  validation
    [ 'validate' \@Age (a < 20) "User must be at least 20 years old"
    , 'validate' \@User (T.elem ' ' u) "Username must not contain spaces"
    , 'validate' \@User (T.length u < 4) "Username must be at least 4 chars"
    ]

formAction :: ('Hyperbole' :> es, 'UserDB' :> es) => FormView -> FormAction -> 'Eff' es ('View' FormView ())
formAction _ SignUp = do
  a <- 'formField' \@Age
  u <- 'formField' \@User

  case validateUser u a of
    'Validation' [] -> successView
    errs -> userForm v
@
@
-}
newtype Validation = Validation [(Text, Text)]
  deriving newtype (NonEmpty Validation -> Validation
Validation -> Validation -> Validation
(Validation -> Validation -> Validation)
-> (NonEmpty Validation -> Validation)
-> (forall b. Integral b => b -> Validation -> Validation)
-> Semigroup Validation
forall b. Integral b => b -> Validation -> Validation
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Validation -> Validation -> Validation
<> :: Validation -> Validation -> Validation
$csconcat :: NonEmpty Validation -> Validation
sconcat :: NonEmpty Validation -> Validation
$cstimes :: forall b. Integral b => b -> Validation -> Validation
stimes :: forall b. Integral b => b -> Validation -> Validation
Semigroup, Semigroup Validation
Validation
Semigroup Validation =>
Validation
-> (Validation -> Validation -> Validation)
-> ([Validation] -> Validation)
-> Monoid Validation
[Validation] -> Validation
Validation -> Validation -> Validation
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Validation
mempty :: Validation
$cmappend :: Validation -> Validation -> Validation
mappend :: Validation -> Validation -> Validation
$cmconcat :: [Validation] -> Validation
mconcat :: [Validation] -> Validation
Monoid)


-- | Create a 'Validation' from list of validators
validation :: [Maybe (Text, Text)] -> Validation
validation :: [Maybe (Text, Text)] -> Validation
validation = [(Text, Text)] -> Validation
Validation ([(Text, Text)] -> Validation)
-> ([Maybe (Text, Text)] -> [(Text, Text)])
-> [Maybe (Text, Text)]
-> Validation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes


invalidStyle :: forall a. (FormField a) => Mod -> Validation -> Mod
invalidStyle :: forall a. FormField a => Mod -> Validation -> Mod
invalidStyle Mod
f Validation
errs =
  case forall a. FormField a => Validation -> Maybe Text
lookupInvalid @a Validation
errs of
    Maybe Text
Nothing -> Mod
forall a. a -> a
id
    Just Text
_ -> Mod
f


lookupInvalid :: forall a. (FormField a) => Validation -> Maybe Text
lookupInvalid :: forall a. FormField a => Validation -> Maybe Text
lookupInvalid (Validation [(Text, Text)]
es) = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. FormField a => Text
inputName @a) [(Text, Text)]
es


{- | Display any validation error for the 'FormField' from the 'Validation' passed to 'form'

@
'field' \@User id Style.invalid $ do
  'label' \"Username\"
  'input' Username ('placeholder' "username")
  el_ 'invalidText'
@
-}
invalidText :: forall a id. (FormField a) => View (Input id a) ()
invalidText :: forall {k} a (id :: k). FormField a => View (Input id a) ()
invalidText = do
  Input Text
_ Validation
v <- View (Input id a) (Input id a)
forall context. View context context
context
  View (Input id a) ()
-> (Text -> View (Input id a) ())
-> Maybe Text
-> View (Input id a) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe View (Input id a) ()
forall c. View c ()
none Text -> View (Input id a) ()
forall c. Text -> View c ()
text (Maybe Text -> View (Input id a) ())
-> Maybe Text -> View (Input id a) ()
forall a b. (a -> b) -> a -> b
$ forall a. FormField a => Validation -> Maybe Text
lookupInvalid @a Validation
v


-- | specify a check for a 'Validation'
validate :: forall a. (FormField a) => Bool -> Text -> Maybe (Text, Text)
validate :: forall a. FormField a => Bool -> Text -> Maybe (Text, Text)
validate Bool
True Text
t = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (forall a. FormField a => Text
inputName @a, Text
t)
validate Bool
False Text
_ = Maybe (Text, Text)
forall a. Maybe a
Nothing


data Label a


data Invalid a


data Input id a = Input Text Validation


{- | Display a 'FormField'

@
data Age = Age Int deriving (Generic, FormField)

myForm = do
  'form' SignUp mempty id $ do
    field @Age id id $ do
     'label' "Age"
     'input' Number (value "0")
@
-}
field :: forall a id. (FormField a) => Mod -> Mod -> View (Input id a) () -> View (FormFields id) ()
field :: forall a id.
FormField a =>
Mod -> Mod -> View (Input id a) () -> View (FormFields id) ()
field Mod
f Mod
inv View (Input id a) ()
cnt = do
  let n :: Text
n = forall a. FormField a => Text
inputName @a
  FormFields id
_ Validation
v <- View (FormFields id) (FormFields id)
forall context. View context context
context
  Text -> Mod -> View (FormFields id) () -> View (FormFields id) ()
forall c. Text -> Mod -> View c () -> View c ()
tag Text
"label" (Mod
f Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
flexCol Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FormField a => Mod -> Validation -> Mod
invalidStyle @a Mod
inv Validation
v) (View (FormFields id) () -> View (FormFields id) ())
-> View (FormFields id) () -> View (FormFields id) ()
forall a b. (a -> b) -> a -> b
$
    Input id a -> View (Input id a) () -> View (FormFields id) ()
forall context c. context -> View context () -> View c ()
addContext (Text -> Validation -> Input id a
forall {k} {k} (id :: k) (a :: k). Text -> Validation -> Input id a
Input Text
n Validation
v) View (Input id a) ()
cnt


-- | label for a 'field'
label :: Text -> View (Input id a) ()
label :: forall {k} {k} (id :: k) (a :: k). Text -> View (Input id a) ()
label = Text -> View (Input id a) ()
forall c. Text -> View c ()
text


-- | input for a 'field'
input :: InputType -> Mod -> View (Input id a) ()
input :: forall {k} {k} (id :: k) (a :: k).
InputType -> Mod -> View (Input id a) ()
input InputType
ft Mod
f = do
  Input Text
nm Validation
_ <- View (Input id a) (Input id a)
forall context. View context context
context
  Text -> Mod -> View (Input id a) () -> View (Input id a) ()
forall c. Text -> Mod -> View c () -> View c ()
tag Text
"input" (Mod
f Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Mod
name Text
nm Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Mod
att Text
"type" (InputType -> Text
forall {a}. IsString a => InputType -> a
inpType InputType
ft) Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Mod
att Text
"autocomplete" (InputType -> Text
auto InputType
ft)) View (Input id a) ()
forall c. View c ()
none
 where
  inpType :: InputType -> a
inpType InputType
NewPassword = a
"password"
  inpType InputType
CurrentPassword = a
"password"
  inpType InputType
Number = a
"number"
  inpType InputType
Email = a
"email"
  inpType InputType
Search = a
"search"
  inpType InputType
_ = a
"text"

  auto :: InputType -> Text
  auto :: InputType -> Text
auto = String -> Text
pack (String -> Text) -> (InputType -> String) -> InputType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
kebab ShowS -> (InputType -> String) -> InputType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputType -> String
forall a. Show a => a -> String
show


placeholder :: Text -> Mod
placeholder :: Text -> Mod
placeholder = Text -> Text -> Mod
att Text
"placeholder"


{- | Type-safe \<form\>. Calls (Action id) on submit

@
userForm :: 'Validation' -> 'View' FormView ()
userForm v = do
  form Signup v id $ do
    el Style.h1 "Sign Up"

    'field' \@User id Style.invalid $ do
      'label' \"Username\"
      'input' Username ('placeholder' "username")
      el_ 'invalidText'

    'field' \@Age id Style.invalid $ do
      'label' \"Age\"
      'input' Number ('placeholder' "age" . value "0")
      el_ 'invalidText'

    'submit' (border 1) \"Submit\"
@
-}
form :: forall id. (HyperView id) => Action id -> Validation -> Mod -> View (FormFields id) () -> View id ()
form :: forall id.
HyperView id =>
Action id
-> Validation -> Mod -> View (FormFields id) () -> View id ()
form Action id
a Validation
v Mod
f View (FormFields id) ()
cnt = do
  id
vid <- View id id
forall context. View context context
context
  -- let frm = formLabels :: form Label
  -- let cnt = fcnt frm
  Text -> Mod -> View id () -> View id ()
forall c. Text -> Mod -> View c () -> View c ()
tag Text
"form" (Action id -> Mod
forall a. Param a => a -> Mod
onSubmit Action id
a Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. id -> Mod
forall a. Param a => a -> Mod
dataTarget id
vid Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
f Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
flexCol) (View id () -> View id ()) -> View id () -> View id ()
forall a b. (a -> b) -> a -> b
$ FormFields id -> View (FormFields id) () -> View id ()
forall context c. context -> View context () -> View c ()
addContext (id -> Validation -> FormFields id
forall id. id -> Validation -> FormFields id
FormFields id
vid Validation
v) View (FormFields id) ()
cnt
 where
  onSubmit :: (Param a) => a -> Mod
  onSubmit :: forall a. Param a => a -> Mod
onSubmit = Text -> Text -> Mod
att Text
"data-on-submit" (Text -> Mod) -> (a -> Text) -> a -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Param a => a -> Text
toParam


-- | Button that submits the 'form'. Use 'button' to specify actions other than submit
submit :: Mod -> View (FormFields id) () -> View (FormFields id) ()
submit :: forall id.
Mod -> View (FormFields id) () -> View (FormFields id) ()
submit Mod
f = Text -> Mod -> View (FormFields id) () -> View (FormFields id) ()
forall c. Text -> Mod -> View c () -> View c ()
tag Text
"button" (Text -> Text -> Mod
att Text
"type" Text
"submit" Mod -> Mod -> Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod
f)


type family Field' (context :: Type -> Type) a
type instance Field' Identity a = a
type instance Field' Label a = Text
type instance Field' Invalid a = Maybe Text


parseForm :: forall form es. (Form form, Hyperbole :> es) => Eff es (form Identity)
parseForm :: forall (form :: (* -> *) -> *) (es :: [Effect]).
(Form form, Hyperbole :> es) =>
Eff es (form Identity)
parseForm = do
  Form
f <- Eff es Form
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Form
formData
  let ef :: Either Text (form Identity)
ef = Form -> Either Text (form Identity)
forall (form :: (* -> *) -> *).
Form form =>
Form -> Either Text (form Identity)
fromForm Form
f :: Either Text (form Identity)
  (Text -> Eff es (form Identity))
-> (form Identity -> Eff es (form Identity))
-> Either Text (form Identity)
-> Eff es (form Identity)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Eff es (form Identity)
forall (es :: [Effect]) a. (Hyperbole :> es) => Text -> Eff es a
parseError form Identity -> Eff es (form Identity)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Text (form Identity)
ef


{- | Parse a 'FormField' from the request

@
formAction :: ('Hyperbole' :> es, 'UserDB' :> es) => FormView -> FormAction -> 'Eff' es ('View' FormView ())
formAction _ SignUp = do
  a <- formField \@Age
  u <- formField \@User
  saveUserToDB u a
  pure $ el_ "Saved!"
@
-}
formField :: forall a es. (FormField a, Hyperbole :> es) => Eff es a
formField :: forall a (es :: [Effect]).
(FormField a, Hyperbole :> es) =>
Eff es a
formField = do
  Form
f <- Eff es Form
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Form
formData
  case Text -> Form -> Either Text a
forall a. FormField a => Text -> Form -> Either Text a
fieldParse (forall a. FormField a => Text
inputName @a) Form
f of
    Left Text
e -> Text -> Eff es a
forall (es :: [Effect]) a. (Hyperbole :> es) => Text -> Eff es a
parseError Text
e
    Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


class Form (form :: (Type -> Type) -> Type) where
  formLabels :: form Label
  default formLabels :: (Generic (form Label), GForm (Rep (form Label))) => form Label
  formLabels = Rep (form Label) Any -> form Label
forall a x. Generic a => Rep a x -> a
forall x. Rep (form Label) x -> form Label
to Rep (form Label) Any
forall p. Rep (form Label) p
forall {k} (f :: k -> *) (p :: k). GForm f => f p
gForm


  formInvalid :: form Invalid
  default formInvalid :: (Generic (form Invalid), GForm (Rep (form Invalid))) => form Invalid
  formInvalid = Rep (form Invalid) Any -> form Invalid
forall a x. Generic a => Rep a x -> a
forall x. Rep (form Invalid) x -> form Invalid
to Rep (form Invalid) Any
forall p. Rep (form Invalid) p
forall {k} (f :: k -> *) (p :: k). GForm f => f p
gForm


  fromForm :: FE.Form -> Either Text (form Identity)
  default fromForm :: (Generic (form Identity), GFromForm (form Identity) (Rep (form Identity))) => FE.Form -> Either Text (form Identity)
  fromForm = FormOptions -> Form -> Either Text (form Identity)
forall a.
(Generic a, GFromForm a (Rep a)) =>
FormOptions -> Form -> Either Text a
genericFromForm FormOptions
defaultFormOptions


-- | Automatically derive labels from form field names
class GForm f where
  gForm :: f p


instance GForm U1 where
  gForm :: forall (p :: k). U1 p
gForm = U1 p
forall k (p :: k). U1 p
U1


instance (GForm f, GForm g) => GForm (f :*: g) where
  gForm :: forall (p :: k). (:*:) f g p
gForm = f p
forall (p :: k). f p
forall {k} (f :: k -> *) (p :: k). GForm f => f p
gForm f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
forall (p :: k). g p
forall {k} (f :: k -> *) (p :: k). GForm f => f p
gForm


instance (GForm f) => GForm (M1 D d f) where
  gForm :: forall (p :: k). M1 D d f p
gForm = f p -> M1 D d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f p
forall (p :: k). f p
forall {k} (f :: k -> *) (p :: k). GForm f => f p
gForm


instance (GForm f) => GForm (M1 C c f) where
  gForm :: forall (p :: k). M1 C c f p
gForm = f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f p
forall (p :: k). f p
forall {k} (f :: k -> *) (p :: k). GForm f => f p
gForm


instance (Selector s) => GForm (M1 S s (K1 R Text)) where
  gForm :: forall (p :: k). M1 S s (K1 R Text) p
gForm = K1 R Text p -> M1 S s (K1 R Text) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R Text p -> M1 S s (K1 R Text) p)
-> (Text -> K1 R Text p) -> Text -> M1 S s (K1 R Text) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> K1 R Text p
forall k i c (p :: k). c -> K1 i c p
K1 (Text -> M1 S s (K1 R Text) p) -> Text -> M1 S s (K1 R Text) p
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (M1 S s (K1 R Text) Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s (K1 R Text) p
forall {k} {p :: k}. M1 S s (K1 R Text) p
forall a. HasCallStack => a
undefined :: M1 S s (K1 R Text) p))


instance GForm (M1 S s (K1 R (Maybe Text))) where
  gForm :: forall (p :: k). M1 S s (K1 R (Maybe Text)) p
gForm = K1 R (Maybe Text) p -> M1 S s (K1 R (Maybe Text)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (Maybe Text) p -> M1 S s (K1 R (Maybe Text)) p)
-> (Maybe Text -> K1 R (Maybe Text) p)
-> Maybe Text
-> M1 S s (K1 R (Maybe Text)) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> K1 R (Maybe Text) p
forall k i c (p :: k). c -> K1 i c p
K1 (Maybe Text -> M1 S s (K1 R (Maybe Text)) p)
-> Maybe Text -> M1 S s (K1 R (Maybe Text)) p
forall a b. (a -> b) -> a -> b
$ Maybe Text
forall a. Maybe a
Nothing


{- | Form Fields are identified by a type

@
data User = User Text deriving (Generic, FormField)
data Age = Age Int deriving (Generic, FormField)
@
-}
class FormField a where
  inputName :: Text
  default inputName :: (Generic a, GDataName (Rep a)) => Text
  inputName = Rep a Any -> Text
forall p. Rep a p -> Text
forall {k} (f :: k -> *) (p :: k). GDataName f => f p -> Text
gDataName (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from (a
forall a. HasCallStack => a
undefined :: a))


  fieldParse :: Text -> FE.Form -> Either Text a
  default fieldParse :: (Generic a, GFieldParse (Rep a)) => Text -> FE.Form -> Either Text a
  fieldParse Text
t Form
f = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Either Text (Rep a Any) -> Either Text a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form -> Either Text (Rep a Any)
forall p. Text -> Form -> Either Text (Rep a p)
forall {k} (f :: k -> *) (p :: k).
GFieldParse f =>
Text -> Form -> Either Text (f p)
gFieldParse Text
t Form
f


class GDataName f where
  gDataName :: f p -> Text


instance (Datatype d) => GDataName (M1 D d (M1 C c f)) where
  gDataName :: forall (p :: k). M1 D d (M1 C c f) p -> Text
gDataName M1 D d (M1 C c f) p
m1 = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 D d (M1 C c f) p -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> String
datatypeName M1 D d (M1 C c f) p
m1


class GFieldParse f where
  gFieldParse :: Text -> FE.Form -> Either Text (f p)


instance (GFieldParse f) => GFieldParse (M1 D d f) where
  gFieldParse :: forall (p :: k). Text -> Form -> Either Text (M1 D d f p)
gFieldParse Text
t Form
f = f p -> M1 D d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D d f p)
-> Either Text (f p) -> Either Text (M1 D d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form -> Either Text (f p)
forall (p :: k). Text -> Form -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFieldParse f =>
Text -> Form -> Either Text (f p)
gFieldParse Text
t Form
f


instance (GFieldParse f) => GFieldParse (M1 C c f) where
  gFieldParse :: forall (p :: k). Text -> Form -> Either Text (M1 C c f p)
gFieldParse Text
t Form
f = f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p)
-> Either Text (f p) -> Either Text (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form -> Either Text (f p)
forall (p :: k). Text -> Form -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFieldParse f =>
Text -> Form -> Either Text (f p)
gFieldParse Text
t Form
f


instance (GFieldParse f) => GFieldParse (M1 S s f) where
  gFieldParse :: forall (p :: k). Text -> Form -> Either Text (M1 S s f p)
gFieldParse Text
t Form
f = f p -> M1 S s f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 S s f p)
-> Either Text (f p) -> Either Text (M1 S s f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form -> Either Text (f p)
forall (p :: k). Text -> Form -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFieldParse f =>
Text -> Form -> Either Text (f p)
gFieldParse Text
t Form
f


instance (FromHttpApiData a) => GFieldParse (K1 R a) where
  gFieldParse :: forall (p :: k). Text -> Form -> Either Text (K1 R a p)
gFieldParse Text
t Form
f = a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a p) -> Either Text a -> Either Text (K1 R a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form -> Either Text a
forall v. FromHttpApiData v => Text -> Form -> Either Text v
FE.parseUnique Text
t Form
f