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

module Web.Hyperbole.HyperView.Forms
  ( FromForm (..)
  , FromFormF (..)
  , GenFields (..)
  , fieldNames
  , FieldName (..)
  , FormFields (..)
  , Field
  , InputType (..)
  , Input (..)
  , field
  , label
  , input
  , checkbox
  , Radio (..)
  , radioGroup
  , radio
  , select
  , form
  , textarea
  , submit
  , formData
  , FormOptions (..)
  , Validated (..)
  , isInvalid
  , invalidText
  , validate
  , Identity

    -- * Re-exports
  , FE.FromFormKey
  , Generic
  , GFieldsGen (..)
  , GenField (..)
  , Form (..)
  )
where

import Data.Bifunctor (first)
import Data.Functor.Identity (Identity (..))
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import Data.Text (Text, pack)
import Effectful
import GHC.Generics
import Text.Casing (kebab)
import Web.Atomic.Types hiding (Selector)
import Web.FormUrlEncoded (Form (..), FormOptions (..))
import Web.FormUrlEncoded qualified as FE
import Web.Hyperbole.Data.Param
import Web.Hyperbole.Effect.Hyperbole
import Web.Hyperbole.Effect.Request
import Web.Hyperbole.Effect.Response (parseError)
import Web.Hyperbole.HyperView.Event (onSubmit)
import Web.Hyperbole.HyperView.Input (Option (..), checked)
import Web.Hyperbole.HyperView.Types
import Web.Hyperbole.HyperView.ViewAction
import Web.Hyperbole.View


------------------------------------------------------------------------------
-- FORM PARSING
------------------------------------------------------------------------------

{- | Simple types that be decoded from form data

@
data ContactForm = ContactForm
  { name :: Text
  , age :: Int
  , isFavorite :: Bool
  , planet :: Planet
  , moon :: Moon
  }
  deriving (Generic, FromForm)
@
-}
class FromForm (form :: Type) where
  fromForm :: FE.Form -> Either String form
  default fromForm :: (Generic form, GFormParse (Rep form)) => FE.Form -> Either String form
  fromForm Form
f = Rep form Any -> form
forall a x. Generic a => Rep a x -> a
forall x. Rep form x -> form
to (Rep form Any -> form)
-> Either String (Rep form Any) -> Either String form
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Form -> Either String (Rep form Any)
forall p. Form -> Either String (Rep form p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either String (f p)
gFormParse Form
f


{- | A Higher-Kinded type that can be parsed from a 'Web.FormUrlEncoded.Form'

@
data UserForm f = UserForm
  { user :: Field f User
  , age :: Field f Int
  , pass1 :: Field f Text
  , pass2 :: Field f Text
  }
  deriving (Generic, FromFormF, GenFields Validated, GenFields FieldName)
@
-}
class FromFormF (f :: (Type -> Type) -> Type) where
  fromFormF :: FE.Form -> Either String (f Identity)
  default fromFormF :: (Generic (f Identity), GFormParse (Rep (f Identity))) => FE.Form -> Either String (f Identity)
  fromFormF Form
f = Rep (f Identity) Any -> f Identity
forall a x. Generic a => Rep a x -> a
forall x. Rep (f Identity) x -> f Identity
to (Rep (f Identity) Any -> f Identity)
-> Either String (Rep (f Identity) Any)
-> Either String (f Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Form -> Either String (Rep (f Identity) Any)
forall p. Form -> Either String (Rep (f Identity) p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either String (f p)
gFormParse Form
f


-- Any FromFormF can be parsed using fromForm @(form Identity)
-- we can't make it an instance because it is an orphan instance
instance (FromFormF form) => FromForm (form Identity) where
  fromForm :: Form -> Either String (form Identity)
fromForm = Form -> Either String (form Identity)
forall (form :: (* -> *) -> *).
FromFormF form =>
Form -> Either String (form Identity)
fromFormF


-- | Parse a full type from a submitted form body
formData :: forall form es. (FromForm form, Hyperbole :> es) => Eff es form
formData :: forall form (es :: [Effect]).
(FromForm form, Hyperbole :> es) =>
Eff es form
formData = do
  Form
f <- Eff es Form
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Form
formBody
  let ef :: Either String form
ef = forall form. FromForm form => Form -> Either String form
fromForm @form Form
f :: Either String form
  (String -> Eff es form)
-> (form -> Eff es form) -> Either String form -> Eff es form
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Eff es form
forall (es :: [Effect]) a. (Hyperbole :> es) => String -> Eff es a
parseError form -> Eff es form
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String form
ef


------------------------------------------------------------------------------
-- GEN FIELDS: Generate a type from selector names
------------------------------------------------------------------------------

{- | Generate a Higher Kinded record with all selectors filled with default values. See 'GenField'

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

@
newContactForm :: 'View' NewContact ()
newContactForm = do
  row ~ pad 10 . gap 10 . border 1 $ do
    target Contacts $ do
      contactForm AddUser (genFields :: ContactForm Maybe)
    col $ do
      space
      'button' CloseForm ~ btnLight $ \"Cancel\"
@
-}
class GenFields f (form :: (Type -> Type) -> Type) where
  genFields :: form f
  default genFields :: (Generic (form f), GFieldsGen (Rep (form f))) => form f
  genFields = Rep (form f) Any -> form f
forall a x. Generic a => Rep a x -> a
forall x. Rep (form f) x -> form f
to Rep (form f) Any
forall p. Rep (form f) p
forall {k} (f :: k -> *) (p :: k). GFieldsGen f => f p
gFieldsGen


{- | Generate FieldNames for a form

▶️ [Forms](https://hyperbole.live/forms)

> data TodoForm f = TodoForm
>   { task :: Field f Text
>   }
>   deriving (Generic, FromFormF, GenFields FieldName)
>
> todoForm :: FilterTodo -> View AllTodos ()
> todoForm filt = do
>   let f :: TodoForm FieldName = fieldNames
>   row ~ border 1 $ do
>     el ~ pad 8 $ do
>       button (ToggleAll filt) Icon.chevronDown ~ width 32 . hover (color Primary)
>     form SubmitTodo ~ grow $ do
>       field f.task $ do
>         input TextInput ~ pad 12 @ placeholder "What needs to be done?" . value ""
-}
fieldNames :: forall form. (GenFields FieldName form) => form FieldName
fieldNames :: forall (form :: (* -> *) -> *).
GenFields FieldName form =>
form FieldName
fieldNames = form FieldName
forall (f :: * -> *) (form :: (* -> *) -> *).
GenFields f form =>
form f
genFields


-- Given a selector, generate the type
class GenField a where
  genField :: String -> a


instance GenField (FieldName a) where
  genField :: String -> 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 -> 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 (Maybe a) where
  genField :: String -> Maybe a
genField String
_ = Maybe a
forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- FORM VIEWS
------------------------------------------------------------------------------

-- | Context that allows form fields
data FormFields id = FormFields id


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

@
formView :: 'View' AddContact ()
formView = do
  form Submit ~ gap 15 . pad 10 . flexCol $ do
    'el' ~ Style.h1 $ \"Add Contact\"

    -- Make sure these names match the field names used by FormParse / formData
    field \"name\" $ do
      label $ do
        text \"Contact Name\"
        input Username @ placeholder \"contact name\" ~ Style.input

    field \"age\" $ do
      label $ do
        text \"Age\"
        input Number @ placeholder \"age\" . value \"0\" ~ Style.input

    field \"isFavorite\" $ do
      label $ do
        row ~ gap 10 $ do
          checkbox False ~ width 32
          text \"Favorite?\"

    col ~ gap 5 $ do
      'el' $ text \"Planet\"
      field \"planet\" $ do
        radioGroup Earth $ do
          radioOption Mercury
          radioOption Venus
          radioOption Earth
          radioOption Mars

    field \"moon\" $ do
      label $ do
        text \"Moon\"
        select Callisto ~ Style.input $ do
          option Titan \"Titan\"
          option Europa \"Europa\"
          option Callisto \"Callisto\"
          option Mimas \"Mimas\"

    submit \"Submit\" ~ btn
 where
  radioOption val =
    label ~ flexRow . gap 10 $ do
      radio val ~ width 32
      text (pack (show val))
@
-}
form :: (ViewAction (Action id)) => Action id -> View (FormFields id) () -> View id ()
form :: forall id.
ViewAction (Action id) =>
Action id -> View (FormFields id) () -> View id ()
form Action id
a View (FormFields id) ()
cnt = do
  id
vid <- View id id
forall c. View c c
context
  Text -> View id () -> View id ()
forall c. Text -> View c () -> View c ()
tag Text
"form" (View id () -> View id ())
-> (Attributes (View id () -> View id ())
    -> Attributes (View id () -> View id ()))
-> View id ()
-> View id ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Action id
-> Attributes (View id () -> View id ())
-> Attributes (View id () -> View id ())
forall id a.
(ViewAction (Action id), ViewContext a ~ id, Attributable a) =>
Action id -> Attributes a -> Attributes a
onSubmit Action id
a (View id () -> View id ()) -> View id () -> View id ()
forall a b. (a -> b) -> a -> b
$ do
    FormFields id -> View (FormFields id) () -> View id ()
forall ctx c. ctx -> View ctx () -> View c ()
addContext (id -> FormFields id
forall id. id -> FormFields id
FormFields id
vid) View (FormFields id) ()
cnt


-- | Button that submits the 'form'
submit :: View (FormFields id) () -> View (FormFields id) ()
submit :: forall id. View (FormFields id) () -> View (FormFields id) ()
submit = Text -> View (FormFields id) () -> View (FormFields id) ()
forall c. Text -> View c () -> View c ()
tag Text
"button" (View (FormFields id) () -> View (FormFields id) ())
-> (Attributes (View (FormFields id) () -> View (FormFields id) ())
    -> Attributes (View (FormFields id) () -> View (FormFields id) ()))
-> View (FormFields id) ()
-> View (FormFields id) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Text
-> Attributes (View (FormFields id) () -> View (FormFields id) ())
-> Attributes (View (FormFields id) () -> View (FormFields id) ())
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"type" Text
"submit"


-- | Form FieldName. This is embeded as the name attribute, and refers to the key need to parse the form when submitted. See 'fieldNames'
newtype FieldName a = FieldName Text
  deriving newtype (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, String -> FieldName a
(String -> FieldName a) -> IsString (FieldName a)
forall a. (String -> a) -> IsString a
forall k (a :: k). String -> FieldName a
$cfromString :: forall k (a :: k). String -> FieldName a
fromString :: String -> FieldName a
IsString)


-- | Display a 'FormField'. See 'form' and 'Form'
field
  :: forall (id :: Type) (a :: Type)
   . FieldName a
  -> View (Input id a) ()
  -> View (FormFields id) ()
field :: forall id a.
FieldName a -> View (Input id a) () -> View (FormFields id) ()
field FieldName a
fn =
  Input id a -> View (Input id a) () -> View (FormFields id) ()
forall ctx c. ctx -> View ctx () -> View c ()
addContext (FieldName a -> Input id a
forall id a. FieldName a -> Input id a
Input FieldName a
fn)


-- | 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)


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


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


-- | input for a 'field'
input :: InputType -> View (Input id a) ()
input :: forall id a. InputType -> View (Input id a) ()
input InputType
ft = do
  Input (FieldName Text
nm) <- View (Input id a) (Input id a)
forall c. View c c
context
  Text -> View (Input id a) () -> View (Input id a) ()
forall c. Text -> View c () -> View c ()
tag Text
"input" (View (Input id a) () -> View (Input id a) ())
-> (Attributes (View (Input id a) () -> View (Input id a) ())
    -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> View (Input id a) ()
-> View (Input id a) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Text
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"type" (InputType -> Text
forall {a}. IsString a => InputType -> a
inpType InputType
ft) (Attributes (View (Input id a) () -> View (Input id a) ())
 -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> (Attributes (View (Input id a) () -> View (Input id a) ())
    -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
name Text
nm (Attributes (View (Input id a) () -> View (Input id a) ())
 -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> (Attributes (View (Input id a) () -> View (Input id a) ())
    -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Text
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"autocomplete" (InputType -> Text
auto InputType
ft) (View (Input id a) () -> View (Input id a) ())
-> View (Input id a) () -> View (Input id a) ()
forall a b. (a -> b) -> a -> b
$ 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


checkbox :: Bool -> View (Input id a) ()
checkbox :: forall id a. Bool -> View (Input id a) ()
checkbox Bool
isChecked = do
  Input (FieldName Text
nm) <- View (Input id a) (Input id a)
forall c. View c c
context
  Text -> View (Input id a) () -> View (Input id a) ()
forall c. Text -> View c () -> View c ()
tag Text
"input" (View (Input id a) () -> View (Input id a) ())
-> (Attributes (View (Input id a) () -> View (Input id a) ())
    -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> View (Input id a) ()
-> View (Input id a) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Text
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"type" Text
"checkbox" (Attributes (View (Input id a) () -> View (Input id a) ())
 -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> (Attributes (View (Input id a) () -> View (Input id a) ())
    -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
name Text
nm (View (Input id a) () -> View (Input id a) ())
-> View (Input id a) () -> View (Input id a) ()
forall a b. (a -> b) -> a -> b
$ View (Input id a) ()
forall c. View c ()
none View (Input id a) ()
-> (Attributes (View (Input id a) ())
    -> Attributes (View (Input id a) ()))
-> View (Input id a) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Bool
-> Attributes (View (Input id a) ())
-> Attributes (View (Input id a) ())
forall a. Attributable a => Bool -> Attributes a -> Attributes a
checked Bool
isChecked


-- NOTE: Radio is a special type of selection different from list type or
-- select. select or list input can be thought of one wrapper and multiple
-- options whereas radio is multiple wrappers with options. The context required
-- for radio is more than that required for select.
data Radio (id :: Type) (a :: Type) (b :: Type) = Selection
  { forall id a b. Radio id a b -> Input id a
inputCtx :: Input id a
  , forall id a b. Radio id a b -> b
defaultOption :: b
  }


radioGroup :: b -> View (Radio id a b) () -> View (Input id a) ()
radioGroup :: forall b id a. b -> View (Radio id a b) () -> View (Input id a) ()
radioGroup b
defOpt = (Input id a -> Radio id a b)
-> View (Radio id a b) () -> View (Input id a) ()
forall ctx0 ctx1. (ctx0 -> ctx1) -> View ctx1 () -> View ctx0 ()
modifyContext ((Input id a -> Radio id a b)
 -> View (Radio id a b) () -> View (Input id a) ())
-> (Input id a -> Radio id a b)
-> View (Radio id a b) ()
-> View (Input id a) ()
forall a b. (a -> b) -> a -> b
$ \Input id a
inp -> Input id a -> b -> Radio id a b
forall id a b. Input id a -> b -> Radio id a b
Selection Input id a
inp b
defOpt


radio :: (Eq b, ToParam b) => b -> View (Radio id a b) ()
radio :: forall b id a. (Eq b, ToParam b) => b -> View (Radio id a b) ()
radio b
val = do
  Selection (Input (FieldName Text
nm)) b
defOpt <- View (Radio id a b) (Radio id a b)
forall c. View c c
context
  Text -> View (Radio id a b) () -> View (Radio id a b) ()
forall c. Text -> View c () -> View c ()
tag Text
"input"
    (View (Radio id a b) () -> View (Radio id a b) ())
-> (Attributes (View (Radio id a b) () -> View (Radio id a b) ())
    -> Attributes (View (Radio id a b) () -> View (Radio id a b) ()))
-> View (Radio id a b) ()
-> View (Radio id a b) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Text
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
forall h.
Attributable h =>
Text -> Text -> Attributes h -> Attributes h
att Text
"type" Text
"radio"
    (Attributes (View (Radio id a b) () -> View (Radio id a b) ())
 -> Attributes (View (Radio id a b) () -> View (Radio id a b) ()))
-> (Attributes (View (Radio id a b) () -> View (Radio id a b) ())
    -> Attributes (View (Radio id a b) () -> View (Radio id a b) ()))
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
name Text
nm
    (Attributes (View (Radio id a b) () -> View (Radio id a b) ())
 -> Attributes (View (Radio id a b) () -> View (Radio id a b) ()))
-> (Attributes (View (Radio id a b) () -> View (Radio id a b) ())
    -> Attributes (View (Radio id a b) () -> View (Radio id a b) ()))
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
value (b -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam b
val).value
    (Attributes (View (Radio id a b) () -> View (Radio id a b) ())
 -> Attributes (View (Radio id a b) () -> View (Radio id a b) ()))
-> (Attributes (View (Radio id a b) () -> View (Radio id a b) ())
    -> Attributes (View (Radio id a b) () -> View (Radio id a b) ()))
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
-> Attributes (View (Radio id a b) () -> View (Radio id a b) ())
forall a. Attributable a => Bool -> Attributes a -> Attributes a
checked (b
defOpt b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
val)
    (View (Radio id a b) () -> View (Radio id a b) ())
-> View (Radio id a b) () -> View (Radio id a b) ()
forall a b. (a -> b) -> a -> b
$ View (Radio id a b) ()
forall c. View c ()
none


select :: (Eq opt) => opt -> View (Option opt id) () -> View (Input id a) ()
select :: forall opt id a.
Eq opt =>
opt -> View (Option opt id) () -> View (Input id a) ()
select opt
defOpt View (Option opt id) ()
options = do
  Input (FieldName Text
nm) <- View (Input id a) (Input id a)
forall c. View c c
context
  Text -> View (Input id a) () -> View (Input id a) ()
forall c. Text -> View c () -> View c ()
tag Text
"select" (View (Input id a) () -> View (Input id a) ())
-> (Attributes (View (Input id a) () -> View (Input id a) ())
    -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> View (Input id a) ()
-> View (Input id a) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
name Text
nm (View (Input id a) () -> View (Input id a) ())
-> View (Input id a) () -> View (Input id a) ()
forall a b. (a -> b) -> a -> b
$ Option opt id -> View (Option opt id) () -> View (Input id a) ()
forall ctx c. ctx -> View ctx () -> View c ()
addContext (opt -> Option opt id
forall {k} opt (id :: k). opt -> Option opt id
Option opt
defOpt) View (Option opt id) ()
options


-- | textarea for a 'field'
textarea :: Maybe Text -> View (Input id a) ()
textarea :: forall id a. Maybe Text -> View (Input id a) ()
textarea Maybe Text
mDefaultText = do
  Input (FieldName Text
nm) <- View (Input id a) (Input id a)
forall c. View c c
context
  Text -> View (Input id a) () -> View (Input id a) ()
forall c. Text -> View c () -> View c ()
tag Text
"textarea" (View (Input id a) () -> View (Input id a) ())
-> (Attributes (View (Input id a) () -> View (Input id a) ())
    -> Attributes (View (Input id a) () -> View (Input id a) ()))
-> View (Input id a) ()
-> View (Input id a) ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Text
-> Attributes (View (Input id a) () -> View (Input id a) ())
-> Attributes (View (Input id a) () -> View (Input id a) ())
forall h. Attributable h => Text -> Attributes h -> Attributes h
name Text
nm (View (Input id a) () -> View (Input id a) ())
-> View (Input id a) () -> View (Input id a) ()
forall a b. (a -> b) -> a -> b
$ Text -> View (Input id a) ()
forall c. Text -> View c ()
text (Text -> View (Input id a) ()) -> Text -> View (Input id a) ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mDefaultText


------------------------------------------------------------------------------
-- VALIDATION
------------------------------------------------------------------------------

{- | 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, FromFormF, GenFields Validated, GenFields FieldName)

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


-- instance (FromParam a, ValidateField a) => FromParam (Validated a) where
--   parseParam inp = do
--     a <- parseParam @a inp
--     pure $ validateField a

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


-- class ValidateField a where
--   validateField :: a -> Validated a
--

-- 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 (Invalid t) = Invalid t
--   convert NotInvalid = NotInvalid
--   convert Valid = Valid
--
--

{- Only shows if 'Validated' is 'Invalid'. See 'formFieldsWith'formform
@
@
-}
invalidText :: forall a id. Validated a -> View (Input id a) ()
invalidText :: forall a id. Validated a -> View (Input id a) ()
invalidText Validated a
v = do
  case Validated a
v of
    Invalid Text
t -> Text -> View (Input id a) ()
forall c. Text -> View c ()
text Text
t
    Validated a
_ -> View (Input id 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)]


{- | 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 (FormField f) a = FormField f a
type instance Field Identity a = a
type instance Field FieldName a = FieldName a
type instance Field Validated a = Validated a
type instance Field Maybe a = Maybe a
type instance Field (Either String) a = Either String a


------------------------------------------------------------------------------
-- GENERIC FORM PARSE
------------------------------------------------------------------------------

class GFormParse f where
  gFormParse :: FE.Form -> Either String (f p)


instance (GFormParse f, GFormParse g) => GFormParse (f :*: g) where
  gFormParse :: forall (p :: k). Form -> Either String ((:*:) f g p)
gFormParse Form
f = do
    f p
a <- Form -> Either String (f p)
forall (p :: k). Form -> Either String (f p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either String (f p)
gFormParse Form
f
    g p
b <- Form -> Either String (g p)
forall (p :: k). Form -> Either String (g p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either String (f p)
gFormParse Form
f
    (:*:) f g p -> Either String ((:*:) f g p)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:*:) f g p -> Either String ((:*:) f g p))
-> (:*:) f g p -> Either String ((:*:) 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 String (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 String (f p) -> Either String (M1 D d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Form -> Either String (f p)
forall (p :: k). Form -> Either String (f p)
forall {k} (f :: k -> *) (p :: k).
GFormParse f =>
Form -> Either String (f p)
gFormParse Form
f


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


-- TODO: need a bool instance?
-- TODO: need a Maybe a instance?
instance (Selector s, FromParam a) => GFormParse (M1 S s (K1 R a)) where
  -- these CANNOT be json encoded, they are encoded by the browser
  gFormParse :: forall (p :: k). Form -> Either String (M1 S s (K1 R a) p)
gFormParse Form
f = do
    let sel :: String
sel = 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)
    Maybe Text
mt :: Maybe Text <- (Text -> String)
-> Either Text (Maybe Text) -> Either String (Maybe Text)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Either Text (Maybe Text) -> Either String (Maybe Text))
-> Either Text (Maybe Text) -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Form -> Either Text (Maybe Text)
FE.lookupMaybe (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
sel) Form
f
    a
a <- ShowS -> Either String a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
err -> String
sel String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err) (Either String a -> Either String a)
-> Either String a -> Either String a
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Either String a
forall a. FromParam a => Maybe Text -> Either String a
decodeFormValue Maybe Text
mt
    M1 S s (K1 R a) p -> Either String (M1 S s (K1 R a) p)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (M1 S s (K1 R a) p -> Either String (M1 S s (K1 R a) p))
-> M1 S s (K1 R a) p -> Either String (M1 S s (K1 R a) p)
forall a b. (a -> b) -> a -> b
$ 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) -> a -> M1 S s (K1 R a) p
forall a b. (a -> b) -> a -> b
$ a
a


-- instance {-# OVERLAPPING #-} (Selector s, FromParam a) => GFormParse (M1 S s (K1 R (Maybe a))) where
--   gFormParse f = do
--     let sel = selName (undefined :: M1 S s (K1 R (f a)) p)
--     mt :: Maybe Text <- first cs $ FE.lookupMaybe (cs sel) f
--     ma :: Maybe a <- maybe (pure Nothing) (parseParam . decodeParam) mt
--     pure $ M1 . K1 $ ma

------------------------------------------------------------------------------
-- GENERIC GENERATE FIELDS
------------------------------------------------------------------------------

class GFieldsGen f where
  gFieldsGen :: f p


instance GFieldsGen U1 where
  gFieldsGen :: forall (p :: k). U1 p
gFieldsGen = U1 p
forall k (p :: k). U1 p
U1


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


-- instance (Selector s, GenField g a, Field f a ~ g a) => GFieldsGen (M1 S s (K1 R (g a))) where
--   gFieldsGen =
--     let sel = selName (undefined :: M1 S s (K1 R (f a)) p)
--      in M1 . K1 $ genField @g @a sel

instance (Selector s, GenField a) => GFieldsGen (M1 S s (K1 R a)) where
  gFieldsGen :: forall (p :: k). M1 S s (K1 R a) p
gFieldsGen =
    let sel :: String
sel = 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)
     in 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) -> a -> M1 S s (K1 R a) p
forall a b. (a -> b) -> a -> b
$ forall a. GenField a => String -> a
genField @a String
sel


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


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

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

-- 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 (a0 :*: a1) (b0 :*: b1) = gMerge a0 b0 :*: gMerge a1 b1
--
--
-- instance (GMerge ra rb rc) => GMerge (M1 D d ra) (M1 D d rb) (M1 D d rc) where
--   gMerge (M1 fa) (M1 fb) = M1 $ gMerge fa fb
--
--
-- instance (GMerge ra rb rc) => GMerge (M1 C d ra) (M1 C d rb) (M1 C d rc) where
--   gMerge (M1 fa) (M1 fb) = M1 $ gMerge fa 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 (M1 (K1 a)) (M1 (K1 b)) = M1 . K1 $ mergeField a b
--
--
-- class MergeField a b c where
--   mergeField :: a -> b -> c

-- instance MergeField (FieldName a) (Validated a) (FormField Validated a) where
--   mergeField = 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 (a0 :*: a1) = gConvert a0 :*: gConvert a1
--
--
-- instance (GConvert ra rc) => GConvert (M1 D d ra) (M1 D d rc) where
--   gConvert (M1 fa) = M1 $ gConvert fa
--
--
-- instance (GConvert ra rc) => GConvert (M1 C d ra) (M1 C d rc) where
--   gConvert (M1 fa) = M1 $ gConvert 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 (M1 (K1 inp)) =
--     let sel = selName (undefined :: M1 S s (K1 R (f a)) p)
--      in M1 . K1 $ genFieldFrom @f @g sel 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 s = FormField (FieldName $ pack s)

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

-- class GCollect ra v where
--   gCollect :: ra p -> [v ()]
--
--
-- instance GCollect U1 v where
--   gCollect _ = []
--
--
-- instance (GCollect f v, GCollect g v) => GCollect (f :*: g) v where
--   gCollect (a :*: b) = gCollect a <> gCollect b
--
--
-- instance (Selector s, ValidationState v) => GCollect (M1 S s (K1 R (v a))) v where
--   gCollect (M1 (K1 val)) = [convert val]
--
--
-- instance (GCollect f v) => GCollect (M1 D d f) v where
--   gCollect (M1 f) = gCollect f
--
--
-- instance (GCollect f v) => GCollect (M1 C c f) v where
--   gCollect (M1 f) = gCollect f

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

-- newtype User = User Text
--   deriving newtype (FromParam)
--
--
-- data TestForm f = TestForm
--   { name :: Field f Text
--   , age :: Field f Int
--   , user :: Field f User
--   }
--   deriving (Generic, FromFormF, GenFields Maybe, GenFields Validated)

-- test :: (Hyperbole :> es) => Eff es (TestForm Identity)
-- test = do
--   tf <- formData
--   pure tf

-- formView :: (ViewAction (Action id)) => View id ()
-- formView = do
--   -- generate a ContactForm' FieldName
--   let f = fieldNames @ContactForm
--   form undefined (gap 10 . pad 10) $ do
--     -- f.name :: FieldName Text
--     -- f.name = FieldName "name"
--     field f.name id $ do
--       label "Contact Name"
--       input Username (placeholder "contact name")
--
--     -- f.age :: FieldName Int
--     -- f.age = FieldName "age"
--     field f.age id $ do
--       label "Age"
--       input Number (placeholder "age" . value "0")
--
--     submit id "Submit"
--
--
-- formView' :: (ViewAction (Action id)) => ContactForm Validated -> View id ()
-- formView' contact = do
--   -- generate a ContactForm' FieldName
--   let f = formFields @ContactForm contact
--   form undefined (gap 10 . pad 10) $ do
--     -- f.name :: FieldName Text
--     -- f.name = FieldName "name"
--     field f.name id $ do
--       label "Contact Name"
--       input Username (placeholder "contact name")
--
--     -- f.age :: FieldName Int
--     -- f.age = FieldName "age"
--     field f.age id $ do
--       label "Age"
--       input Number (placeholder "age" . value "0")
--
--     field f.age id $ do
--       label "Username"
--       input Username (placeholder "username")
--
--     case f.age.value of
--       Invalid t -> el_ (text t)
--       Valid -> el_ "Username is available"
--       _ -> none
--
--     submit id "Submit"
--  where
--   valStyle (Invalid _) = id
--   valStyle Valid = id
--   valStyle _ = id
--
--
-- data ContactForm' = ContactForm'
--   { name :: Text
--   , age :: Int
--   }
--   deriving (Generic)
-- instance FormParse ContactForm'
--
--
-- formView'' :: (ViewAction (Action id)) => View id ()
-- formView'' = do
--   form undefined (gap 10 . pad 10) $ do
--     -- f.name :: FieldName Text
--     -- f.name = FieldName "name"
--     field (FieldName "name") id $ do
--       label "Contact Name"
--       input Username (placeholder "contact name")