diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 9ce0d8ce3..e384524d8 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -124,21 +124,22 @@ postTUsersR tid ssh csh tutn = do (TutorialUserPrintQualificationData{..}, selectedUsers) | tuQualification `Set.member` courseQids -> do rcvr <- requireAuth + encRcvr <- encrypt $ entityKey rcvr letters <- runDB $ makeCourseCertificates tut Nothing $ toList selectedUsers - now <- liftIO getCurrentTime - case letters of - [l] -> do - encRcvr <- encrypt $ entityKey rcvr - apcIdent <- letterApcIdent l encRcvr now - let fName = letterFileName l - renderLetter rcvr l apcIdent >>= \case - Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err - Right pdf -> Just <$> sendByteStringAsFile fName (LBS.toStrict pdf) now - -- sendResponseByteStringFile "demoPDF.pdf" (LBS.toStrict pdf) - -- let typePDF :: ContentType - -- typePDF = "application/pdf" - -- sendResponse (typePDF, toContent pdf) - _ -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing + let mbAletter = anyone letters + case mbAletter of + Nothing -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing -- TODO: better error message + Just aletter -> do + now <- liftIO getCurrentTime + apcIdent <- letterApcIdent aletter encRcvr now + let fName = letterFileName aletter + renderLetters rcvr letters apcIdent >>= \case + Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err + Right pdf -> Just <$> sendByteStringAsFile fName (LBS.toStrict pdf) now + -- sendResponseByteStringFile "demoPDF.pdf" (LBS.toStrict pdf) + -- let typePDF :: ContentType + -- typePDF = "application/pdf" + -- sendResponse (typePDF, toContent pdf) (TutorialUserGrantQualificationData{..}, selectedUsers) | tuQualification `Set.member` courseQids -> do -- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime diff --git a/src/Utils.hs b/src/Utils.hs index e6c518358..0bafb212b 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -845,6 +845,11 @@ toNothing = const Nothing toNothingS :: String -> Maybe b toNothingS = const Nothing +-- | change second of maybe pair to Nothing, if both are Just and equal +eq2nothing :: Eq a => (Maybe a, Maybe a) -> (Maybe a, Maybe a) +eq2nothing (mx@(Just x), Just y) | x==y = (mx, Nothing) +eq2nothing p = p + -- replaced by a more general formulation, see canonical -- null2nothing :: MonoFoldable a => Maybe a -> Maybe a -- null2nothing (Just x) | null x = Nothing @@ -1297,6 +1302,12 @@ maxLength :: ( Integral n -- ^ @maxLegth n xs = length xs <= n@ maxLength l = not . minLength (succ l) +-- anyone :: (Foldable t) => t a -> Maybe a +-- | return any single element from a foldable, if it is not null +anyone :: (Foldable t, Alternative f) => t a -> f a +anyone = Fold.foldr ((<|>).pure) empty + + ------------ -- Writer -- ------------ diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 201469586..7bd9e2c5d 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -6,6 +6,7 @@ module Utils.Print ( renderLetter -- used for generating letter pdfs + , renderLetters , sendEmailOrLetter -- directly print or sends by email , printLetter -- always send a letter , letterApcIdent -- create acknowledge string for APC @@ -107,7 +108,7 @@ import Utils.Print.CourseCertificate -- | read and writes markdown, applying it as its own template to apply meta -mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either P.PandocError Text) +mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either P.PandocError P.Pandoc) mdTemplating template meta = runExceptT $ do let readerOpts = def { P.readerExtensions = P.pandocExtensions , P.readerStripComments = True @@ -117,21 +118,20 @@ mdTemplating template meta = runExceptT $ do let writerOpts = def { P.writerExtensions = P.pandocExtensions , P.writerTemplate = Just tmpl } - ExceptT . pure . P.runPure $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang - $ addMeta meta doc + ExceptT . pure . P.runPure $ do + md_txt <- P.writeMarkdown writerOpts $ appMeta setIsDeFromLang $ addMeta meta doc + P.readMarkdown readerOpts md_txt + -- | creates a PDF using a LaTeX template -pdfLaTeX :: LetterKind -> P.Meta -> Text -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString) -pdfLaTeX lk meta md = do +pdfLaTeX :: LetterKind -> P.Pandoc -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString) +pdfLaTeX lk doc = do e_tmpl <- $cachedHereBinary ("LetterKind:" <> tshow lk) (liftIO . P.runIO $ compileTemplate $ templateLatex lk) actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do - let readerOpts = def { P.readerExtensions = P.pandocExtensions } - writerOpts = def { P.writerExtensions = P.pandocExtensions - , P.writerTemplate = Just tmpl } - doc <- P.readMarkdown readerOpts md - makePDF writerOpts - $ appMeta setIsDeFromLang - $ addMeta meta doc + let writerOpts = def { P.writerExtensions = P.pandocExtensions + , P.writerTemplate = Just tmpl } + makePDF writerOpts $ appMeta setIsDeFromLang doc + renderLetter :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString) @@ -151,9 +151,38 @@ renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do --, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise ] e_md <- mdTemplating tmpl meta - result <- actRight e_md $ pdfLaTeX kind meta + result <- actRight e_md $ pdfLaTeX kind return $ over _Left P.renderError result +-- TODO: apcIdent does not make sense for multiple letters +renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString) +renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent + | Just l <- anyone mdls = do + now <- liftIO getCurrentTime + formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr + let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang + kind = getLetterKind $ pure l + + templateCombine _ err@Left{} = pure err + templateCombine mdl (Right doc1) = + let tmpl = getTemplate mdl + meta = addApcIdent apcIdent + <> letterMeta mdl formatter lang rcvrEnt + <> mkMeta + [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages + toMeta "date" $ format SelFormatDate now + , toMeta "rcvr-name" $ rcvr & userDisplayName + , toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr + --, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise + ] + in mdTemplating tmpl meta >>= \case + err@Left{} -> pure err + Right doc2 -> pure $ Right $ doc1 <> doc2 + + doc <- foldrM templateCombine (Right mempty) mdls + result <- actRight doc $ pdfLaTeX kind + return $ over _Left P.renderError result + | otherwise = return $ Left "renderLetters received empty set of letters" --------------- diff --git a/src/Utils/Print/CourseCertificate.hs b/src/Utils/Print/CourseCertificate.hs index c04d3f05c..cbbe1f05d 100644 --- a/src/Utils/Print/CourseCertificate.hs +++ b/src/Utils/Print/CourseCertificate.hs @@ -80,8 +80,7 @@ makeCourseCertificates Tutorial{ tutorialName = CI.original -> ccTutorialName , courseSchool = CI.original . unSchoolKey -> ccCourseSchool , courseDescription = fmap html2textlines -> ccCourseContent } <- get404 ccCourseId - let (ccCourseBegin, ccCourseEnd') = occurrencesBounds occurrences - ccCourseEnd = bool ccCourseEnd' Nothing $ ccCourseBegin == ccCourseEnd + let (ccCourseBegin, ccCourseEnd) = eq2nothing $ occurrencesBounds occurrences forM participants $ \uid -> do User{userDisplayName=ccParticipant, userCompanyDepartment, userCompanyPersonalNumber} <- get404 uid (ccFraNumber, ccFraDepartment, ccCompany) <- diff --git a/templates/letter/fraport_qualification.md b/templates/letter/fraport_qualification.md index 2ca22bfc5..5f43711a5 100644 --- a/templates/letter/fraport_qualification.md +++ b/templates/letter/fraport_qualification.md @@ -79,4 +79,6 @@ $else$ **English version is not yet implemened.** TODO -$endif$ \ No newline at end of file +$endif$ + +\clearpage \ No newline at end of file