{-# 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|

Jäsenhakemus
^{applyWidget}

Lähettämällä jäsenhakemuksen vakuutat antamiesi tietojen oikeellisuuden ja puuttettomuuden sekä sitoudut pitämään ne ajan tasalla. |] 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)