-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.CommCenter
  ( getCommCenterR
  ) where

import Import
import Handler.Utils

-- import qualified Data.Set as Set
import qualified Data.Map as Map
-- import qualified Data.Text as Text
import Data.Text.Lens (packed)

-- import Database.Persist.Sql (updateWhereCount)
-- import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Legacy as EL (on) -- only `on` and `from` are different, needed for dbTable using Esqueleto.Legacy
import qualified Database.Esqueleto.Experimental as E
import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.PostgreSQL as E
import Database.Esqueleto.Utils.TH


data CCTableAction = CCActDummy -- just a dummy, since we don't now yet which actions we will be needing
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

instance Universe CCTableAction
instance Finite CCTableAction
nullaryPathPiece ''CCTableAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''CCTableAction id

data CCTableActionData  = CCActDummyData
  deriving (Eq, Ord, Read, Show, Generic)


-- SJ: I don't know how to use E.unionAll_ with dbTable, so we simulate it by a FullOuterJoin with constant False ON-clause instead
type CCTableExpr =
  (                   (E.SqlExpr (Maybe (Entity User))  `E.InnerJoin` E.SqlExpr (Maybe (Entity SentMail)))
    `E.FullOuterJoin` (E.SqlExpr (Maybe (Entity User))  `E.InnerJoin` E.SqlExpr (Maybe (Entity PrintJob)))
  )

queryRecipientMail :: CCTableExpr -> E.SqlExpr (Maybe (Entity User))
queryRecipientMail = $(sqlIJproj 2 1) . $(sqlFOJproj 2 1)

queryMail :: CCTableExpr -> E.SqlExpr (Maybe (Entity SentMail))
queryMail = $(sqlIJproj 2 2) . $(sqlFOJproj 2 1)

queryRecipientPrint :: CCTableExpr -> E.SqlExpr (Maybe (Entity User))
queryRecipientPrint = $(sqlIJproj 2 1) . $(sqlFOJproj 2 2)

queryPrint :: CCTableExpr -> E.SqlExpr (Maybe (Entity PrintJob))
queryPrint = $(sqlIJproj 2 2) . $(sqlFOJproj 2 2)

type CCTableData = DBRow (Maybe (Entity User), Maybe (Entity SentMail), Maybe (Entity User), Maybe (Entity PrintJob))

resultRecipientMail :: Traversal' CCTableData (Entity User)
resultRecipientMail = _dbrOutput . _1 . _Just

resultMail :: Traversal' CCTableData (Entity SentMail)
resultMail = _dbrOutput . _2 . _Just

resultRecipientPrint :: Traversal' CCTableData (Entity User)
resultRecipientPrint = _dbrOutput . _3 . _Just

resultPrint :: Traversal' CCTableData (Entity PrintJob)
resultPrint = _dbrOutput . _4 . _Just


mkCCTable :: DB (Any, Widget)
mkCCTable = do
  let
    dbtSQLQuery :: CCTableExpr -> E.SqlQuery (E.SqlExpr (Maybe (Entity User)), E.SqlExpr (Maybe (Entity SentMail)), E.SqlExpr (Maybe (Entity User)), E.SqlExpr (Maybe (Entity PrintJob)))
    dbtSQLQuery  ((recipientMail `E.InnerJoin` mail) `E.FullOuterJoin` (recipientPrint `E.InnerJoin` printJob)) = do
      EL.on $ recipientMail  E.?. UserId E.==. E.joinV (mail     E.?. SentMailRecipient)
      EL.on $ recipientPrint E.?. UserId E.==. E.joinV (printJob E.?. PrintJobRecipient)
      -- EL.on $ recipientMail  E.?. UserId E.==. recipientPrint E.?. UserId E.&&. E.false -- simulating E.unionAll_ by a constant false full outer join, since it is unclear how dbTable could handle E.unionAll_
      EL.on E.false -- simulating E.unionAll_ by a constant false full outer join, since it is unclear how dbTable could handle E.unionAll_
      -- E.where_ $ E.isJust (recipientMail E.?. UserId) E.||. E.isJust (recipientPrint E.?. UserId) -- not needed for full outer join
      -- return (E.coalesce[recipientMail, recipientPrint], mail, print) -- coalesce only works on values, not entities
      return (recipientMail,  mail, recipientPrint, printJob)
    -- dbtRowKey = (,) <$> views (to queryMail) (E.?. SentMailId) <*> views (to queryPrint) (E.?. PrintJobId)
    dbtRowKey ((_recipientMail `E.InnerJoin` mail) `E.FullOuterJoin` (_recipientPrint `E.InnerJoin` printJob)) = (mail E.?. SentMailId, printJob E.?. PrintJobId)

    dbtProj = dbtProjId
    dbtColonnade = dbColonnade $ mconcat -- prefer print over email in the impossible case that both are Just
      [ sortable (Just "date")      (i18nCell MsgPrintJobCreated)       $ \row ->
          let tprint  = row ^? resultPrint  . _entityVal . _printJobCreated
              tmail   = row ^? resultMail   . _entityVal . _sentMailSentAt
          in maybeCell (tprint <|> tmail) dateTimeCell
      , sortable (Just "recipient") (i18nCell MsgPrintRecipient)        $ \row ->
          let uprint = row ^? resultRecipientPrint
              umail  = row ^? resultRecipientMail
          in  maybeCell (uprint <|> umail) $ cellHasUserLink AdminUserR
      , sortable Nothing (i18nCell MsgCommBody) $ \row -> if
          | (Just k) <- row ^? resultPrint . _entityKey
            -> anchorCellM (PrintDownloadR <$> encrypt k) $ toWgt (iconLetterOrEmail True ) <> text2widget "-link"
          | (Just k) <- row ^? resultMail  . _entityKey
            -> anchorCellM (MailHtmlR      <$> encrypt k) $ toWgt (iconLetterOrEmail False) <> text2widget "-link"
          | otherwise
            -> mempty
      , sortable Nothing (i18nCell MsgCommSubject) $ \row ->
          let tsubject = row ^? resultPrint . _entityVal . _printJobFilename . packed
              msubject = row ^? resultMail . _entityVal . _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject"
          in maybeCell (tsubject <|> msubject) textCell
      ]
    dbtSorting = mconcat
      [ singletonMap "date"       $ SortColumn  $ \row -> E.coalesce [queryPrint row E.?. PrintJobCreated, queryMail row E.?. SentMailSentAt]
      , singletonMap "recipient"  $ SortColumns $ \row ->
          [ SomeExprValue $ E.coalesce [queryRecipientPrint row E.?. UserSurname    , queryRecipientMail row E.?. UserSurname    ]
          , SomeExprValue $ E.coalesce [queryRecipientPrint row E.?. UserDisplayName, queryRecipientMail row E.?. UserDisplayName]
          ]
      ]
    dbtFilter = Map.fromList
      [ ("sentTo"    , FilterColumn . E.mkDayFilterTo
                  $ \row -> E.coalesceDefault [queryPrint row E.?. PrintJobCreated, queryMail row E.?. SentMailSentAt] E.now_) -- either one is guaranteed to be non-null, default never used
      , ("sentFrom"  , FilterColumn . E.mkDayFilterFrom
                  $ \row -> E.coalesceDefault [queryPrint row E.?. PrintJobCreated, queryMail row E.?. SentMailSentAt] E.now_) -- either one is guaranteed to be non-null, default never used
      , ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just
                  $ \row -> E.coalesce [queryRecipientPrint row E.?. UserDisplayName, queryRecipientMail row E.?. UserDisplayName])
      , ("subject"   , FilterColumn . E.mkContainsFilterWithCommaPlus Just
                                $ \row -> E.coalesce [E.str2text' $ queryPrint row E.?. PrintJobFilename
                                                     ,E.str2text' $ queryMail  row E.?. SentMailHeaders  ])
      ]
    dbtFilterUI mPrev = mconcat
      [ prismAForm (singletonFilter "sentTo"    . maybePrism _PathPiece) mPrev $ aopt (hoistField lift  dayField)  (fslI MsgTableFilterSentBefore)
      , prismAForm (singletonFilter "sentFrom"  . maybePrism _PathPiece) mPrev $ aopt (hoistField lift  dayField)  (fslI MsgTableFilterSentAfter)
      , prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlus)
      , prismAForm (singletonFilter "subject"   . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)  (fslI MsgCommSubject    & setTooltip MsgTableFilterCommaPlusShort)
      ]
    dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
    dbtIdent :: Text
    dbtIdent = "comms"
    dbtCsvEncode = noCsvEncode
    dbtCsvDecode = Nothing
    dbtExtraReps = []
    dbtParams = def
    psValidator = def & defaultSorting [SortDescBy "date"]
  dbTable psValidator DBTable{..}

getCommCenterR :: Handler Html
getCommCenterR = do
  (_, ccTable) <- runDB mkCCTable
  siteLayoutMsg MsgMenuCommCenter $ do
    setTitleI MsgMenuCommCenter
    $(widgetFile "comm-center")

