diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 9c2d90bb5..c3f6dca23 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -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