-- SPDX-FileCopyrightText: 2022 Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} module Utils.Print.Letters where -- import Import.NoModel -- import Data.Char (isSeparator) -- import qualified Data.Text as T -- import qualified Data.CaseInsensitive as CI import qualified Data.Foldable as Fold import qualified Data.ByteString.Lazy as LBS import Control.Monad.Except import Import hiding (embedFile) import Data.FileEmbed (embedFile) import qualified Text.Pandoc as P import qualified Text.Pandoc.PDF as P import qualified Text.Pandoc.Builder as P import Text.Hamlet -- import System.Exit -- import System.Process.Typed -- for calling pdftk for pdf encryption -- import Handler.Utils.Users -- import Handler.Utils.DateTime -- import Handler.Utils.Mail -- import Handler.Utils.Widgets (nameHtml, nameHtml') -- import Handler.Utils.Avs (updateReceivers) -- import Jobs.Handler.SendNotification.Utils -- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly? ------------------------- -- 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 -- ---------------------- -- Either I don't understand how pandoc works or -- I don't understand why these are not included compileTemplate :: (P.PandocMonad m) => Text -> m (P.Template Text) compileTemplate tmpl = do let partialPath = "" -- no partials used, see Text.DocTemplates mbTemplate <- P.runWithDefaultPartials $ P.compileTemplate partialPath tmpl liftEither $ str2pandocError mbTemplate where str2pandocError = over _Left $ P.PandocTemplateError . pack 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 . LBS.toStrict) _Meta :: Lens' P.Pandoc P.Meta _Meta = lens mget mput where mget (P.Pandoc m _) = m mput (P.Pandoc _ b) m = P.Pandoc m b toMeta :: P.ToMetaValue a => Text -> a -> Map Text P.MetaValue toMeta k = singletonMap k . P.toMetaValue mbMeta :: P.ToMetaValue a => Text -> Maybe a -> Map Text P.MetaValue mbMeta = foldMap . toMeta -- | For convenience and to avoid importing Pandoc mkMeta :: [Map Text P.MetaValue] -> P.Meta mkMeta = P.Meta . mconcat -- | Modify the Meta-Block of Pandoc appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs -- appMeta f = _Meta %~ f -- lens version. Not sure this is better -- TODO: applyMetas is inconvenient since we cannot have an instance -- ToMetaValue a => ToMetaValue (Maybe a) -- so apply Metas -- For tests see module PandocSpec applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, Maybe a) -> p -> p applyMetas metas doc = Fold.foldr act doc metas where act (k, Just v) acc | notNull k = P.setMeta k v acc act _ acc = acc -- | Add meta to pandoc. Existing variables will be overwritten. -- For specification, see module PandocSpec addMeta :: P.Meta -> P.Pandoc -> P.Pandoc 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 -- | Pandoc conditionals only test if a variable is set or isn't set. -- Variable "is-de" will be set to True if the "lang" variable starts with "de" -- and will be unset otherwise setIsDeFromLang :: P.Meta -> P.Meta setIsDeFromLang m | (Just (P.MetaString t)) <- P.lookupMeta "lang" m , isDe t = P.setMeta isde True m | otherwise = P.deleteMeta isde m where isde = "is-de" defReaderOpts :: P.ReaderOptions defReaderOpts = def { P.readerExtensions = P.pandocExtensions, P.readerStripComments = True } defWriterOpts :: P.Template Text -> P.WriterOptions defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplate = Just t }