118 lines
3.5 KiB
Haskell
118 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.Applications where
|
|
|
|
import Relude hiding (id)
|
|
|
|
import Client.ApiRequests
|
|
import Client.Types
|
|
import Data.Morpheus.Client
|
|
import Server.Types hiding (Applications)
|
|
import Yesod hiding (emailField)
|
|
import Yesod.Auth
|
|
import Client.FormFields
|
|
import Data.Time (Day)
|
|
import Data.Maybe (fromJust)
|
|
|
|
declareLocalTypesInline "schema.gql" [raw|
|
|
query Applications {
|
|
applications {
|
|
id
|
|
name
|
|
nickname
|
|
email
|
|
homeplace
|
|
birthdate
|
|
application
|
|
}
|
|
}
|
|
|]
|
|
|
|
declareLocalTypesInline "schema.gql" [raw|
|
|
mutation Reject($user: UserID!) {
|
|
reject(user: $user)
|
|
}
|
|
|]
|
|
|
|
declareLocalTypesInline "schema.gql" [raw|
|
|
mutation Accept($user: UserID!) {
|
|
accept(user: $user)
|
|
}
|
|
|]
|
|
|
|
resolveApplicationForm :: Maybe UserID -> Form UserID
|
|
resolveApplicationForm user = renderDivs $ areq hiddenField "" user
|
|
|
|
applicationsW :: [ApplicationsApplications] -> Widget
|
|
applicationsW applications = do
|
|
setTitle "Jäsenhakemukset"
|
|
[whamlet|<h1>Käsiteltävät jäsenhakemukset|]
|
|
when (null applications) $ [whamlet|<p>Ei jäsenhakemuksia.|]
|
|
rejectRoute <- handlerToWidget $ maybeAuthorized RejectR True
|
|
acceptRoute <- handlerToWidget $ maybeAuthorized AcceptR True
|
|
forM_ applications $ \ApplicationsApplications {..} -> do
|
|
(widget, enctype) <- handlerToWidget $ generateFormPost $ resolveApplicationForm $ Just id
|
|
[whamlet|
|
|
<details>
|
|
<summary>
|
|
<h2>#{name}
|
|
<article>
|
|
<h3>Hakemus
|
|
<p>#{Textarea application}
|
|
<table>
|
|
<tr>
|
|
<th scope="row">Nimi
|
|
<td>#{name}
|
|
<tr>
|
|
<th scope="row">Kutsumanimi
|
|
<td>#{nickname}
|
|
<tr>
|
|
<th scope="row">Kotipaikka
|
|
<td>#{homeplace}
|
|
<tr>
|
|
<th scope="row">Syntymäaika
|
|
<td>#{renderDate $ birthdate}
|
|
<tr>
|
|
<th scope="row">Sähköposti
|
|
<td>#{renderEmail $ fromJust $ email}
|
|
$maybe route <- acceptRoute
|
|
<form action="@{route}" method="post" enctype="#{enctype}">
|
|
^{widget}
|
|
<input type="submit" value="Hyväksy">
|
|
$maybe route <- rejectRoute
|
|
<form action="@{route}" method="post" enctype="#{enctype}">
|
|
^{widget}
|
|
<input type="submit" value="Hylkää" class="reject-button">
|
|
|]
|
|
|
|
getApplicationsR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
|
|
getApplicationsR = do
|
|
Applications applications <- apiRequest @Applications True ()
|
|
defaultLayout $ applicationsW applications
|
|
|
|
postAcceptR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
|
|
postAcceptR = do
|
|
((result, _), _) <- runFormPost $ resolveApplicationForm Nothing
|
|
case result of
|
|
FormSuccess user -> void $ apiRequest @Accept True $ AcceptArgs user
|
|
_ -> pure ()
|
|
redirect ApplicationsR
|
|
|
|
postRejectR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
|
|
postRejectR = do
|
|
((result, _), _) <- runFormPost $ resolveApplicationForm Nothing
|
|
case result of
|
|
FormSuccess user -> void $ apiRequest @Reject True $ RejectArgs user
|
|
_ -> pure ()
|
|
redirect ApplicationsR
|