datarekisteri/Client/Handlers/Applications.hs

{-# 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
    phoneNumber
    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}
            <tr>
                <th scope="row">Puhelinnumero
                <td>#{renderPhoneNumber $ phoneNumber}
    $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