datarekisteri/Client/Handlers/Apply.hs

87 lines
3.5 KiB
Haskell

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Client.Handlers.Apply where
import Relude hiding (id)
import Client.ApiRequests
import Client.Types
import Data.Morpheus.Client
import Server.Types
import Yesod hiding (emailField)
import Yesod.Auth
import Client.FormFields
import Data.Time (Day)
declareLocalTypesInline "schema.gql" [raw|
mutation Apply($name: String!, $nickname: String, $homeplace: String!,
$birthdate: Date!, $email: Email!, $phoneNumber: PhoneNumber!, $password: String!, $application: String!) {
apply(email: $email, password: $password, name: $name, nickname: $nickname,
birthdate: $birthdate, homeplace: $homeplace, application: $application, phoneNumber: $phoneNumber) {
id
}
}
|]
applyForm :: Html -> MForm Handler (FormResult ApplyArgs, Widget)
applyForm = renderDivs $ ApplyArgs
<$> areq textField nameSettings Nothing
<*> aopt textField nicknameSettings Nothing
<*> areq textField homeplaceSettings Nothing
<*> areq dayField' birthdateSettings Nothing
<*> areq emailField emailSettings Nothing
<*> areq telephoneField phoneSettings Nothing
<*> areq verifiedPasswordField "Salasana" Nothing
<*> areq textareaField' applicationSettings Nothing
where dayField' :: Field Handler Date
dayField' = checkMMap (pure . Right . Date :: Day -> Handler (Either Text Date))
(\(Date x) -> x) dayField
textareaField' = checkMMap (pure . Right . unTextarea :: Textarea -> Handler (Either Text Text))
Textarea textareaField
nameSettings = "Nimi" {fsAttrs = [("placeholder","Erkki Juhani Esimerkki")]}
nicknameSettings = "Kutsumanimi" {fsAttrs = [("placeholder","Juhani")]}
homeplaceSettings = "Kotipaikka" {fsAttrs = [("placeholder","Espoo")]}
birthdateSettings = "Syntymäaika" {fsAttrs = [("placeholder","2000-01-01")]}
emailSettings = "Sähköposti" {fsAttrs = [("placeholder","erkki.juhani@esimerkki.fi")]}
phoneSettings = "Puhelinnumero" {fsAttrs = [("placeholder","+358 12 34567890")]}
applicationSettings = "Hakemus (eli miksi olet data)"
{fsAttrs = [("placeholder","Aloitin opiskelun Otaniemen datalla vuonna 2020.")]}
applyW :: (Widget, Enctype) -> Widget
applyW (applyWidget, applyEnctype) = do
setTitle "Jäsenhakemus"
[whamlet|
<h1>
Jäsenhakemus
<form action="@{ApplyR}" method="post" enctype="#{applyEnctype}">
^{applyWidget}
<p>
Lähettämällä jäsenhakemuksen vakuutat antamiesi tietojen oikeellisuuden ja puuttettomuuden
sekä sitoudut pitämään ne ajan tasalla.
<input type="submit" value="Hae jäseneksi">
|]
getApplyR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
getApplyR = do
applyForm <- liftHandler $ generateFormPost applyForm
defaultLayout $ applyW applyForm
postApplyR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
postApplyR = do
((result, widget), enctype) <- runFormPost applyForm
case result of
FormSuccess application -> apiRequest @Apply False application >>= \x ->
redirect $ ProfileR $ let ApplyApply {..} = apply x in id
_ -> do
defaultLayout $ applyW (widget, enctype)