-- SPDX-FileCopyrightText: 2022-23 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 Import hiding (embedFile)
import Data.FileEmbed (embedFile)
import           Data.Char as Char
import qualified Data.Text as Text
-- import qualified Data.CaseInsensitive as CI
import qualified Data.Foldable as Fold
import qualified Data.ByteString.Lazy as LBS

import Control.Monad.Except

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?


-- instance P.ToMetaValue (CI Text) where
--   toMetaValue = P.MetaString . CI.original

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



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

paperKind :: LetterKind -> Text -- Muss genau 5 Zeichen haben!
paperKind PinLetter = "a4pin"   -- Pin-Brief
paperKind Plain     = "a4wht"   -- Ohne Logo
paperKind Din5008   = "a4log"   -- Mit Logo
paperKind PlainLogo = "a4log"

templateHtml :: LetterKind -> Text
-- templateHtml Din5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html")
templateHtml _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html")


---------------
-- PrintJobs --
---------------

data PrintJobIdentification = PrintJobIdentification
      { pjiName           :: Text
      , pjiApcAcknowledge :: Text
      , pjiRecipient      :: Maybe UserId
      , pjiSender         :: Maybe UserId
      , pjiCourse         :: Maybe CourseId
      , pjiQualification  :: Maybe QualificationId
      , pjiLmsUser        :: Maybe LmsIdent
      , pjiFileName       :: Text -- suggested filename, without suffix ".pdf"
      }
  deriving (Eq, Show)

-- | create an identifier for printing with apc; which must always be place with the same length; exept for the last part which may be of variable length
--   this is printed in white on white at the exact same position on the page
--   Note: that all letters to the same UUID within 24h are collated in one envelope
--   Example: 9ad8de3f-0a7e-ede5-bd8b-6d0ed85c1049-f___a4pin___230322-10___lms-stuvwxyz
mkApcIdent :: CryptoUUIDUser -> Char -> LetterKind -> Text -> Text -> Text
mkApcIdent uuid envelope lk tnow apcAck = Text.filter apcAcceptedChars $ Text.intercalate apcIdentSeparator 
      [ ensureLength 38 $ tshow (ciphertext uuid) <> Text.cons '-' (Text.singleton envelope)
      , ensureLength  5 $ paperKind lk
      , ensureLength  9   tnow
      , Text.take    32   apcAck -- length of last part may be arbitrary, but more than 32 symbols do not fit into the line
      ]
  where 
    ensureLength :: Int -> Text -> Text
    ensureLength n = Text.take n . Text.justifyLeft n 'x'

formatApcIdentTime :: (HasLocalTime t, MonadHandler m) => t -> m Text
formatApcIdentTime = formatTime' "%y%m%d-%H"

-- updateApcIdentTime :: UTCTime -> Text -> Text
-- updateApcIdentTime now oldapcident = do 
--   tnow <- formatApcIdentTime now
--   let (st,en') = Text.splitAt (38 + 3 + 5 + 3) oldapcident -- TODO: ensure that the numbers are correct
--       en = Text.drop 9 en'
--   TODO: TEST whether the last characters in st and first characters in en are apcIdentSeparators and call error otherwise
--   return $ st <> ensureLength 9 tnow <> en

apcIdentSeparator :: Text
apcIdentSeparator = Text.take 3 "___" -- must always have length 3

-- | Character allowed to be included in the APC identifier string printed in white in the header of all printed letters, must not contain ',' nor ';'
apcAcceptedChars :: Char -> Bool
apcAcceptedChars '-' = True
apcAcceptedChars '_' = True
apcAcceptedChars  c  = isAlphaNum c



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

data EncryptPDFfor = NoPassword | PasswordSupervisor | PasswordUnderling 
  deriving (Eq, Show)

class MDLetter l where
  letterMeta        :: l -> DateTimeFormatter -> Lang -> Entity User -> P.Meta -- formatter/lang for individual receiver, set Meta "lang" for individually translated letters
  -- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetterPDF for each receiver
  getPJId           :: l -> PrintJobIdentification
  getLetterEnvelope :: l -> Char
  getLetterKind     :: l -> LetterKind
  getTemplate       :: l -> Text
  encryptPDFfor     :: l -> EncryptPDFfor
  getMailSubject    :: l -> SomeMessage UniWorX -- currently only used as email subject
  getMailBody       :: l -> Maybe (DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -- Just returns cover-lettter for attaching PDF to, Nothing indicates that the letter should be sent as direct Html Email
  getMailBody = const Nothing

letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text
letterApcIdent l uuid now = do
  -- now  <- liftIO getCurrentTime
  tnow <- formatApcIdentTime now
  return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind l) tnow (pjiApcAcknowledge $ getPJId l)

letterFileName :: (MDLetter l) => l -> FilePath
letterFileName = Text.unpack . (<> ".pdf") . text2asciiAlphaNum . pjiFileName . getPJId

addApcIdent :: Text -> P.Meta
addApcIdent = P.Meta . toMeta "apc-ident"

getApcIdent :: P.Meta -> Maybe Text
getApcIdent (P.lookupMeta "apc-ident" -> Just (P.MetaString t)) = Just t
getApcIdent _ = Nothing
