fradrive/src/Utils/Print/Letters.hs

-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- 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 --
-------------------------

templateRenewal :: Text
templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")

templateDIN5008 :: Text
templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")



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