feat(letter): allow printing of multiple course certificates at once

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        
+        let mbAletter = anyone letters 
-        case letters of 
+        case mbAletter of 
-          [l] -> do
+          Nothing -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing -- TODO: better error message
-                  encRcvr <- encrypt $ entityKey rcvr
+          Just aletter -> do             
-                  apcIdent <- letterApcIdent l encRcvr now
+            now <- liftIO getCurrentTime
-                  let fName = letterFileName l
+            apcIdent <- letterApcIdent aletter encRcvr now        
-                  renderLetter rcvr l apcIdent >>= \case
+            let fName = letterFileName aletter
-                    Left err  -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err                      
+            renderLetters rcvr letters apcIdent >>= \case
-                    Right pdf -> Just <$> sendByteStringAsFile fName (LBS.toStrict pdf) now
+              Left err  -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err                      
-                      -- sendResponseByteStringFile "demoPDF.pdf" (LBS.toStrict pdf)
+              Right pdf -> Just <$> sendByteStringAsFile fName (LBS.toStrict pdf) now
-                      -- let typePDF :: ContentType 
+                -- sendResponseByteStringFile "demoPDF.pdf" (LBS.toStrict pdf)
-                      --     typePDF = "application/pdf"
+                -- let typePDF :: ContentType 
-                      -- sendResponse (typePDF, toContent pdf)
+                --     typePDF = "application/pdf"
-          _ -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing
+                -- sendResponse (typePDF, toContent pdf)          
     (TutorialUserGrantQualificationData{..}, selectedUsers)
       | tuQualification `Set.member` courseQids -> do
         -- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime

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

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
+  ExceptT . pure . P.runPure $ do
-                                                          $ addMeta meta doc
+    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 :: LetterKind -> P.Pandoc -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
-pdfLaTeX lk meta md = do
+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 }
+      let writerOpts  = def { P.writerExtensions = P.pandocExtensions
-          writerOpts  = def { P.writerExtensions = P.pandocExtensions
+                            , P.writerTemplate   = Just tmpl }      
-                            , P.writerTemplate   = Just tmpl }
+      makePDF writerOpts $ appMeta setIsDeFromLang doc
-      doc <- P.readMarkdown readerOpts md
+        
-      makePDF writerOpts
-        $ appMeta setIsDeFromLang
-        $ addMeta meta 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"
 
 
 ---------------

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
+  let (ccCourseBegin, ccCourseEnd) = eq2nothing $ occurrencesBounds occurrences      
-      ccCourseEnd = bool ccCourseEnd' Nothing $ ccCourseBegin == ccCourseEnd
   forM participants $ \uid -> do
     User{userDisplayName=ccParticipant, userCompanyDepartment, userCompanyPersonalNumber} <- get404 uid    
     (ccFraNumber, ccFraDepartment, ccCompany) <- 

templates/letter/fraport_qualification.md

@@ -79,4 +79,6 @@ $else$
 **English version is not yet implemened.**
 TODO
 
-$endif$
+$endif$
+
+\clearpage