refactor(pdf): more useful filenames generated

src/Handler/Utils/Users.hs

@@ -9,6 +9,7 @@ module Handler.Utils.Users
   , UserAssimilateException(..), UserAssimilateExceptionReason(..)
   , assimilateUser
   , userPrefersEmail, userPrefersLetter
+  , abbrvName
   ) where
 
 import Import
@@ -41,8 +42,25 @@ import qualified Data.Text as Text
 import Jobs.Types(Job, JobChildren)
 
 
+abbrvName :: User -> Text
+abbrvName User{userDisplayName, userFirstName, userSurname} = 
+    if  | (lastDisplayName : tsrif) <- reverse nameParts 
+          -> assemble $ reverse $ lastDisplayName : abbreviate tsrif
+        | otherwise
+          -> assemble $ abbreviate (Text.words userFirstName) <> [userSurname]
+  where 
+    nameParts = Text.words userDisplayName
+    abbreviate = fmap (Text.take 1)
+    assemble = Text.intercalate "."
+
+
 userPrefersLetter :: User -> Bool
-userPrefersLetter User{..} = (userPrefersPostal || Text.null (CI.original userEmail)) && isJust userPostAddress
+userPrefersLetter User{..} 
+  = isJust userPostAddress &&
+    ( userPrefersPostal || 
+      isNothing userPinPassword ||
+      Text.null (CI.original userEmail)
+    )
 
 userPrefersEmail :: User -> Bool
 userPrefersEmail = not . userPrefersLetter

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -62,7 +62,8 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
   letterDate <- formatTimeUser SelFormatDate now                         $ Just entRecipient
   expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient
 
-  let prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address    
+  let printJobName = "RenewalPin"
+      prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address    
       pdfMeta = mkMeta
                   [ toMeta "date"           letterDate
                   , toMeta "lang"          (selectDeEn userLanguages)    -- select either German or English only, see Utils.Lang
@@ -80,8 +81,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
       error $ unpack msg
 
     Right pdf | userPrefersLetter recipient -> do
-        let printJobName = "Renewal"
-            printSender  = Nothing 
+        let printSender  = Nothing 
         runDB (sendLetter printJobName pdf printSender (Just jRecipient) Nothing (Just nQualification)) >>= \case        
           Left err -> do
             let msg = "Notify " <> tshow jRecipient <> "  PDF printing to send letter failed with error: " <> err
@@ -98,13 +98,15 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
         replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
         setSubjectI $ MsgMailSubjectQualificationRenewal qname
               
+        let fileName = printJobName <> "_" <> abbrvName recipient <> ".pdf"
+
         encryptPDF (fromMaybe "tomatenmarmelade" userPinPassword) pdf >>= \case -- TODO
           Left err -> do
-            let msg = "Notify " <> tshow jRecipient <> "  PDF encryption failed with error: " <> err
+            let msg = "Notify " <> tshow jRecipient <> " PDF encryption failed with error: " <> err
             $logErrorS "LMS" msg
             
           Right pdffile -> do
-            addPart (File { fileTitle = "RenewalPinLetter.pdf" -- TODO: better file title!
+            addPart (File { fileTitle = Text.unpack fileName
                           , fileModified = now
                           , fileContent = Just $ yield $ LBS.toStrict pdffile
                           } :: PureFile)

src/Utils/Print.hs

@@ -30,6 +30,8 @@ import qualified Text.Pandoc.Builder as P
 import System.Exit
 import System.Process.Typed -- for calling pdftk for pdf encryption
 
+import Handler.Utils.Users (abbrvName)
+
 -- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
 
 {- Recall:
@@ -267,8 +269,8 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
   sender    <- join <$> mapM get printJobSender
   course    <- join <$> mapM get printJobCourse
   quali     <- join <$> mapM get printJobQualification
-  let nameRecipient = userDisplayName <$> recipient
-      nameSender    = userDisplayName <$> sender
+  let nameRecipient = abbrvName <$> recipient
+      nameSender    = abbrvName <$> sender
       nameCourse    = CI.original . courseShorthand        <$> course
       nameQuali     = CI.original . qualificationShorthand <$> quali
   let printJobAcknowledged = Nothing