{-# OPTIONS -Wno-unused-top-binds #-}      -- TODO: remove me, for debugging only

module Handler.PrintCenter
  ( getPrintCenterR, postPrintCenterR  
  , getPrintSendR  , postPrintSendR  
  -- TODO: for testing only, remove exports
  , mprToMeta
  ) where

import Import
import qualified Data.Text      as T
import qualified Data.Text.Lazy as LT
import qualified Data.ByteString.Lazy as LBS
import qualified Text.Pandoc          as P
import qualified Text.Pandoc.Builder  as P

import qualified Control.Monad.State.Class as State
import Utils.Print
-- import Data.Aeson (encode)
-- import qualified Data.Text as Text
-- import qualified Data.Set  as Set

import Handler.Utils

data MetaPinRenewal = MetaPinRenewal 
      { mppRecipient :: Text
      , mppAddress   :: StoredMarkup
      , mppLogin     :: Text 
      , mppPin       :: Text
      , mppURL       :: Maybe URI
      , mppDate      :: Day
      , mppLang      :: Lang
      , mppOpening   :: Maybe Text
      , mppClosing   :: Maybe Text      
      }
  deriving (Eq, Ord, Show, Generic, Typeable)

-- TODO: just for testing, remove in production
instance Default MetaPinRenewal where 
  def = MetaPinRenewal 
          { mppRecipient = "Papa Schlumpf"
          , mppAddress   = plaintextToStoredMarkup ("Erdbeerweg 42\n98726 Schlumpfhausen"::Text)
          , mppLogin     = "keiner123"
          , mppPin       = "898989"
          , mppURL       = Nothing 
          , mppDate      = fromGregorian 2022 07 27
          , mppLang      = "de-de"
          , mppOpening   = Just "Lieber Papa Schlumpfi,"
          , mppClosing   = Nothing 
          }  

makeRenewalForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal
makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html -> do
  now_day <- utctDay <$> liftIO getCurrentTime
  flip (renderAForm FormStandard) html $ MetaPinRenewal
    <$> areq textField        (fslI MsgMppRecipient)         (mppRecipient <$> tmpl)
    <*> areq htmlField        (fslI MsgMppAddress)           (mppAddress   <$> tmpl)
    <*> areq textField        (fslI MsgMppLogin)             (mppLogin     <$> tmpl)
    <*> areq textField        (fslI MsgMppPin)               (mppPin       <$> tmpl)
    <*> aopt  urlField        (fslI MsgMppURL)               (mppURL       <$> tmpl)
    <*> areq  dayField        (fslI MsgMppDate)             ((mppDate      <$> tmpl) <|> Just now_day)
    <*> areq (langField True) (fslI MsgMppLang)             ((mppLang      <$> tmpl) <|> Just "de-de")
    <*> aopt textField        (fslI MsgMppOpening)           (mppOpening   <$> tmpl)
    <*> aopt textField        (fslI MsgMppClosing)           (mppClosing   <$> tmpl)

validateMetaPinRenewal :: FormValidator MetaPinRenewal Handler ()
validateMetaPinRenewal = do 
  MetaPinRenewal{..} <- State.get
  guardValidation MsgMppBadLanguage $ isDe mppLang || isEn mppLang

mprToMeta :: MetaPinRenewal -> P.Meta 
mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat 
  [ toMeta "recipient"  mppRecipient
  , toMeta "address"   (mppAddress & html2textlines)
  , toMeta "login"      mppLogin    
  , toMeta "pin"        mppPin      
  , mbMeta "url"       (mppURL  <&> tshow)
  , toMeta "date"      (mppDate  &  tshow) -- TODO: render according to user preference
  , toMeta "lang"       mppLang
  , mbMeta keyOpening   mppOpening
  , mbMeta keyClosing   mppClosing
  ] 
  where     
    deOrEn     = if isDe mppLang then "de" else "en"
    keyOpening = deOrEn <> "-opening"
    keyClosing = deOrEn <> "-closing"
    mbMeta :: P.ToMetaValue a => Text -> Maybe a -> Map Text P.MetaValue
    mbMeta   = foldMap . toMeta
    toMeta :: P.ToMetaValue a => Text ->       a -> Map Text P.MetaValue
    toMeta k = singletonMap k . P.toMetaValue
    html2textlines :: StoredMarkup -> [Text]
    html2textlines sm = T.lines . LT.toStrict $ markupInput sm


getPrintCenterR,  postPrintCenterR :: Handler Html
getPrintCenterR = postPrintCenterR
postPrintCenterR = do 
  -- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
  siteLayoutMsg MsgMenuApc $ do
    setTitleI MsgMenuApc
    $(widgetFile "print-center")  


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 
          Right bs -> do 
            liftIO $ LBS.writeFile "/tmp/generated.pdf" bs
            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
  siteLayoutMsg MsgMenuPrintSend $ do
    setTitleI MsgMenuPrintSend      
    let sendForm = wrapForm sendWidget def 
                    { formEncoding = sendEnctype
                    -- , formAction = Just $ SomeRoute actionUrl
                    }
    -- TODO: use i18nWidgetFile instead if this is to become permanent
    $(widgetFile "print-send")