From ad05ab9ab9db8094a9efcacd4e2ffce3a910a7ab Mon Sep 17 00:00:00 2001
From: Saku Laesvuori <saku@laesvuori.fi>
Date: Mon, 11 Sep 2023 17:22:42 +0300
Subject: [PATCH] Add page for seeing all members

---
 datarekisteri.cabal            |  1 +
 src/Client/Handlers.hs         |  2 +
 src/Client/Handlers/Members.hs | 67 ++++++++++++++++++++++++++++++++++
 src/Client/Types.hs            | 12 +++++-
 4 files changed, 81 insertions(+), 1 deletion(-)
 create mode 100644 src/Client/Handlers/Members.hs

diff --git a/datarekisteri.cabal b/datarekisteri.cabal
index 689f5b3..1b01f73 100644
--- a/datarekisteri.cabal
+++ b/datarekisteri.cabal
@@ -54,6 +54,7 @@ executable datarekisteri
     Client.Handlers.Apply,
     Client.Handlers.Profile,
     Client.Handlers.VerifyEmail,
+    Client.Handlers.Members,
     Client.Types,
     Server,
     Server.API,
diff --git a/src/Client/Handlers.hs b/src/Client/Handlers.hs
index 41edb43..ef78cb3 100644
--- a/src/Client/Handlers.hs
+++ b/src/Client/Handlers.hs
@@ -12,6 +12,7 @@ module Client.Handlers
     , module Client.Handlers.Apply
     , module Client.Handlers.Applications
     , module Client.Handlers.VerifyEmail
+    , module Client.Handlers.Members
     , getHomeR
     , postApiR
     ) where
@@ -22,6 +23,7 @@ import Client.Handlers.Profile
 import Client.Handlers.Apply
 import Client.Handlers.Applications
 import Client.Handlers.VerifyEmail
+import Client.Handlers.Members
 import Client.Types
 import Yesod
 import Yesod.Auth
diff --git a/src/Client/Handlers/Members.hs b/src/Client/Handlers/Members.hs
new file mode 100644
index 0000000..174aaa4
--- /dev/null
+++ b/src/Client/Handlers/Members.hs
@@ -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}
+|]
diff --git a/src/Client/Types.hs b/src/Client/Types.hs
index ad8c81c..57175ed 100644
--- a/src/Client/Types.hs
+++ b/src/Client/Types.hs
@@ -46,6 +46,8 @@ mkYesodData "DataIdClient" [parseRoutes|
 /update-password/#UserID UpdatePasswordR POST
 /verify-email VerifyEmailR GET POST
 
+/members MembersR GET
+
 /applications ApplicationsR GET
 /accept AcceptR POST
 /reject RejectR POST
@@ -135,6 +137,7 @@ instance Yesod DataIdClient where
     isAuthorized (ProfileR user) isWrite = withAuthenticated $ const $ authorizedHelper (Profile user) isWrite
     isAuthorized (UpdatePasswordR 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 AcceptR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
     isAuthorized RejectR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
@@ -157,6 +160,7 @@ instance Yesod DataIdClient where
         msgs <- getMessages
         applicationsRoute <- maybeAuthorized ApplicationsR False
         profileRoute <- maybeAuthorized OwnProfileR False
+        membersRoute <- maybeAuthorized MembersR False
         currentRoute <- getCurrentRoute
         loggedIn <- isJust <$> maybeAuthId
         p <- widgetToPageContent $ do
@@ -167,6 +171,9 @@ instance Yesod DataIdClient where
                       $maybe route <- profileRoute
                         <li :Just route == currentRoute:class="active-nav">
                           <a href="@{route}">Profiili
+                      $maybe route <- membersRoute
+                        <li :Just route == currentRoute:class="active-nav">
+                          <a href="@{route}">Jäsenet
                       $maybe route <- applicationsRoute
                         <li :Just route == currentRoute:class="active-nav">
                           <a href="@{route}">Hakemukset
@@ -195,9 +202,12 @@ instance Yesod DataIdClient where
                   font-family: "Fira Sans", sans-serif;
                   height: 100%;
                 }
-                th {
+                th[scope="row"] {
                   text-align: right;
                 }
+                th[scope="col"] {
+                  text-align: center;
+                }
                 body {
                   background-color: #e8eaef;
                   color: var(--fg-colour);