90 lines
3.4 KiB
Haskell
90 lines
3.4 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!, $password: String!, $application: String!) {
|
|
apply(email: $email, password: $password, name: $name, nickname: $nickname,
|
|
birthdate: $birthdate, homeplace: $homeplace, application: $application) {
|
|
id
|
|
name
|
|
nickname
|
|
email
|
|
pendingEmail
|
|
homeplace
|
|
birthdate
|
|
}
|
|
}
|
|
|]
|
|
|
|
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 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")]}
|
|
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 $ id (apply x :: ApplyApply)
|
|
_ -> do
|
|
defaultLayout $ applyW (widget, enctype)
|