chore(print): rework templating and apc acknowledge id mechanism
This commit is contained in:
parent
d2020866a8
commit
bb9c2259e9
@ -7,6 +7,7 @@ PrintJobName: Bezeichnung
|
||||
PrintJobFilename: Dateiname
|
||||
PrintJobId !ident-ok: Id
|
||||
PrintJobCreated: Gesendet
|
||||
PrintJobApcAcknowledge: Bestätigungs ID
|
||||
PrintJobAcknowledged: Bestätigt
|
||||
PrintJobUnacknowledged: Noch nicht gedruckt
|
||||
PrintJobAcknowledge n@Int64: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} als gedruckt und versendet bestätigt
|
||||
|
||||
@ -7,6 +7,7 @@ PrintJobName: Description
|
||||
PrintJobFilename: Filename
|
||||
PrintJobId: Id
|
||||
PrintJobCreated: Created
|
||||
PrintJobApcAcknowledge: Acknowledge ID
|
||||
PrintJobAcknowledged: Acknowledged
|
||||
PrintJobUnacknowledged: Not yet printed
|
||||
PrintJobAcknowledge n: #{n} #{pluralENs n "print-job"} marked as printed and mailed
|
||||
|
||||
@ -3,15 +3,17 @@
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
PrintJob
|
||||
name Text
|
||||
filename FilePath
|
||||
file ByteString -- stores plain pdf; otherwise use FileContentReference Maybe
|
||||
created UTCTime
|
||||
acknowledged UTCTime Maybe
|
||||
recipient UserId Maybe OnDeleteCascade OnUpdateCascade -- optional as some letters may contain just an address
|
||||
sender UserId Maybe OnDeleteSetNull OnUpdateCascade -- senders and associations are optional
|
||||
course CourseId Maybe OnDeleteCascade OnUpdateCascade
|
||||
qualification QualificationId Maybe OnDeleteCascade OnUpdateCascade
|
||||
lmsUser LmsIdent Maybe OnDeleteCascade OnUpdateCascade -- allows tracking if recipient has been notified; must be unique
|
||||
name Text
|
||||
apcAcknowledge Text default='unknown'
|
||||
filename FilePath
|
||||
file ByteString -- stores plain pdf; otherwise use FileContentReference Maybe
|
||||
created UTCTime
|
||||
acknowledged UTCTime Maybe
|
||||
recipient UserId Maybe OnDeleteCascade OnUpdateCascade -- optional as some letters may contain just an address
|
||||
sender UserId Maybe OnDeleteSetNull OnUpdateCascade -- senders and associations are optional
|
||||
course CourseId Maybe OnDeleteCascade OnUpdateCascade
|
||||
qualification QualificationId Maybe OnDeleteCascade OnUpdateCascade
|
||||
lmsUser LmsIdent Maybe OnDeleteCascade OnUpdateCascade -- allows tracking if recipient has been notified; must be unique
|
||||
-- UniquePrintJobLmsUser lmsUser -- Note that in fact multiple print jobs per LMS user are possible!
|
||||
-- UniquePrintJobApcAcknowledge apcAcknowledge -- TODO: not yet enforced, since LmsIdent is currently used
|
||||
deriving Generic
|
||||
@ -201,11 +201,12 @@ mkPJTable = do
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
dbtColonnade = mconcat
|
||||
[ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged)
|
||||
, sortable (Just "created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t
|
||||
, sortable (Just "acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
|
||||
, sortable (Just "created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t
|
||||
, sortable (Just "acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
|
||||
, sortable (Just "filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey
|
||||
t = r ^. resultPrintJob . _entityVal . _printJobFilename
|
||||
in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t)
|
||||
, sortable (Just "apcid") (i18nCell MsgPrintJobApcAcknowledge)$ \( view $ resultPrintJob . _entityVal . _printJobApcAcknowledge -> t) -> textCell t
|
||||
, sortable (Just "name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n
|
||||
, sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
||||
, sortable (Just "sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
||||
@ -218,6 +219,7 @@ mkPJTable = do
|
||||
, single ("filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename))
|
||||
, single ("created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated))
|
||||
, single ("acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged))
|
||||
, single ("apcid" , SortColumn $ queryPrintJob >>> (E.^. PrintJobApcAcknowledge))
|
||||
, single ("recipient" , sortUserNameBareM queryRecipient)
|
||||
, single ("sender" , sortUserNameBareM querySender )
|
||||
, single ("course" , SortColumn $ queryCourse >>> (E.?. CourseName))
|
||||
@ -226,7 +228,8 @@ mkPJTable = do
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single ("name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName))
|
||||
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
|
||||
, single ("apcid" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobApcAcknowledge))
|
||||
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
|
||||
, single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
|
||||
--, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
|
||||
, single ("recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName))
|
||||
@ -234,6 +237,7 @@ mkPJTable = do
|
||||
, single ("course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName))
|
||||
, single ("qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
|
||||
, single ("lmsid" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob) (E.^. PrintJobLmsUser))
|
||||
|
||||
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
@ -248,6 +252,7 @@ mkPJTable = do
|
||||
, prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse)
|
||||
, prismAForm (singletonFilter "qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification)
|
||||
, prismAForm (singletonFilter "lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser)
|
||||
, prismAForm (singletonFilter "apcid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobApcAcknowledge)
|
||||
, prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
|
||||
@ -321,7 +326,7 @@ postPrintSendR = do
|
||||
-- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
|
||||
-- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
|
||||
uID <- maybeAuthId
|
||||
runDB (sendLetter' "Test-Brief" bs (mbRecipient, uID) Nothing Nothing Nothing) >>= \case -- calls lpr
|
||||
runDB (sendLetter' "Test-Brief" "abcdefgh" bs (mbRecipient, uID) Nothing Nothing Nothing) >>= \case -- calls lpr
|
||||
Left err -> do
|
||||
let msg = "PDF printing failed with error: " <> err
|
||||
$logErrorS "LPR" msg
|
||||
|
||||
@ -203,17 +203,17 @@ pdfLetter md meta = do
|
||||
return $ over _Left P.renderError result
|
||||
|
||||
|
||||
renderLetter :: (MDLetter l) => User -> l -> Handler (Either Text LBS.ByteString)
|
||||
renderLetter rcvr mdl = do
|
||||
renderLetter :: (MDLetter l) => Entity User -> l -> Handler (Either Text LBS.ByteString)
|
||||
renderLetter Entity{entityKey=uid, entityVal=rcvr} mdl = do
|
||||
now <- liftIO getCurrentTime
|
||||
uuid :: CryptoUUIDUser <- encrypt uid
|
||||
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
|
||||
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
|
||||
tmpl = getTemplate $ pure mdl
|
||||
meta = letterMeta mdl formatter lang
|
||||
meta = letterApcIdent uuid mdl
|
||||
<> letterMeta mdl formatter lang
|
||||
<> mkMeta
|
||||
[ toMeta "paper" ("TODO"::Text) -- TODO continue here
|
||||
, toMeta "printid" ("TODO"::Text)
|
||||
, toMeta "lang" lang
|
||||
[ toMeta "lang" lang
|
||||
, toMeta "date" $ format SelFormatDate now
|
||||
, toMeta "rcvr-name" $ rcvr & userDisplayName
|
||||
, toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
|
||||
@ -221,16 +221,18 @@ renderLetter rcvr mdl = do
|
||||
]
|
||||
pdfLetter tmpl meta
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
-- PrintJobs --
|
||||
---------------
|
||||
|
||||
|
||||
-- Only used in print-test-handler for PrintSendR
|
||||
sendLetter' :: Text -> LBS.ByteString -> (Maybe UserId, Maybe UserId) -> Maybe CourseId -> Maybe QualificationId -> Maybe LmsIdent -> DB (Either Text (Text, FilePath))
|
||||
sendLetter' printJobName pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification printJobLmsUser =
|
||||
sendLetter' :: Text -> Text -> LBS.ByteString -> (Maybe UserId, Maybe UserId) -> Maybe CourseId -> Maybe QualificationId -> Maybe LmsIdent -> DB (Either Text (Text, FilePath))
|
||||
sendLetter' printJobName printJobApcAcknowledge pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification printJobLmsUser =
|
||||
sendLetter pdf PrintJobIdentification
|
||||
{ pjiName = printJobName
|
||||
, pjiApcAcknowledge = printJobApcAcknowledge
|
||||
, pjiRecipient = printJobRecipient
|
||||
, pjiSender = printJobSender
|
||||
, pjiCourse = printJobCourse
|
||||
@ -239,7 +241,7 @@ sendLetter' printJobName pdf (printJobRecipient, printJobSender) printJobCourse
|
||||
}
|
||||
|
||||
sendLetter :: LBS.ByteString -> PrintJobIdentification -> DB (Either Text (Text, FilePath))
|
||||
sendLetter pdf PrintJobIdentification{pjiName = printJobName, pjiRecipient = printJobRecipient, pjiSender = printJobSender, pjiCourse = printJobCourse, pjiQualification = printJobQualification, pjiLmsUser = printJobLmsUser} = do
|
||||
sendLetter pdf PrintJobIdentification{pjiName = printJobName, pjiApcAcknowledge = printJobApcAcknowledge, pjiRecipient = printJobRecipient, pjiSender = printJobSender, pjiCourse = printJobCourse, pjiQualification = printJobQualification, pjiLmsUser = printJobLmsUser} = do
|
||||
recipient <- join <$> mapM get printJobRecipient
|
||||
sender <- join <$> mapM get printJobSender
|
||||
course <- join <$> mapM get printJobCourse
|
||||
@ -285,6 +287,7 @@ sendEmailOrLetter recipient letter = do
|
||||
now <- liftIO getCurrentTime
|
||||
oks <- forM receivers $ \Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
|
||||
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvrUsr
|
||||
encRecipient :: CryptoUUIDUser <- encrypt svr
|
||||
let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr
|
||||
isSupervised = recipient /= svr
|
||||
lang = selectDeEn $ rcvrUsr & userLanguages -- select either German or English only, default de; see Utils.Lang
|
||||
@ -305,20 +308,17 @@ sendEmailOrLetter recipient letter = do
|
||||
)
|
||||
|
||||
pdfLetter tmpl lMeta >>= \case
|
||||
_ | preferPost, isNothing postal -> do -- neither email nor postal is known
|
||||
encRecipient :: CryptoUUIDUser <- encrypt svr
|
||||
_ | preferPost, isNothing postal -> do -- neither email nor postal is known
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Left err -> do -- pdf generation failed
|
||||
encRecipient :: CryptoUUIDUser <- encrypt svr
|
||||
Left err -> do -- pdf generation failed
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
Right pdf | preferPost -> -- send printed letter
|
||||
runDB (sendLetter pdf pjid{ pjiRecipient = Just svr}) >>= \case
|
||||
Left err -> do
|
||||
encRecipient :: CryptoUUIDUser <- encrypt svr
|
||||
Left err -> do
|
||||
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
|
||||
$logErrorS "LETTER" msg
|
||||
return False
|
||||
@ -332,8 +332,7 @@ sendEmailOrLetter recipient letter = do
|
||||
Nothing -> return pdf
|
||||
Just passwd -> encryptPDF passwd pdf >>= \case
|
||||
Right encPdf -> return encPdf
|
||||
Left err -> do
|
||||
encRecipient :: CryptoUUIDUser <- encrypt svr
|
||||
Left err -> do
|
||||
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
|
||||
$logWarnS "LETTER" msg
|
||||
return pdf
|
||||
|
||||
@ -8,7 +8,7 @@ module Utils.Print.Letters where
|
||||
|
||||
-- import Import.NoModel
|
||||
-- import Data.Char (isSeparator)
|
||||
-- import qualified Data.Text as T
|
||||
import qualified Data.Text as Text
|
||||
-- import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Foldable as Fold
|
||||
|
||||
@ -37,81 +37,6 @@ import Text.Hamlet
|
||||
|
||||
|
||||
|
||||
|
||||
-------------------------
|
||||
-- Hardcoded Templates --
|
||||
-------------------------
|
||||
|
||||
|
||||
data LetterKind = Din5008 -- scrlttr2: Standard postal letter with address field, expects peprinted FraportLogo
|
||||
| PinLetter -- Like Din5008, but for special paper with a protected pin field
|
||||
| Plain -- scrartcl: Empty, expects empty paper with no preprints
|
||||
| PlainLogo -- Like plain, but expects to be printed on paper with Logo
|
||||
-- | Logo -- Like plain, but prints Fraport Logo in the upper right corner
|
||||
deriving (Eq, Show)
|
||||
|
||||
templateLatex :: LetterKind -> Text
|
||||
templateLatex =
|
||||
let
|
||||
tDin5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
|
||||
tPinLetter = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008with_pin.latex")
|
||||
tPlain = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/plain_article.latex")
|
||||
in \case
|
||||
PinLetter -> tPinLetter
|
||||
Din5008 -> tDin5008
|
||||
PlainLogo -> tPlain
|
||||
Plain -> tPlain
|
||||
|
||||
-- | DEPRECATED TODO: remove
|
||||
templateDIN5008 :: Text
|
||||
templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
|
||||
|
||||
templateRenewal :: Text
|
||||
templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
-- PrintJobs --
|
||||
---------------
|
||||
|
||||
data PrintJobIdentification = PrintJobIdentification
|
||||
{ pjiName :: Text
|
||||
, pjiRecipient :: Maybe UserId
|
||||
, pjiSender :: Maybe UserId
|
||||
, pjiCourse :: Maybe CourseId
|
||||
, pjiQualification :: Maybe QualificationId
|
||||
, pjiLmsUser :: Maybe LmsIdent
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
------------------
|
||||
-- Letter Class --
|
||||
------------------
|
||||
|
||||
{- Probably not needed:}
|
||||
data SomeUserTime where
|
||||
SomeUserTime :: HasLocalTime t => SelDateTimeFormat -> t -> SomeUserTime
|
||||
|
||||
data ProtoMeta = IsMeta P.MetaValue
|
||||
| IsTime SomeUserTime
|
||||
|
||||
convertProto :: DateTimeFormatter -> ProtoMeta -> P.MetaValue
|
||||
convertProto _ (IsMeta v) = v
|
||||
convertProto f (IsTime t) = P.toMetaValue $ f t
|
||||
-}
|
||||
|
||||
class MDLetter l where
|
||||
getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
|
||||
getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment
|
||||
letterMeta :: l -> DateTimeFormatter -> Lang -> P.Meta
|
||||
getTemplate :: Proxy l -> Text
|
||||
getPJId :: l -> PrintJobIdentification
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------
|
||||
-- Pandoc Functions --
|
||||
----------------------
|
||||
@ -193,3 +118,99 @@ defReaderOpts = def { P.readerExtensions = P.pandocExtensions, P.readerStripComm
|
||||
defWriterOpts :: P.Template Text -> P.WriterOptions
|
||||
defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplate = Just t }
|
||||
|
||||
|
||||
|
||||
-------------------------
|
||||
-- Hardcoded Templates --
|
||||
-------------------------
|
||||
|
||||
|
||||
data LetterKind = Din5008 -- scrlttr2: Standard postal letter with address field, expects peprinted FraportLogo
|
||||
| PinLetter -- Like Din5008, but for special paper with a protected pin field
|
||||
| Plain -- scrartcl: Empty, expects empty paper with no preprints
|
||||
| PlainLogo -- Like plain, but expects to be printed on paper with Logo
|
||||
-- | Logo -- Like plain, but prints Fraport Logo in the upper right corner
|
||||
deriving (Eq, Show)
|
||||
|
||||
templateLatex :: LetterKind -> Text
|
||||
templateLatex =
|
||||
let
|
||||
tDin5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
|
||||
tPinLetter = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008with_pin.latex")
|
||||
tPlain = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/plain_article.latex")
|
||||
in \case
|
||||
PinLetter -> tPinLetter
|
||||
Din5008 -> tDin5008
|
||||
PlainLogo -> tPlain
|
||||
Plain -> tPlain
|
||||
|
||||
paperKind :: LetterKind -> Text
|
||||
paperKind Din5008 = "a4logo"
|
||||
paperKind PinLetter = "a4pin"
|
||||
paperKind Plain = "a4plain"
|
||||
paperKind PlainLogo = "a4logo"
|
||||
|
||||
-- | DEPRECATED TODO: remove
|
||||
templateDIN5008 :: Text
|
||||
templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
|
||||
|
||||
templateRenewal :: Text
|
||||
templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
-- PrintJobs --
|
||||
---------------
|
||||
|
||||
data PrintJobIdentification = PrintJobIdentification
|
||||
{ pjiName :: Text
|
||||
, pjiApcAcknowledge :: Text
|
||||
, pjiRecipient :: Maybe UserId
|
||||
, pjiSender :: Maybe UserId
|
||||
, pjiCourse :: Maybe CourseId
|
||||
, pjiQualification :: Maybe QualificationId
|
||||
, pjiLmsUser :: Maybe LmsIdent
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | create an identifier for printing with apc; which must always be place in the same position for all letters, printed in white on white
|
||||
-- Note that all letters to the same UUID within 24h are collated in one envelope
|
||||
mkApcIdent :: CryptoUUIDUser -> LetterKind -> Text -> P.Meta
|
||||
mkApcIdent uuid lk apcAck = P.Meta $ toMeta "apc-ident" $ apcSep <> apcIdent <> apcSep
|
||||
where
|
||||
apcSep = "___"
|
||||
apcIdent = Text.intercalate apcSep
|
||||
[ tshow uuid
|
||||
, paperKind lk
|
||||
, apcAck
|
||||
]
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
-- Letter Class --
|
||||
------------------
|
||||
|
||||
{- Probably not needed:}
|
||||
data SomeUserTime where
|
||||
SomeUserTime :: HasLocalTime t => SelDateTimeFormat -> t -> SomeUserTime
|
||||
|
||||
data ProtoMeta = IsMeta P.MetaValue
|
||||
| IsTime SomeUserTime
|
||||
|
||||
convertProto :: DateTimeFormatter -> ProtoMeta -> P.MetaValue
|
||||
convertProto _ (IsMeta v) = v
|
||||
convertProto f (IsTime t) = P.toMetaValue $ f t
|
||||
-}
|
||||
|
||||
class MDLetter l where
|
||||
getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
|
||||
getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment
|
||||
letterMeta :: l -> DateTimeFormatter -> Lang -> P.Meta
|
||||
getTemplate :: Proxy l -> Text
|
||||
getLetterKind :: Proxy l -> LetterKind
|
||||
getPJId :: l -> PrintJobIdentification
|
||||
|
||||
letterApcIdent :: MDLetter l => CryptoUUIDUser -> l -> P.Meta
|
||||
letterApcIdent uuid l = mkApcIdent uuid (getLetterKind $ pure l) (pjiApcAcknowledge $ getPJId l)
|
||||
|
||||
@ -45,6 +45,7 @@ letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRene
|
||||
|
||||
instance MDLetter LetterRenewQualificationF where
|
||||
getTemplate _ = templateRenewal
|
||||
getLetterKind _ = PinLetter
|
||||
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
|
||||
-- getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l
|
||||
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } =
|
||||
@ -66,6 +67,7 @@ instance MDLetter LetterRenewQualificationF where
|
||||
getPJId LetterRenewQualificationF{..} =
|
||||
PrintJobIdentification
|
||||
{ pjiName = "Renewal"
|
||||
, pjiApcAcknowledge = "lms" <> getLmsIdent lmsLogin
|
||||
, pjiRecipient = Nothing -- to be filled later
|
||||
, pjiSender = Nothing
|
||||
, pjiCourse = Nothing
|
||||
|
||||
@ -141,15 +141,17 @@ $endif$
|
||||
$endfor$
|
||||
}
|
||||
|
||||
$if(apc-ident)$
|
||||
\begin{textblock}{200}(5,5)%hpos,vpos
|
||||
\textcolor{white!0}{$apc-ident$}%
|
||||
\end{textblock}%
|
||||
$endif$
|
||||
|
||||
$if(is-de)$
|
||||
\opening{$de-opening$}
|
||||
$else$
|
||||
\opening{$en-opening$}
|
||||
$endif$
|
||||
|
||||
\begin{textblock}{65}(142,21)%hpos,vpos
|
||||
\textcolor{white!0}{\_\_\_$paper$\_\_\_$printid$\_\_\_}%
|
||||
\end{textblock}
|
||||
$endif$
|
||||
|
||||
$body$
|
||||
|
||||
|
||||
@ -141,15 +141,18 @@ $endif$
|
||||
$endfor$
|
||||
}
|
||||
|
||||
$if(apc-ident)$
|
||||
\begin{textblock}{200}(5,5)%hpos,vpos
|
||||
\textcolor{white!0}{$apc-ident$}%
|
||||
\end{textblock}%
|
||||
$endif$
|
||||
|
||||
$if(is-de)$
|
||||
\opening{$de-opening$}
|
||||
$else$
|
||||
\opening{$en-opening$}
|
||||
$endif$
|
||||
|
||||
\begin{textblock}{65}(142,21)%hpos,vpos
|
||||
\textcolor{white!0}{\_\_\_$paper$\_\_\_$printid$\_\_\_}%
|
||||
\end{textblock}
|
||||
$endif$
|
||||
|
||||
\begin{textblock}{65}(84,232)%hpos,vpos
|
||||
\textcolor{black!39}{
|
||||
\begin{labeling}{Password:}%Achtung! Die Position des Logins muss sprachunabhängig immer an der gleichen Position sein, sonst kannn die Rückmeldung der Druckerei den Ident nicht mehr identifizieren!
|
||||
|
||||
@ -96,9 +96,11 @@ $endif$
|
||||
\setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}}
|
||||
|
||||
\begin{document}%
|
||||
\begin{textblock}{65}(142,21)%hpos,vpos
|
||||
\textcolor{white!0}{:::$paper$:::$printid$:::}%
|
||||
\end{textblock}
|
||||
$if(apc-ident)$
|
||||
\begin{textblock}{200}(5,5)%hpos,vpos
|
||||
\textcolor{white!0}{$apc-ident$}%
|
||||
\end{textblock}%
|
||||
$endif$
|
||||
|
||||
$body$
|
||||
|
||||
|
||||
@ -597,16 +597,16 @@ fillDb = do
|
||||
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing
|
||||
void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing now Nothing Nothing Nothing
|
||||
|
||||
void . insert $ PrintJob "TestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing
|
||||
void . insert $ PrintJob "TestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk")
|
||||
void . insert $ PrintJob "TestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
void . insert $ PrintJob "TestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "qwvu")
|
||||
void . insert $ PrintJob "TestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu")
|
||||
void . insert $ PrintJob "TestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing
|
||||
void . insert $ PrintJob "TestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
||||
void . insert $ PrintJob "TestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
||||
void . insert $ PrintJob "TestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
||||
void . insert $ PrintJob "TestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn")
|
||||
void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing
|
||||
void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk")
|
||||
void . insert $ PrintJob "TestJob3" "AckTestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
void . insert $ PrintJob "TestJob4" "AckTestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "qwvu")
|
||||
void . insert $ PrintJob "TestJob5" "AckTestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu")
|
||||
void . insert $ PrintJob "TestJob6" "AckTestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing
|
||||
void . insert $ PrintJob "TestJob7" "AckTestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
||||
void . insert $ PrintJob "TestJob8" "AckTestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
||||
void . insert $ PrintJob "TestJob9" "AckTestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
||||
void . insert $ PrintJob "TestJob0" "AckTestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn")
|
||||
|
||||
|
||||
let
|
||||
|
||||
Loading…
Reference in New Issue
Block a user