Add page for seeing all members

This commit is contained in:
Saku Laesvuori 2023-09-11 17:22:42 +03:00
parent db412bd374
commit ad05ab9ab9
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
4 changed files with 81 additions and 1 deletions

View File

@ -54,6 +54,7 @@ executable datarekisteri
Client.Handlers.Apply, Client.Handlers.Apply,
Client.Handlers.Profile, Client.Handlers.Profile,
Client.Handlers.VerifyEmail, Client.Handlers.VerifyEmail,
Client.Handlers.Members,
Client.Types, Client.Types,
Server, Server,
Server.API, Server.API,

View File

@ -12,6 +12,7 @@ module Client.Handlers
, module Client.Handlers.Apply , module Client.Handlers.Apply
, module Client.Handlers.Applications , module Client.Handlers.Applications
, module Client.Handlers.VerifyEmail , module Client.Handlers.VerifyEmail
, module Client.Handlers.Members
, getHomeR , getHomeR
, postApiR , postApiR
) where ) where
@ -22,6 +23,7 @@ import Client.Handlers.Profile
import Client.Handlers.Apply import Client.Handlers.Apply
import Client.Handlers.Applications import Client.Handlers.Applications
import Client.Handlers.VerifyEmail import Client.Handlers.VerifyEmail
import Client.Handlers.Members
import Client.Types import Client.Types
import Yesod import Yesod
import Yesod.Auth import Yesod.Auth

View File

@ -0,0 +1,67 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Client.Handlers.Members where
import Relude hiding (id)
import Data.Morpheus.Client
import Client.Types
import Client.ApiRequests
import Server.Types
import Yesod
import Yesod.Auth
declareLocalTypesInline "schema.gql" [raw|
query MembersPage {
users {
id
name
nickname
homeplace
}
}
|]
getMembersR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
getMembersR = do
MembersPage {..} <- apiRequest True ()
defaultLayout $ do
setTitle "Jäsenet"
let memberNickname member = let MembersPageUsers {..} = member in nickname
memberName member = let MembersPageUsers {..} = member in name
memberHomeplace member = let MembersPageUsers {..} = member in homeplace
memberId member = let MembersPageUsers {..} = member in id
[whamlet|
<h1>
Jäsenet
$if null users
<p>
Ei jäseniä.
$else
<table>
<thead>
<tr>
<th scope="col">
Nimi
<th scope="col">
Kutsumanimi
<th scope="col">
Kotipaikka
<tbody>
$forall member <- users
<tr>
<td>
#{memberName member}
<td>
#{memberNickname member}
<td>
#{memberHomeplace member}
|]

View File

@ -46,6 +46,8 @@ mkYesodData "DataIdClient" [parseRoutes|
/update-password/#UserID UpdatePasswordR POST /update-password/#UserID UpdatePasswordR POST
/verify-email VerifyEmailR GET POST /verify-email VerifyEmailR GET POST
/members MembersR GET
/applications ApplicationsR GET /applications ApplicationsR GET
/accept AcceptR POST /accept AcceptR POST
/reject RejectR POST /reject RejectR POST
@ -135,6 +137,7 @@ instance Yesod DataIdClient where
isAuthorized (ProfileR user) isWrite = withAuthenticated $ const $ authorizedHelper (Profile user) isWrite isAuthorized (ProfileR user) isWrite = withAuthenticated $ const $ authorizedHelper (Profile user) isWrite
isAuthorized (UpdatePasswordR user) isWrite = isAuthorized (UpdatePasswordR user) isWrite =
withAuthenticated $ const $ authorizedHelper (Profile user) isWrite withAuthenticated $ const $ authorizedHelper (Profile user) isWrite
isAuthorized MembersR isWrite = withAuthenticated $ const $ authorizedHelper Members isWrite
isAuthorized ApplicationsR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite isAuthorized ApplicationsR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
isAuthorized AcceptR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite isAuthorized AcceptR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
isAuthorized RejectR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite isAuthorized RejectR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
@ -157,6 +160,7 @@ instance Yesod DataIdClient where
msgs <- getMessages msgs <- getMessages
applicationsRoute <- maybeAuthorized ApplicationsR False applicationsRoute <- maybeAuthorized ApplicationsR False
profileRoute <- maybeAuthorized OwnProfileR False profileRoute <- maybeAuthorized OwnProfileR False
membersRoute <- maybeAuthorized MembersR False
currentRoute <- getCurrentRoute currentRoute <- getCurrentRoute
loggedIn <- isJust <$> maybeAuthId loggedIn <- isJust <$> maybeAuthId
p <- widgetToPageContent $ do p <- widgetToPageContent $ do
@ -167,6 +171,9 @@ instance Yesod DataIdClient where
$maybe route <- profileRoute $maybe route <- profileRoute
<li :Just route == currentRoute:class="active-nav"> <li :Just route == currentRoute:class="active-nav">
<a href="@{route}">Profiili <a href="@{route}">Profiili
$maybe route <- membersRoute
<li :Just route == currentRoute:class="active-nav">
<a href="@{route}">Jäsenet
$maybe route <- applicationsRoute $maybe route <- applicationsRoute
<li :Just route == currentRoute:class="active-nav"> <li :Just route == currentRoute:class="active-nav">
<a href="@{route}">Hakemukset <a href="@{route}">Hakemukset
@ -195,9 +202,12 @@ instance Yesod DataIdClient where
font-family: "Fira Sans", sans-serif; font-family: "Fira Sans", sans-serif;
height: 100%; height: 100%;
} }
th { th[scope="row"] {
text-align: right; text-align: right;
} }
th[scope="col"] {
text-align: center;
}
body { body {
background-color: #e8eaef; background-color: #e8eaef;
color: var(--fg-colour); color: var(--fg-colour);