fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

refactor(letter): extract user processing for letter meta data

Browse Source
This commit is contained in:
Steffen Jost 2022-07-18 16:48:59 +02:00
parent 94feda10c2
commit cfc1609eac
1 changed files with 14 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Handler/PrintCenter.hs
View File

@ -3,7 +3,7 @@
module Handler.PrintCenter
( getPrintCenterR, postPrintCenterR
, getPrintSendR , postPrintSendR
, getPrintDownloadR
, getPrintDownloadR
) where
import Import
@ -82,8 +82,6 @@ validateMetaPinRenewal = do
guardValidation MsgMppBadLanguage $ isDe mppLang || isEn mppLang
-- TODO: formatTimeUser SelFormatDate now (Entity <$> printJobRecipient recipient)
mprToMeta :: MetaPinRenewal -> P.Meta
mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat
-- formatTimeUser SelFormatDate mppDate mppRecipient
@ -92,7 +90,7 @@ mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat
, toMeta "login" mppLogin
, toMeta "pin" mppPin
, mbMeta "url" (mppURL <&> tshow)
, toMeta "date" (mppDate & tshow) -- TODO: render according to user preference
, toMeta "date" (mppDate & tshow) -- rendering according to user preference requires Handler Monad; deferred to Post-processing of P.Meta
, toMeta "lang" mppLang
, mbMeta keyOpening mppOpening
, mbMeta keyClosing mppClosing
@ -108,6 +106,15 @@ mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat
html2textlines :: StoredMarkup -> [Text]
html2textlines sm = T.lines . LT.toStrict $ markupInput sm
mprToMetaUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity User -> MetaPinRenewal -> m P.Meta
mprToMetaUser entUser@Entity{entityVal = u} mpr = do
let userLang = userLanguages u >>= (listToMaybe . view _Wrapped) -- auch möglich `op Languages` statt `view _Wrapped`
meta = mprToMeta mpr{ mppRecipient = userDisplayName u
-- , mppAddress = --TODO once we have User addresses within the DB
, mppLang = fromMaybe (mppLang mpr) userLang -- check if this is the desired behaviour!
}
userDate <- formatTimeUser SelFormatDate (mppDate mpr) (Just entUser)
return $ P.setMeta "date" userDate meta
data PJTableAction = PJActAcknowledge
@ -287,24 +294,15 @@ getPrintSendR = postPrintSendR
postPrintSendR = do
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm $ Just def
let procFormSend mpr = do
-- addMessage Info . toHtml $ "Brief wird gesendet an " <> mppRecipient
let meta = mprToMeta mpr
receivers <- runDB $ Ex.select $ do
user <- Ex.from $ Ex.table @User
Ex.where_ $ E.val (mppRecipient mpr) `E.isInfixOf` (user E.^. UserIdent)
pure user
letters <- case receivers of
[] -> pure . (Nothing ,) <$> pdfRenewal meta
[] -> pure . (Nothing ,) <$> pdfRenewal (mprToMeta mpr)
_ -> forM receivers $ \usr -> do
mDate <- formatTimeUser SelFormatDate (mppDate mpr) (Just usr)
let u = entityVal usr
paras = [(k,v) | (k, Just v) <- [
("lang" , userLanguages u >>= (listToMaybe . view _Wrapped)) -- auch möglich `op Languages` statt `view _Wrapped`
]] ++
[ ("date" , mDate)
, ("recipient" , userDisplayName u)
]
pdf <- pdfRenewal $ applyMetas paras meta
meta <- mprToMetaUser usr mpr
pdf <- pdfRenewal meta
return (Just $ entityKey usr, pdf)
oks <- forM letters $ \case
(mbRecipient, Right bs) -> do