chore(print): add prinjobs to model

models/print.model

@@ -0,0 +1,10 @@
+PrintJob  
+  name          Text
+  file          FileContentReference
+  created       UTCTime
+  acknowledged  UTCTime Maybe
+  recipient     UserId Maybe    -- optional as some letters may contain just an address
+  sender        UserId Maybe    -- senders and associations are optional
+  course        CourseId Maybe        OnDeleteCascade OnUpdateCascade
+  qualification QualificationId Maybe OnDeleteCascade OnUpdateCascade
+  deriving Generic

src/Handler/PrintCenter.hs

@@ -101,27 +101,24 @@ postPrintCenterR = do
     $(widgetFile "print-center")
 
 
-getPrintSendR, postPrintSendR:: Handler TypedContent
+getPrintSendR, postPrintSendR:: Handler Html
 getPrintSendR = postPrintSendR
 postPrintSendR = do
   ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm Nothing
   let procFormSend mpr@MetaPinRenewal{..} = do
         addMessage Info . toHtml $ "Brief wird gesendet an " <> mppRecipient
         e_pdf <- pdfRenewal $ mprToMeta mpr
-        now <- liftIO getCurrentTime
-        _ <- case e_pdf of
+        -- now <- liftIO getCurrentTime
+        case e_pdf of
           Right bs -> do
             liftIO $ LBS.writeFile "/tmp/generated.pdf" bs
-            sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict bs) now
-            -- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
-          Left err -> 
-            -- addMessage Error . toHtml $ P.renderError err
-            sendResponseStatus internalServerError500 $ toTypedContent $ P.renderError err
+            addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
+          Left err -> addMessage Error . toHtml $ P.renderError err
         -- TODO: continue here with acutal letter sending!
         return $ Just ()
   mbPdfLink <- formResultMaybe sendResult procFormSend
   -- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
-  answer <- siteLayoutMsg MsgMenuPrintSend $ do
+  siteLayoutMsg MsgMenuPrintSend $ do
     setTitleI MsgMenuPrintSend
     let sendForm = wrapForm sendWidget def
                     { formEncoding = sendEnctype
@@ -129,4 +126,3 @@ postPrintSendR = do
                     }
     -- TODO: use i18nWidgetFile instead if this is to become permanent
     $(widgetFile "print-send")
-  sendResponse $ toTypedContent answer

src/Utils/Print.hs

@@ -1,11 +1,11 @@
 module Utils.Print where
 
-import Import.NoModel
+-- import Import.NoModel
 -- import qualified Data.Foldable as Fold
 -- hiding (foldr) import Data.Foldable (foldr)
 
 -- import qualified Data.Text as T
-import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy as LBS
 import Control.Monad.Except
 import Import hiding (embedFile)
 import Data.FileEmbed (embedFile)
@@ -46,25 +46,33 @@ compileTemplate tmpl = do
   where
     str2pandocError = over _Left $ P.PandocTemplateError . pack
 
-makePDF :: P.WriterOptions -> P.Pandoc -> P.PandocIO L.ByteString
--- makePDF :: (PandocMonad m, MonadIO m, MonadMask m) => P.WriterOptions -> P.Pandoc -> m L.ByteString -- only pandoc >= 2.18
+makePDF :: P.WriterOptions -> P.Pandoc -> P.PandocIO LBS.ByteString
+-- makePDF :: (PandocMonad m, MonadIO m, MonadMask m) => P.WriterOptions -> P.Pandoc -> m LBS.ByteString -- only pandoc >= 2.18
 makePDF wopts doc = do
     mbPdf <- P.makePDF "lualatex" texopts P.writeLaTeX wopts doc
     liftEither $ bs2pandocError mbPdf
   where
     texopts = []
-    bs2pandocError = over _Left (P.PandocMakePDFError . decodeUtf8 . L.toStrict)
+    bs2pandocError = over _Left (P.PandocMakePDFError . decodeUtf8 . LBS.toStrict)
 
 -- | Modify the Meta-Block of Pandoc
+--   This could be a lens?
 appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc
 appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs
+-- appMeta f = _Meta %~ f
+
+_Meta :: Lens' P.Pandoc P.Meta
+_Meta = lens mg mp 
+  where 
+    mg (P.Pandoc m _)   = m
+    mp (P.Pandoc _ b) m = P.Pandoc m b
 
 -- applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p
 -- applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
 
 -- | Add meta to pandoc. Existing variables will be overwritten.
 addMeta :: P.Meta -> P.Pandoc -> P.Pandoc
-addMeta m = appMeta (<> m)
+addMeta m = appMeta (<> m) -- Data.Map says: (<>) == union and union should prefer the left operand, but somehow it does not!
 --addMeta m p = meta <> p
 --  where meta = P.Pandoc m mempty
 
@@ -86,6 +94,7 @@ defWriterOpts :: P.Template Text -> P.WriterOptions
 defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplate = Just t }
 
 
+
 -------------------------
 -- Readers and writers --
 -------------------------
@@ -129,8 +138,8 @@ reTemplateLetter' meta md  = do
                      }    
 
 
---pdfDIN5008 :: P.PandocMonad m => Text -> m L.ByteString -- for pandoc > 2.18
-pdfDIN5008' :: P.Meta -> Text -> P.PandocIO L.ByteString
+--pdfDIN5008 :: P.PandocMonad m => Text -> m LBS.ByteString -- for pandoc > 2.18
+pdfDIN5008' :: P.Meta -> Text -> P.PandocIO LBS.ByteString
 pdfDIN5008' meta md = do
   tmpl <- compileTemplate templateDIN5008
   let readerOpts  = def { P.readerExtensions = P.pandocExtensions }
@@ -142,7 +151,7 @@ pdfDIN5008' meta md = do
     $ addMeta meta doc
 
 -- | creates a PDF using the din5008 template
-pdfDIN5008 :: P.Meta -> Text -> HandlerFor UniWorX (Either P.PandocError L.ByteString)
+pdfDIN5008 :: P.Meta -> Text -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
 pdfDIN5008 meta md = do
   e_tmpl <- $cachedHereBinary ("din5008"::Text) (liftIO . P.runIO $ compileTemplate templateDIN5008)
   actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do
@@ -194,14 +203,29 @@ mdRenewal meta = runExceptT $ do
 
 
 -- | combines 'mdRenewal' and 'pdfDIN5008'
-pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either P.PandocError L.ByteString)
+pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
 pdfRenewal meta = do
   e_txt <- mdRenewal' meta 
   --actRight e_txt (pdfDIN5008 . appMeta setIsDeFromLang . addMeta meta) -- try this
   actRight e_txt $ pdfDIN5008 meta
 
 -- | like pdfRenewal but without caching
-pdfRenewal' :: P.Meta -> P.PandocIO L.ByteString
+pdfRenewal' :: P.Meta -> P.PandocIO LBS.ByteString
 pdfRenewal' meta = do 
   doc <- reTemplateLetter' meta templateRenewal   
   pdfDIN5008' meta doc 
+
+
+
+---------------
+-- PrintJobs --
+---------------
+
+sendLetter :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB ()
+sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do 
+  let printJobAcknowledged = Nothing
+  printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- sinkFileDB: Boolean Field problematic? Hashing?
+  printJobCreated <- liftIO getCurrentTime
+  insert_ PrintJob {..}
+
+