Forms.hs

module Example.Forms where

import Data.Functor.Identity (Identity)
import Data.Text (Text, pack)
import Effectful
import Example.Colors
import GHC.Generics (Generic)
import Web.Hyperbole


page :: (Hyperbole :> es) => Page es ()
page = do
  hyper action

  load $ do
    pure $ row (pad 20) $ do
      viewId Main formView


data Main = Main
  deriving (Show, Read, Param)


data MainAction
  = Submit
  | Cancel
  deriving (Show, Read, Param)


instance HyperView Main where
  type Action Main = MainAction


data UserForm a = UserForm
  { username :: Field a Text
  , age :: Field a Integer
  , password1 :: Field a Text
  , password2 :: Field a Text
  }
  deriving (Generic, Form)


action :: (Hyperbole :> es) => Main -> MainAction -> Eff es (View Main ())
action _ Submit = do
  u <- parseForm
  pure $ userView u
action _ Cancel = do
  pure $ el_ "Cancelled"


formView :: View Main ()
formView = do
  form @UserForm Submit (gap 10 . pad 10) $ \f -> do
    el h1 "Sign Up"

    field id $ do
      label "Username"
      input Username (inp . placeholder "username") f.username

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

    field id $ do
      label "Password"
      input NewPassword (inp . placeholder "password") f.password1

    field id $ do
      label "Repeat Password"
      input NewPassword (inp . placeholder "repeat password") f.password2

    submit id "Submit"
    button Cancel id "Cancel"
 where
  placeholder = att "placeholder"
  inp = border 1 . pad 8


userView :: UserForm Identity -> View Main ()
userView user = do
  el_ "User View"
  el_ $ text user.username
  el_ $ text $ pack (show user.age)
  el_ $ text user.password1
  el_ $ text user.password2


btn :: Mod
btn = bg Primary . hover (bg PrimaryLight) . color White . pad 10


h1 :: Mod
h1 = bold . fontSize 32