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

Käsiteltävät jäsenhakemukset|] when (null applications) $ [whamlet|

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|

#{name}

Hakemus

#{Textarea application}
Nimi #{name}
Kutsumanimi #{nickname}
Kotipaikka #{homeplace}
Syntymäaika #{renderDate $ birthdate}
Sähköposti #{renderEmail $ fromJust $ email} $maybe route <- acceptRoute
^{widget} $maybe route <- rejectRoute ^{widget} |] 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