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

module Web.Hyperbole.View.Forms
  ( FormFields (..)
  , InputType (..)
  , FieldName
  , Invalid
  , Input (..)
  , field
  , label
  , input
  , form
  , textarea
  , placeholder
  , submit
  , formData
  , Form (..)
  , formParseParam
  , formLookupParam
  , formFields
  , formFieldsWith
  , Field
  , defaultFormOptions
  , FormOptions (..)
  , Validated (..)
  , FormField (..)
  , fieldValid
  , anyInvalid
  , invalidText
  , validate
  , Identity

    -- * Re-exports
  , FromParam
  , Generic
  , GenFields (..)
  , GenField (..)
  )
where

import Data.Function ((&))
import Data.Functor.Identity (Identity (..))
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import Debug.Trace
import Effectful
import GHC.Generics
import Text.Casing (kebab)
import Web.FormUrlEncoded (FormOptions (..), defaultFormOptions, parseUnique)
import Web.FormUrlEncoded qualified as FE
import Web.Hyperbole.Data.QueryData (FromParam (..), Param (..), ParamValue (..))
import Web.Hyperbole.Effect.Hyperbole
import Web.Hyperbole.Effect.Request
import Web.Hyperbole.Effect.Response (parseError)
import Web.Hyperbole.HyperView
import Web.Hyperbole.View.Event (onSubmit)
import Web.View hiding (form, input, label)
import Web.View.Style (addClass, cls, prop)


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


data FormField v a = FormField
  { forall {k} (v :: k -> *) (a :: k). FormField v a -> FieldName a
fieldName :: FieldName a
  , forall {k} (v :: k -> *) (a :: k). FormField v a -> v a
validated :: v a
  }
  deriving (Int -> FormField v a -> ShowS
[FormField v a] -> ShowS
FormField v a -> String
(Int -> FormField v a -> ShowS)
-> (FormField v a -> String)
-> ([FormField v a] -> ShowS)
-> Show (FormField v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (v :: k -> *) (a :: k).
Show (v a) =>
Int -> FormField v a -> ShowS
forall k (v :: k -> *) (a :: k).
Show (v a) =>
[FormField v a] -> ShowS
forall k (v :: k -> *) (a :: k).
Show (v a) =>
FormField v a -> String
$cshowsPrec :: forall k (v :: k -> *) (a :: k).
Show (v a) =>
Int -> FormField v a -> ShowS
showsPrec :: Int -> FormField v a -> ShowS
$cshow :: forall k (v :: k -> *) (a :: k).
Show (v a) =>
FormField v a -> String
show :: FormField v a -> String
$cshowList :: forall k (v :: k -> *) (a :: k).
Show (v a) =>
[FormField v a] -> ShowS
showList :: [FormField v a] -> ShowS
Show)


-- instance Show (v a) => Show (FormField v) where
--   show f = "Form Field"

-- instance (ViewId id) => ViewId (FormFields id v fs) where
--   parseViewId t = do
--     i <- parseViewId t
--     pure $ FormFields i lbls mempty
--   toViewId (FormFields i _ _) = toViewId i
--
--
-- instance (HyperView id, ViewId id) => HyperView (FormFields id v fs) where
--   type Action (FormFields id v fs) = 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'. See 'validate'

@
data UserForm f = UserForm
  { user :: Field f User
  , age :: Field f Int
  , pass1 :: Field f Text
  , pass2 :: Field f Text
  }
  deriving (Generic)
instance Form UserForm Validated

validateForm :: UserForm Identity -> UserForm Validated
validateForm u =
  UserForm
    { user = validateUser u.user
    , age = validateAge u.age
    , pass1 = validatePass u.pass1 u.pass2
    , pass2 = NotInvalid
    }

validateAge :: Int -> Validated Int
validateAge a =
  validate (a < 20) \"User must be at least 20 years old\"
@
-}
data Validated a = Invalid Text | NotInvalid | Valid
  deriving (Int -> Validated a -> ShowS
[Validated a] -> ShowS
Validated a -> String
(Int -> Validated a -> ShowS)
-> (Validated a -> String)
-> ([Validated a] -> ShowS)
-> Show (Validated a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Validated a -> ShowS
forall k (a :: k). [Validated a] -> ShowS
forall k (a :: k). Validated a -> String
$cshowsPrec :: forall k (a :: k). Int -> Validated a -> ShowS
showsPrec :: Int -> Validated a -> ShowS
$cshow :: forall k (a :: k). Validated a -> String
show :: Validated a -> String
$cshowList :: forall k (a :: k). [Validated a] -> ShowS
showList :: [Validated a] -> ShowS
Show)


instance Semigroup (Validated a) where
  Invalid Text
t <> :: Validated a -> Validated a -> Validated a
<> Validated a
_ = Text -> Validated a
forall {k} (a :: k). Text -> Validated a
Invalid Text
t
  Validated a
_ <> Invalid Text
t = Text -> Validated a
forall {k} (a :: k). Text -> Validated a
Invalid Text
t
  Validated a
Valid <> Validated a
_ = Validated a
forall {k} (a :: k). Validated a
Valid
  Validated a
_ <> Validated a
Valid = Validated a
forall {k} (a :: k). Validated a
Valid
  Validated a
a <> Validated a
_ = Validated a
a


instance Monoid (Validated a) where
  mempty :: Validated a
mempty = Validated a
forall {k} (a :: k). Validated a
NotInvalid


class ValidationState (v :: Type -> Type) where
  convert :: v a -> v b
  isInvalid :: v a -> Bool


instance ValidationState Validated where
  convert :: Validated a -> Validated b
  convert :: forall {k} {k} (a :: k) (b :: k). Validated a -> Validated b
convert (Invalid Text
t) = Text -> Validated b
forall {k} (a :: k). Text -> Validated a
Invalid Text
t
  convert Validated a
NotInvalid = Validated b
forall {k} (a :: k). Validated a
NotInvalid
  convert Validated a
Valid = Validated b
forall {k} (a :: k). Validated a
Valid


  isInvalid :: Validated a -> Bool
  isInvalid :: forall {k} (a :: k). Validated a -> Bool
isInvalid (Invalid Text
_) = Bool
True
  isInvalid Validated a
_ = Bool
False


{- Only shows if 'Validated' is 'Invalid'. See 'formFieldsWith'
@
@
-}
invalidText :: forall a id. View (Input id Validated a) ()
invalidText :: forall a id. View (Input id Validated a) ()
invalidText = do
  Input FieldName a
_ Validated a
v <- View (Input id Validated a) (Input id Validated a)
forall context. View context context
context
  case Validated a
v of
    Invalid Text
t -> Text -> View (Input id Validated a) ()
forall c. Text -> View c ()
text Text
t
    Validated a
_ -> View (Input id Validated a) ()
forall c. View c ()
none


{- | specify a check for a 'Validation'

@
validateAge :: Int -> Validated Int
validateAge a =
  validate (a < 20) \"User must be at least 20 years old\"
@
-}
validate :: Bool -> Text -> Validated a
validate :: forall {k} (a :: k). Bool -> Text -> Validated a
validate Bool
True Text
t = Text -> Validated a
forall {k} (a :: k). Text -> Validated a
Invalid Text
t -- Validation [(inputName @a, Invalid t)]
validate Bool
False Text
_ = Validated a
forall {k} (a :: k). Validated a
NotInvalid -- Validation [(inputName @a, NotInvalid)]


-- validateWith :: forall a fs v. (FormField a, Elem a fs, ValidationState v) => v a -> Validation' v fs
-- validateWith v = Validation [(inputName @a, convert v)]

-- eh... not sure how to do this...
anyInvalid :: forall form val. (Form form val, ValidationState val) => form val -> Bool
anyInvalid :: forall (form :: (* -> *) -> *) (val :: * -> *).
(Form form val, ValidationState val) =>
form val -> Bool
anyInvalid form val
f = (val () -> Bool) -> [val ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any val () -> Bool
forall a. val a -> Bool
forall (v :: * -> *) a. ValidationState v => v a -> Bool
isInvalid (form val -> [val ()]
forall (form :: (* -> *) -> *) (val :: * -> *).
(Form form val, ValidationState val) =>
form val -> [val ()]
collectValids form val
f :: [val ()])


-- any (isInvalid . snd) vs

-- | Returns the 'Validated' for the 'field'. See 'formFieldsWith'
fieldValid :: View (Input id v a) (v a)
fieldValid :: forall id (v :: * -> *) a. View (Input id v a) (v a)
fieldValid = do
  Input FieldName a
_ v a
v <- View (Input id v a) (Input id v a)
forall context. View context context
context
  v a -> View (Input id v a) (v a)
forall a. a -> View (Input id v a) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v a
v


data FieldName a = FieldName Text
  deriving (Int -> FieldName a -> ShowS
[FieldName a] -> ShowS
FieldName a -> String
(Int -> FieldName a -> ShowS)
-> (FieldName a -> String)
-> ([FieldName a] -> ShowS)
-> Show (FieldName a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> FieldName a -> ShowS
forall k (a :: k). [FieldName a] -> ShowS
forall k (a :: k). FieldName a -> String
$cshowsPrec :: forall k (a :: k). Int -> FieldName a -> ShowS
showsPrec :: Int -> FieldName a -> ShowS
$cshow :: forall k (a :: k). FieldName a -> String
show :: FieldName a -> String
$cshowList :: forall k (a :: k). [FieldName a] -> ShowS
showList :: [FieldName a] -> ShowS
Show)


data Invalid a


data Input (id :: Type) (valid :: Type -> Type) (a :: Type) = Input
  { forall id (valid :: * -> *) a. Input id valid a -> FieldName a
inputName :: FieldName a
  , forall id (valid :: * -> *) a. Input id valid a -> valid a
valid :: valid a
  }


-- | Display a 'FormField'. See 'form' and 'Form'
field
  :: forall (id :: Type) (v :: Type -> Type) (a :: Type)
   . FormField v a
  -> (v a -> Mod (FormFields id))
  -> View (Input id v a) ()
  -> View (FormFields id) ()
field :: forall id (v :: * -> *) a.
FormField v a
-> (v a -> Mod (FormFields id))
-> View (Input id v a) ()
-> View (FormFields id) ()
field FormField v a
fld v a -> Mod (FormFields id)
md View (Input id v a) ()
cnt = do
  Text
-> Mod (FormFields id)
-> View (FormFields id) ()
-> View (FormFields id) ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"label" (v a -> Mod (FormFields id)
md FormField v a
fld.validated Mod (FormFields id) -> Mod (FormFields id) -> Mod (FormFields id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod (FormFields id)
forall c. Mod c
flexCol) (View (FormFields id) () -> View (FormFields id) ())
-> View (FormFields id) () -> View (FormFields id) ()
forall a b. (a -> b) -> a -> b
$ do
    Input id v a -> View (Input id v a) () -> View (FormFields id) ()
forall context c. context -> View context () -> View c ()
addContext (FieldName a -> v a -> Input id v a
forall id (valid :: * -> *) a.
FieldName a -> valid a -> Input id valid a
Input FormField v a
fld.fieldName FormField v a
fld.validated) View (Input id v a) ()
cnt


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


-- | input for a 'field'
input :: InputType -> Mod (Input id v a) -> View (Input id v a) ()
input :: forall id (v :: * -> *) a.
InputType -> Mod (Input id v a) -> View (Input id v a) ()
input InputType
ft Mod (Input id v a)
f = do
  Input (FieldName Text
nm) v a
_ <- View (Input id v a) (Input id v a)
forall context. View context context
context
  Text
-> Mod (Input id v a)
-> View (Input id v a) ()
-> View (Input id v a) ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"input" (Mod (Input id v a)
f Mod (Input id v a) -> Mod (Input id v a) -> Mod (Input id v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Mod (Input id v a)
forall c. Text -> Mod c
name Text
nm Mod (Input id v a) -> Mod (Input id v a) -> Mod (Input id v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Mod (Input id v a)
forall c. Text -> Text -> Mod c
att Text
"type" (InputType -> Text
forall {a}. IsString a => InputType -> a
inpType InputType
ft) Mod (Input id v a) -> Mod (Input id v a) -> Mod (Input id v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Mod (Input id v a)
forall c. Text -> Text -> Mod c
att Text
"autocomplete" (InputType -> Text
auto InputType
ft)) View (Input id v 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 id
placeholder :: forall c. Text -> Mod c
placeholder = Text -> Text -> Mod id
forall c. Text -> Text -> Mod c
att Text
"placeholder"


-- | textarea for a 'field'
textarea :: Mod (Input id v a) -> Maybe Text -> View (Input id v a) ()
textarea :: forall id (v :: * -> *) a.
Mod (Input id v a) -> Maybe Text -> View (Input id v a) ()
textarea Mod (Input id v a)
f Maybe Text
mDefaultText = do
  Input (FieldName Text
nm) v a
_ <- View (Input id v a) (Input id v a)
forall context. View context context
context
  Text
-> Mod (Input id v a)
-> View (Input id v a) ()
-> View (Input id v a) ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"textarea" (Mod (Input id v a)
f Mod (Input id v a) -> Mod (Input id v a) -> Mod (Input id v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Mod (Input id v a)
forall c. Text -> Mod c
name Text
nm) (Text -> View (Input id v a) ()
forall c. Text -> View c ()
text (Text -> View (Input id v a) ()) -> Text -> View (Input id v a) ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mDefaultText)


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

@
formView :: 'View' FormView ()
formView = do
  -- create formfields for our form
  let f = formFields @ContactForm
  form @ContactForm Submit (gap 10 . pad 10) $ do
    'el' Style.h1 \"Add Contact\"

    -- pass the form field into the 'field' function
    field f.name (const id) $ do
      label \"Contact Name\"
      input Username (inp . placeholder \"contact name\")

    field f.age (const id) $ do
      label \"Age\"
      input Number (inp . placeholder \"age\" . value \"0\")

    submit Style.btn \"Submit\"
 where
  inp = Style.input
@
-}
form :: (Form form v, ViewAction (Action id)) => Action id -> Mod id -> View (FormFields id) () -> View id ()
form :: forall (form :: (* -> *) -> *) (v :: * -> *) id.
(Form form v, ViewAction (Action id)) =>
Action id -> Mod id -> View (FormFields id) () -> View id ()
form Action id
a Mod id
md View (FormFields id) ()
cnt = do
  id
vid <- View id id
forall context. View context context
context
  Text -> Mod id -> View id () -> View id ()
forall c. Text -> Mod c -> View c () -> View c ()
tag Text
"form" (Action id -> Mod id
forall id. ViewAction (Action id) => Action id -> Mod id
onSubmit Action id
a Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod id
md Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod id
forall c. Mod c
flexCol Mod id -> Mod id -> Mod id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod id
forall c. Mod c
marginEnd0) (View id () -> View id ()) -> View id () -> View id ()
forall a b. (a -> b) -> a -> b
$ do
    FormFields id -> View (FormFields id) () -> View id ()
forall context c. context -> View context () -> View c ()
addContext (id -> FormFields id
forall id. id -> FormFields id
FormFields id
vid) View (FormFields id) ()
cnt
 where
  -- not sure why chrome is adding margin-block-end: 16 to forms? Add to web-view?
  marginEnd0 :: Mod c
marginEnd0 =
    Class -> Mod c
forall c. Class -> Mod c
addClass (Class -> Mod c) -> Class -> Mod c
forall a b. (a -> b) -> a -> b
$
      ClassName -> Class
cls ClassName
"mg-end-0"
        Class -> (Class -> Class) -> Class
forall a b. a -> (a -> b) -> b
& forall val. ToStyleValue val => Text -> val -> Class -> Class
prop @PxRem Text
"margin-block-end" PxRem
0


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


{- | Field allows a Higher Kinded 'Form' to reuse the same selectors for form parsing, generating html forms, and validation

> Field Identity Text ~ Text
> Field Maybe Text ~ Maybe Text
-}
type family Field (context :: Type -> Type) a


type instance Field Identity a = a
type instance Field FieldName a = FieldName a
type instance Field (FormField v) a = FormField v a
type instance Field Validated a = Validated a
type instance Field Maybe a = Maybe a
type instance Field (Either String) a = Either String a


formData :: forall form val es. (Form form val, Hyperbole :> es) => Eff es (form Identity)
formData :: forall (form :: (* -> *) -> *) (val :: * -> *) (es :: [Effect]).
(Form form val, Hyperbole :> es) =>
Eff es (form Identity)
formData = do
  Form
f <- Eff es Form
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Form
formBody
  String -> Eff es ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> Eff es ()) -> String -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Form -> String
forall a. Show a => a -> String
show Form
f
  let ef :: Either Text (form Identity)
ef = forall (form :: (* -> *) -> *) (val :: * -> *).
Form form val =>
Form -> Either Text (form Identity)
formParse @form @val Form
f :: Either Text (form Identity)
  case Either Text (form Identity)
ef of
    Left Text
e -> Text -> Eff es (form Identity)
forall (es :: [Effect]) a. (Hyperbole :> es) => Text -> Eff es a
parseError Text
e
    Right form Identity
a -> form Identity -> Eff es (form Identity)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure form Identity
a


{- | A Form is a Higher Kinded record listing each 'Field'. `ContactForm` `Identity` behaves like a normal record, while `ContactForm` `Maybe` would be maybe values for each field

From [Example.Page.FormSimple](https://docs.hyperbole.live/formsimple)

@
data ContactForm f = ExampleForm
  { name :: Field f Text
  , age :: Field f Int
  }
  deriving (Generic)
instance Form ContactForm Maybe
@
-}
class Form form (val :: Type -> Type) | form -> val where
  formParse :: FE.Form -> Either Text (form Identity)
  default formParse :: (Generic (form Identity), GFormParse (Rep (form Identity))) => FE.Form -> Either Text (form Identity)
  formParse Form
f = Rep (form Identity) Any -> form Identity
forall a x. Generic a => Rep a x -> a
forall x. Rep (form Identity) x -> form Identity
to (Rep (form Identity) Any -> form Identity)
-> Either Text (Rep (form Identity) Any)
-> Either Text (form Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Form -> Either Text (Rep (form Identity) Any)
forall p. Form -> Either Text (Rep (form Identity) p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either Text (f p)
gFormParse Form
f


  collectValids :: (ValidationState val) => form val -> [val ()]
  default collectValids :: (Generic (form val), GCollect (Rep (form val)) val) => form val -> [val ()]
  collectValids form val
f = Rep (form val) Any -> [val ()]
forall p. Rep (form val) p -> [val ()]
forall {k} (ra :: k -> *) (v :: * -> *) (p :: k).
GCollect ra v =>
ra p -> [v ()]
gCollect (form val -> Rep (form val) Any
forall x. form val -> Rep (form val) x
forall a x. Generic a => a -> Rep a x
from form val
f)


  genForm :: form val
  default genForm :: (Generic (form val), GenFields (Rep (form val))) => form val
  genForm = Rep (form val) Any -> form val
forall a x. Generic a => Rep a x -> a
forall x. Rep (form val) x -> form val
to Rep (form val) Any
forall p. Rep (form val) p
forall {k} (f :: k -> *) (p :: k). GenFields f => f p
gGenFields


  genFieldsWith :: form val -> form (FormField val)
  default genFieldsWith
    :: (Generic (form val), Generic (form (FormField val)), GConvert (Rep (form val)) (Rep (form (FormField val))))
    => form val
    -> form (FormField val)
  genFieldsWith form val
fv = Rep (form (FormField val)) Any -> form (FormField val)
forall a x. Generic a => Rep a x -> a
forall x. Rep (form (FormField val)) x -> form (FormField val)
to (Rep (form (FormField val)) Any -> form (FormField val))
-> Rep (form (FormField val)) Any -> form (FormField val)
forall a b. (a -> b) -> a -> b
$ Rep (form val) Any -> Rep (form (FormField val)) Any
forall p. Rep (form val) p -> Rep (form (FormField val)) p
forall {k} (ra :: k -> *) (rc :: k -> *) (p :: k).
GConvert ra rc =>
ra p -> rc p
gConvert (form val -> Rep (form val) Any
forall x. form val -> Rep (form val) x
forall a x. Generic a => a -> Rep a x
from form val
fv)


formParseParam :: (FromParam a) => Param -> FE.Form -> Either Text a
formParseParam :: forall a. FromParam a => Param -> Form -> Either Text a
formParseParam (Param Text
key) Form
frm = do
  Text
t <- forall v. FromHttpApiData v => Text -> Form -> Either Text v
FE.parseUnique @Text Text
key Form
frm
  ParamValue -> Either Text a
forall a. FromParam a => ParamValue -> Either Text a
parseParam (Text -> ParamValue
ParamValue Text
t)


formLookupParam :: (FromParam a) => Param -> FE.Form -> Either Text (Maybe a)
formLookupParam :: forall a. FromParam a => Param -> Form -> Either Text (Maybe a)
formLookupParam (Param Text
key) Form
frm = do
  Maybe Text
mt <- forall v.
FromHttpApiData v =>
Text -> Form -> Either Text (Maybe v)
FE.parseMaybe @Text Text
key Form
frm
  Either Text (Maybe a)
-> (Text -> Either Text (Maybe a))
-> Maybe Text
-> Either Text (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Either Text (Maybe a)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) (ParamValue -> Either Text (Maybe a)
forall a. FromParam a => ParamValue -> Either Text a
parseParam (ParamValue -> Either Text (Maybe a))
-> (Text -> ParamValue) -> Text -> Either Text (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParamValue
ParamValue) Maybe Text
mt


{- | Generate FormFields for the given instance of 'Form', with no validation information. See [Example.Page.FormSimple](https://docs.hyperbole.live/formsimple)

> data ContactForm f = ExampleForm
>   { name :: Field f Text
>   , age :: Field f Int
>   }
>   deriving (Generic)
>
> formView :: View FormView ()
> formView = do
>   -- create formfields for our form
>   let f = formFields @ContactForm
>   form @ContactForm Submit (gap 10 . pad 10) $ do
>     el Style.h1 "Add Contact"
> 
>     -- pass the form field into the 'field' function
>     field f.name (const id) $ do
>       label "Contact Name"
>       input Username (inp . placeholder "contact name")
> 
>     field f.age (const id) $ do
>       label "Age"
>       input Number (inp . placeholder "age" . value "0")
> 
>     submit Style.btn "Submit"
>  where
>   inp = Style.input
-}
formFields :: (Form form val) => form (FormField val)
formFields :: forall (form :: (* -> *) -> *) (val :: * -> *).
Form form val =>
form (FormField val)
formFields = form val -> form (FormField val)
forall (form :: (* -> *) -> *) (val :: * -> *).
Form form val =>
form val -> form (FormField val)
genFieldsWith form val
forall (form :: (* -> *) -> *) (val :: * -> *).
Form form val =>
form val
genForm


{- | Generate FormFields for the given instance of 'Form' from validation data. See [Example.Page.FormValidation](https://docs.hyperbole.live/formvalidation)

> data UserForm f = UserForm
>   { user :: Field f User
>   , age :: Field f Int
>   , pass1 :: Field f Text
>   , pass2 :: Field f Text
>   }
>   deriving (Generic)
> instance Form UserForm Validated
>
> formView :: UserForm Validated -> View FormView ()
> formView v = do
>   let f = formFieldsWith v
>   form @UserForm Submit (gap 10 . pad 10) $ do
>     el Style.h1 "Sign Up"
> 
>     field f.user valStyle $ do
>       label "Username"
>       input Username (inp . placeholder "username")
> 
>       fv <- fieldValid
>       case fv of
>         Invalid t -> el_ (text t)
>         Valid -> el_ "Username is available"
>         _ -> none
> 
>     field f.age valStyle $ do
>       label "Age"
>       input Number (inp . placeholder "age" . value "0")
>       el_ invalidText
> 
>     field f.pass1 valStyle $ do
>       label "Password"
>       input NewPassword (inp . placeholder "password")
>       el_ invalidText
> 
>     field f.pass2 (const id) $ do
>       label "Repeat Password"
>       input NewPassword (inp . placeholder "repeat password")
> 
>     submit Style.btn "Submit"
>  where
>   inp = Style.input
>   valStyle (Invalid _) = Style.invalid
>   valStyle Valid = Style.success
>   valStyle _ = id
-}
formFieldsWith :: (Form form val) => form val -> form (FormField val)
formFieldsWith :: forall (form :: (* -> *) -> *) (val :: * -> *).
Form form val =>
form val -> form (FormField val)
formFieldsWith = form val -> form (FormField val)
forall (form :: (* -> *) -> *) (val :: * -> *).
Form form val =>
form val -> form (FormField val)
genFieldsWith


-- | Automatically derive labels from form field names
class GFormParse f where
  gFormParse :: FE.Form -> Either Text (f p)


-- instance GForm U1 where
--   gForm = U1

instance (GFormParse f, GFormParse g) => GFormParse (f :*: g) where
  gFormParse :: forall (p :: k). Form -> Either Text ((:*:) f g p)
gFormParse Form
f = do
    f p
a <- Form -> Either Text (f p)
forall (p :: k). Form -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either Text (f p)
gFormParse Form
f
    g p
b <- Form -> Either Text (g p)
forall (p :: k). Form -> Either Text (g p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either Text (f p)
gFormParse Form
f
    (:*:) f g p -> Either Text ((:*:) f g p)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:*:) f g p -> Either Text ((:*:) f g p))
-> (:*:) f g p -> Either Text ((:*:) f g p)
forall a b. (a -> b) -> a -> b
$ f p
a f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
b


instance (GFormParse f) => GFormParse (M1 D d f) where
  gFormParse :: forall (p :: k). Form -> Either Text (M1 D d f p)
gFormParse 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
<$> Form -> Either Text (f p)
forall (p :: k). Form -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either Text (f p)
gFormParse Form
f


instance (GFormParse f) => GFormParse (M1 C c f) where
  gFormParse :: forall (p :: k). Form -> Either Text (M1 C c f p)
gFormParse 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
<$> Form -> Either Text (f p)
forall (p :: k). Form -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either Text (f p)
gFormParse Form
f


instance (Selector s, FromParam a) => GFormParse (M1 S s (K1 R a)) where
  gFormParse :: forall (p :: k). Form -> Either Text (M1 S s (K1 R a) p)
gFormParse Form
f = do
    let s :: String
s = M1 S s (K1 R (Any a)) 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 (f a)) p
forall {k} {f :: * -> *} {p :: k}. M1 S s (K1 R (f a)) p
forall a. HasCallStack => a
undefined :: M1 S s (K1 R (f a)) p)
    Text
t <- forall v. FromHttpApiData v => Text -> Form -> Either Text v
parseUnique @Text (String -> Text
pack String
s) Form
f
    K1 R a p -> M1 S s (K1 R a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R a p -> M1 S s (K1 R a) p)
-> (a -> K1 R a p) -> a -> M1 S s (K1 R a) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> M1 S s (K1 R a) p)
-> Either Text a -> Either Text (M1 S s (K1 R a) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParamValue -> Either Text a
forall a. FromParam a => ParamValue -> Either Text a
parseParam (Text -> ParamValue
ParamValue Text
t)


------------------------------------------------------------------------------
-- GEN FIELDS :: Create the field! -------------------------------------------
------------------------------------------------------------------------------

class GenFields f where
  gGenFields :: f p


instance GenFields U1 where
  gGenFields :: forall (p :: k). U1 p
gGenFields = U1 p
forall k (p :: k). U1 p
U1


instance (GenFields f, GenFields g) => GenFields (f :*: g) where
  gGenFields :: forall (p :: k). (:*:) f g p
gGenFields = f p
forall (p :: k). f p
forall {k} (f :: k -> *) (p :: k). GenFields f => f p
gGenFields 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). GenFields f => f p
gGenFields


instance (Selector s, GenField f a, Field f a ~ f a) => GenFields (M1 S s (K1 R (f a))) where
  gGenFields :: forall (p :: k). M1 S s (K1 R (f a)) p
gGenFields =
    let sel :: String
sel = M1 S s (K1 R (f a)) 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 (f a)) p
forall {k} {p :: k}. M1 S s (K1 R (f a)) p
forall a. HasCallStack => a
undefined :: M1 S s (K1 R (f a)) p)
     in K1 R (f a) p -> M1 S s (K1 R (f a)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (f a) p -> M1 S s (K1 R (f a)) p)
-> (Field f a -> K1 R (f a) p)
-> Field f a
-> M1 S s (K1 R (f a)) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> K1 R (f a) p
Field f a -> K1 R (f a) p
forall k i c (p :: k). c -> K1 i c p
K1 (Field f a -> M1 S s (K1 R (f a)) p)
-> Field f a -> M1 S s (K1 R (f a)) p
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. GenField f a => String -> Field f a
genField @f @a String
sel


instance (GenFields f) => GenFields (M1 D d f) where
  gGenFields :: forall (p :: k). M1 D d f p
gGenFields = 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). GenFields f => f p
gGenFields


instance (GenFields f) => GenFields (M1 C c f) where
  gGenFields :: forall (p :: k). M1 C c f p
gGenFields = 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). GenFields f => f p
gGenFields


------------------------------------------------------------------------------
-- GenField -- Generate a value from the selector name
------------------------------------------------------------------------------

class GenField f a where
  genField :: String -> Field f a


instance GenField FieldName a where
  genField :: String -> Field FieldName a
genField String
s = Text -> FieldName a
forall {k} (a :: k). Text -> FieldName a
FieldName (Text -> FieldName a) -> Text -> FieldName a
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s


instance GenField Validated a where
  genField :: String -> Field Validated a
genField = Validated a -> String -> Validated a
forall a b. a -> b -> a
const Validated a
forall {k} (a :: k). Validated a
NotInvalid


instance GenField (FormField Validated) a where
  genField :: String -> Field (FormField Validated) a
genField String
s = FieldName a -> Validated a -> FormField Validated a
forall {k} (v :: k -> *) (a :: k).
FieldName a -> v a -> FormField v a
FormField (Text -> FieldName a
forall {k} (a :: k). Text -> FieldName a
FieldName (Text -> FieldName a) -> Text -> FieldName a
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s) Validated a
forall {k} (a :: k). Validated a
NotInvalid


instance GenField (FormField Maybe) a where
  genField :: String -> Field (FormField Maybe) a
genField String
s = FieldName a -> Maybe a -> FormField Maybe a
forall {k} (v :: k -> *) (a :: k).
FieldName a -> v a -> FormField v a
FormField (Text -> FieldName a
forall {k} (a :: k). Text -> FieldName a
FieldName (Text -> FieldName a) -> Text -> FieldName a
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s) Maybe a
forall a. Maybe a
Nothing


instance GenField Maybe a where
  genField :: String -> Field Maybe a
genField String
_ = Maybe a
Field Maybe a
forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- GMerge - combine two records with the same structure
------------------------------------------------------------------------------

-- class ConvertFields a where
--   convertFields :: (FromSelector f g) => a f -> a g
--   default convertFields :: (Generic (a f), Generic (a g), GConvert (Rep (a f)) (Rep (a g))) => a f -> a g
--   convertFields x = to $ gConvert (from x)

class GMerge ra rb rc where
  gMerge :: ra p -> rb p -> rc p


instance (GMerge ra0 rb0 rc0, GMerge ra1 rb1 rc1) => GMerge (ra0 :*: ra1) (rb0 :*: rb1) (rc0 :*: rc1) where
  gMerge :: forall (p :: k).
(:*:) ra0 ra1 p -> (:*:) rb0 rb1 p -> (:*:) rc0 rc1 p
gMerge (ra0 p
a0 :*: ra1 p
a1) (rb0 p
b0 :*: rb1 p
b1) = ra0 p -> rb0 p -> rc0 p
forall (p :: k). ra0 p -> rb0 p -> rc0 p
forall {k} (ra :: k -> *) (rb :: k -> *) (rc :: k -> *) (p :: k).
GMerge ra rb rc =>
ra p -> rb p -> rc p
gMerge ra0 p
a0 rb0 p
b0 rc0 p -> rc1 p -> (:*:) rc0 rc1 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: ra1 p -> rb1 p -> rc1 p
forall (p :: k). ra1 p -> rb1 p -> rc1 p
forall {k} (ra :: k -> *) (rb :: k -> *) (rc :: k -> *) (p :: k).
GMerge ra rb rc =>
ra p -> rb p -> rc p
gMerge ra1 p
a1 rb1 p
b1


instance (GMerge ra rb rc) => GMerge (M1 D d ra) (M1 D d rb) (M1 D d rc) where
  gMerge :: forall (p :: k). M1 D d ra p -> M1 D d rb p -> M1 D d rc p
gMerge (M1 ra p
fa) (M1 rb p
fb) = rc p -> M1 D d rc p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (rc p -> M1 D d rc p) -> rc p -> M1 D d rc p
forall a b. (a -> b) -> a -> b
$ ra p -> rb p -> rc p
forall (p :: k). ra p -> rb p -> rc p
forall {k} (ra :: k -> *) (rb :: k -> *) (rc :: k -> *) (p :: k).
GMerge ra rb rc =>
ra p -> rb p -> rc p
gMerge ra p
fa rb p
fb


instance (GMerge ra rb rc) => GMerge (M1 C d ra) (M1 C d rb) (M1 C d rc) where
  gMerge :: forall (p :: k). M1 C d ra p -> M1 C d rb p -> M1 C d rc p
gMerge (M1 ra p
fa) (M1 rb p
fb) = rc p -> M1 C d rc p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (rc p -> M1 C d rc p) -> rc p -> M1 C d rc p
forall a b. (a -> b) -> a -> b
$ ra p -> rb p -> rc p
forall (p :: k). ra p -> rb p -> rc p
forall {k} (ra :: k -> *) (rb :: k -> *) (rc :: k -> *) (p :: k).
GMerge ra rb rc =>
ra p -> rb p -> rc p
gMerge ra p
fa rb p
fb


instance (Selector s, MergeField a b c) => GMerge (M1 S s (K1 R a)) (M1 S s (K1 R b)) (M1 S s (K1 R c)) where
  gMerge :: forall (p :: k).
M1 S s (K1 R a) p -> M1 S s (K1 R b) p -> M1 S s (K1 R c) p
gMerge (M1 (K1 a
a)) (M1 (K1 b
b)) = K1 R c p -> M1 S s (K1 R c) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R c p -> M1 S s (K1 R c) p)
-> (c -> K1 R c p) -> c -> M1 S s (K1 R c) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> K1 R c p
forall k i c (p :: k). c -> K1 i c p
K1 (c -> M1 S s (K1 R c) p) -> c -> M1 S s (K1 R c) p
forall a b. (a -> b) -> a -> b
$ a -> b -> c
forall a b c. MergeField a b c => a -> b -> c
mergeField a
a b
b


class MergeField a b c where
  mergeField :: a -> b -> c


instance MergeField (FieldName a) (Validated a) (FormField Validated a) where
  mergeField :: FieldName a -> Validated a -> FormField Validated a
mergeField = FieldName a -> Validated a -> FormField Validated a
forall {k} (v :: k -> *) (a :: k).
FieldName a -> v a -> FormField v a
FormField


------------------------------------------------------------------------------
-- GConvert - combine two records with the same structure
------------------------------------------------------------------------------

-- class ConvertFields a where
--   convertFields :: (FromSelector f g) => a f -> a g
--   default convertFields :: (Generic (a f), Generic (a g), GConvert (Rep (a f)) (Rep (a g))) => a f -> a g
--   convertFields x = to $ gConvert (from x)

class GConvert ra rc where
  gConvert :: ra p -> rc p


instance (GConvert ra0 rc0, GConvert ra1 rc1) => GConvert (ra0 :*: ra1) (rc0 :*: rc1) where
  gConvert :: forall (p :: k). (:*:) ra0 ra1 p -> (:*:) rc0 rc1 p
gConvert (ra0 p
a0 :*: ra1 p
a1) = ra0 p -> rc0 p
forall (p :: k). ra0 p -> rc0 p
forall {k} (ra :: k -> *) (rc :: k -> *) (p :: k).
GConvert ra rc =>
ra p -> rc p
gConvert ra0 p
a0 rc0 p -> rc1 p -> (:*:) rc0 rc1 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: ra1 p -> rc1 p
forall (p :: k). ra1 p -> rc1 p
forall {k} (ra :: k -> *) (rc :: k -> *) (p :: k).
GConvert ra rc =>
ra p -> rc p
gConvert ra1 p
a1


instance (GConvert ra rc) => GConvert (M1 D d ra) (M1 D d rc) where
  gConvert :: forall (p :: k). M1 D d ra p -> M1 D d rc p
gConvert (M1 ra p
fa) = rc p -> M1 D d rc p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (rc p -> M1 D d rc p) -> rc p -> M1 D d rc p
forall a b. (a -> b) -> a -> b
$ ra p -> rc p
forall (p :: k). ra p -> rc p
forall {k} (ra :: k -> *) (rc :: k -> *) (p :: k).
GConvert ra rc =>
ra p -> rc p
gConvert ra p
fa


instance (GConvert ra rc) => GConvert (M1 C d ra) (M1 C d rc) where
  gConvert :: forall (p :: k). M1 C d ra p -> M1 C d rc p
gConvert (M1 ra p
fa) = rc p -> M1 C d rc p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (rc p -> M1 C d rc p) -> rc p -> M1 C d rc p
forall a b. (a -> b) -> a -> b
$ ra p -> rc p
forall (p :: k). ra p -> rc p
forall {k} (ra :: k -> *) (rc :: k -> *) (p :: k).
GConvert ra rc =>
ra p -> rc p
gConvert ra p
fa


instance (Selector s, GenFieldFrom f g a, Field g a ~ g a) => GConvert (M1 S s (K1 R (f a))) (M1 S s (K1 R (g a))) where
  gConvert :: forall (p :: k). M1 S s (K1 R (f a)) p -> M1 S s (K1 R (g a)) p
gConvert (M1 (K1 f a
inp)) =
    let sel :: String
sel = M1 S s (K1 R (f a)) 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 (f a)) p
forall {k} {p :: k}. M1 S s (K1 R (f a)) p
forall a. HasCallStack => a
undefined :: M1 S s (K1 R (f a)) p)
     in K1 R (g a) p -> M1 S s (K1 R (g a)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (g a) p -> M1 S s (K1 R (g a)) p)
-> (g a -> K1 R (g a) p) -> g a -> M1 S s (K1 R (g a)) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> K1 R (g a) p
forall k i c (p :: k). c -> K1 i c p
K1 (g a -> M1 S s (K1 R (g a)) p) -> g a -> M1 S s (K1 R (g a)) p
forall a b. (a -> b) -> a -> b
$ forall (inp :: * -> *) (f :: * -> *) a.
GenFieldFrom inp f a =>
String -> inp a -> Field f a
genFieldFrom @f @g String
sel f a
inp


class GenFieldFrom inp f a where
  genFieldFrom :: String -> inp a -> Field f a


-- instance GenFieldFrom Validated (FormField Validated) a where
--   genFieldFrom s = FormField (FieldName $ pack s)
--

instance GenFieldFrom val (FormField val) a where
  genFieldFrom :: String -> val a -> Field (FormField val) a
genFieldFrom String
s = FieldName a -> val a -> FormField val a
forall {k} (v :: k -> *) (a :: k).
FieldName a -> v a -> FormField v a
FormField (Text -> FieldName a
forall {k} (a :: k). Text -> FieldName a
FieldName (Text -> FieldName a) -> Text -> FieldName a
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s)


------------------------------------------------------------------------------

class GCollect ra v where
  gCollect :: ra p -> [v ()]


instance GCollect U1 v where
  gCollect :: forall (p :: k). U1 p -> [v ()]
gCollect U1 p
_ = []


instance (GCollect f v, GCollect g v) => GCollect (f :*: g) v where
  gCollect :: forall (p :: k). (:*:) f g p -> [v ()]
gCollect (f p
a :*: g p
b) = f p -> [v ()]
forall (p :: k). f p -> [v ()]
forall {k} (ra :: k -> *) (v :: * -> *) (p :: k).
GCollect ra v =>
ra p -> [v ()]
gCollect f p
a [v ()] -> [v ()] -> [v ()]
forall a. Semigroup a => a -> a -> a
<> g p -> [v ()]
forall (p :: k). g p -> [v ()]
forall {k} (ra :: k -> *) (v :: * -> *) (p :: k).
GCollect ra v =>
ra p -> [v ()]
gCollect g p
b


instance (Selector s, ValidationState v) => GCollect (M1 S s (K1 R (v a))) v where
  gCollect :: forall (p :: k). M1 S s (K1 R (v a)) p -> [v ()]
gCollect (M1 (K1 v a
val)) = [v a -> v ()
forall a b. v a -> v b
forall (v :: * -> *) a b. ValidationState v => v a -> v b
convert v a
val]


instance (GCollect f v) => GCollect (M1 D d f) v where
  gCollect :: forall (p :: k). M1 D d f p -> [v ()]
gCollect (M1 f p
f) = f p -> [v ()]
forall (p :: k). f p -> [v ()]
forall {k} (ra :: k -> *) (v :: * -> *) (p :: k).
GCollect ra v =>
ra p -> [v ()]
gCollect f p
f


instance (GCollect f v) => GCollect (M1 C c f) v where
  gCollect :: forall (p :: k). M1 C c f p -> [v ()]
gCollect (M1 f p
f) = f p -> [v ()]
forall (p :: k). f p -> [v ()]
forall {k} (ra :: k -> *) (v :: * -> *) (p :: k).
GCollect ra v =>
ra p -> [v ()]
gCollect f p
f

------------------------------------------------------------------------------