-- SPDX-FileCopyrightText: 2023-2025 Steffen Jost <S.Jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE TypeApplications #-}

module Handler.Firm.Supervision
  ( getFirmsSupervisionR , postFirmsSupervisionR
  )
  where

import Import

-- import Jobs
import Utils.Company
import Handler.Utils
import Handler.Utils.Company


import qualified Data.Set as Set
import qualified Data.Map as Map
-- import qualified Data.Csv as Csv
-- import qualified Data.Text as T
import qualified Data.CaseInsensitive as CI
-- import qualified Data.Conduit.List as C
-- import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
import Database.Persist.Postgresql
import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Legacy as EL (on) -- needed for legacy join expected by dbTable
-- import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Utils as E
-- import Database.Esqueleto.Utils.TH


-- decryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => CryptoUUIDUser -> m UserId
-- decryptUser = decrypt

-- encryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m CryptoUUIDUser
-- encryptUser = encrypt


-----------------------
-- Supervision Sanity

data ActSupervision = ASChangeCompany | ASRemoveAssociation
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''ActSupervision $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''ActSupervision id

data ActSupervisionData
    = ASChangeCompanyData     { asTblCompany :: Maybe CompanyShorthand, asTblReason  :: Maybe Text }
    | ASRemoveAssociationData
  deriving (Eq, Ord, Read, Show, Generic)

data SupervisionViolation = SupervisionViolationEither | SupervisionViolationClient | SupervisionViolationSupervisor | SupervisionViolationBoth
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''SupervisionViolation $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''SupervisionViolation id

supervisionViolationField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m SupervisionViolation
-- supervisionViolationField = radioGroupField (Just $ SomeMessage MsgSupervisionViolationEither) $ optionsFinite
supervisionViolationField = radioGroupField Nothing $ optionsFinite

type TblSupervisionData = DBRow (Entity UserSupervisor, Entity User, Entity User)

mkSupervisionTable :: DB (FormResult (ActSupervisionData, Set UserSupervisorId), Widget)
mkSupervisionTable = over _1 postprocess <$> dbTable validator DBTable{..}
  where
    dbtIdent = "sanity-super" :: Text
    dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}

    queryRelation   :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity UserSupervisor)
    queryRelation   = $(E.sqlIJproj 3 1)
    querySupervisor :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity User)
    querySupervisor = $(E.sqlIJproj 3 2)
    queryClient     :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity User)
    queryClient     = $(E.sqlIJproj 3 3)

    resultRelation    :: Lens' TblSupervisionData (Entity UserSupervisor)
    resultRelation    =  _dbrOutput . _1
    resultSupervisor  :: Lens' TblSupervisionData (Entity User)
    resultSupervisor  =  _dbrOutput . _2
    resultClient      :: Lens' TblSupervisionData (Entity User)
    resultClient      =  _dbrOutput . _3

    dbtSQLQuery (uus `E.InnerJoin` spr `E.InnerJoin` sub) = do
      EL.on $ uus E.^. UserSupervisorSupervisor E.==. spr E.^. UserId
      EL.on $ uus E.^. UserSupervisorUser       E.==. sub E.^. UserId
      E.where_ $ E.isJust (uus E.^. UserSupervisorCompany)
      return (uus, spr, sub)
    dbtRowKey = queryRelation >>> (E.^. UserSupervisorId)
    dbtProj = dbtProjId
    dbtColonnade = formColonnade $ mconcat
      [ dbSelect (applying _2) id (return . view (resultRelation . _entityKey))
      , sortable (Just "reroute")     (i18nCell MsgTableRerouteActive)    $ \(view $ resultRelation . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute
      , sortable (Just "reason")      (i18nCell MsgUserSupervisorReason)  $ \(view $ resultRelation . _entityVal . _userSupervisorReason  -> r) -> maybeCell r textCell
      , sortable (Just "rel-comp")    (i18nCell MsgUserSupervisorCompany) $ \(view $ resultRelation . _entityVal . _userSupervisorCompany -> c) -> maybeCell c companyIdCell\
      , sortable (Just "supervisor")  (i18nCell MsgTableSupervisor)       $ \(view $ resultSupervisor  -> u) -> cellHasUserModal ForProfileDataR u
      , sortable (Just "super-comp")  (i18nCell MsgTableCompanies)        $ \(view $ resultSupervisor  . _entityKey -> uid) -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
          maybeMonoid <$> wgtCompanies True uid
      , sortable (Just "client") (i18nCell MsgTableSupervisee)       $ \(view $ resultClient -> u) -> cellHasUserModal ForProfileDataR u
      , sortable (Just "client-comp") (i18nCell MsgTableCompanies)        $ \(view $ resultClient . _entityKey -> uid) -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
          maybeMonoid <$> wgtCompanies True uid
      ]
    validator = def & defaultSorting [SortAscBy "rel-comp", SortAscBy "supervisor", SortAscBy "client"]
                    & defaultFilter  (singletonMap "violation" [toPathPiece SupervisionViolationEither])
    dbtSorting = Map.fromList
      [ ("reason"       , SortColumn $ queryRelation    >>> (E.^. UserSupervisorReason))
      , ("rel-comp"     , SortColumn $ queryRelation    >>> (E.^. UserSupervisorCompany))
      , ("reroute"      , SortColumn $ queryRelation    >>> (E.^. UserSupervisorRerouteNotifications))
      , ("supervisor"   , SortColumn $ querySupervisor  >>> (E.^. UserDisplayName))
      , ("client"       , SortColumn $ queryClient >>> (E.^. UserDisplayName))
      , ("super-comp"   , SortColumn (\row -> E.subSelect $ do
            (cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
            E.where_ $ usrCmp E.^. UserCompanyUser E.==. querySupervisor  row E.^. UserId
            E.orderBy [E.asc $ cmp E.^. CompanyName]
            return (cmp E.^. CompanyName)
          ))
      , ("client-comp"  , SortColumn (\row -> E.subSelect $ do
            (cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
            E.where_ $ usrCmp E.^. UserCompanyUser E.==. queryClient row E.^. UserId
            E.orderBy [E.asc $ cmp E.^. CompanyName]
            return (cmp E.^. CompanyName)
          ))
      ]

    dbtFilter = Map.fromList
      [ ("violation", FilterColumn $ \(queryRelation -> us) (getLast -> criterion) -> case criterion of
          Just SupervisionViolationSupervisor  -> missingCompanySupervisor us
          Just SupervisionViolationClient ->                                   missingCompanyClient us
          Just SupervisionViolationBoth        -> missingCompanySupervisor us E.&&. missingCompanyClient us
          _                                    -> missingCompanySupervisor us E.||. missingCompanyClient us
        )
      , ("rel-company", FilterColumn $ E.mkExistsFilter $ \(queryRelation -> us) (commaSeparatedText -> criteria) -> do
          let numCrits    = setMapMaybe readMay criteria
          cmp <- E.from $ E.table @Company
          E.where_ $ cmp E.^. CompanyId E.=?. us E.^. UserSupervisorCompany
              E.&&. E.or (
                      bcons (notNull numCrits)
                      (E.mkExactFilter (E.^. CompanyAvsId) cmp numCrits)
                      [E.mkContainsFilterWith CI.mk (E.^. CompanyName) cmp criteria
                      ,E.mkContainsFilterWith CI.mk (E.^. CompanyShorthand) cmp criteria
                      ]
                    )
        )
      , ("supervisor-company", fltrCompanyShortNrUsr (querySupervisor  >>> (E.^. UserId)))
      , ("client-company"    , fltrCompanyShortNrUsr (queryClient >>> (E.^. UserId)))
      , ("supervisor", FilterColumn . E.mkContainsFilter $ querySupervisor >>> (E.^. UserDisplayName))
      , ("client"    , FilterColumn . E.mkContainsFilter $ queryClient     >>> (E.^. UserDisplayName))
      ]
    dbtFilterUI mPrev = mconcat                  --  Maybe (Map FilterKey [Text]) -> AForm DB (Map FilterKey [Text])
      [ prismAForm (singletonFilter "violation" . maybePrism _PathPiece) mPrev $ aopt supervisionViolationField (fslI MsgSupervisionViolationChoice)
      , prismAForm (singletonFilter "rel-company")     mPrev $ aopt textField (fslI MsgUserSupervisorCompany & setTooltip MsgTableFilterCommaNameNr)
      , prismAForm (singletonFilter "supervisor")      mPrev $ aopt textField (fslI MsgTableSupervisor)
      , fltrCompanyNameNrUsrHdrUI "supervisor-company" (someMessages [MsgTableSupervisor, MsgTableCompanyShort]) mPrev
      , prismAForm (singletonFilter "client")          mPrev $ aopt textField (fslI MsgTableSupervisee)
      , fltrCompanyNameNrUsrHdrUI "client-company"     (someMessages [MsgTableSupervisee, MsgTableCompanyShort]) mPrev
      ]

    suggestionSupervision :: Handler (OptionList Text)
    suggestionSupervision = mkOptionListText <$> runDB
      (E.select $ do
        us <- E.from $ E.table @UserSupervisor
        let reason = us E.^. UserSupervisorReason
            countRows' :: E.SqlExpr (E.Value Int64) = E.countRows
        E.where_ $ E.isJust reason
        E.groupBy reason
        E.orderBy [E.desc countRows']
        E.limit 9
        pure $ E.coalesceDefault [reason] (E.val "")
      )
    dbtParams = DBParamsForm
      { dbParamsFormMethod = POST
      , dbParamsFormAction = Nothing
      , dbParamsFormAttrs  = []
      , dbParamsFormSubmit = FormSubmit
      , dbParamsFormAdditional =
          let acts :: Map ActSupervision (AForm Handler ActSupervisionData)
              acts = mconcat
                      [ singletonMap ASChangeCompany $ ASChangeCompanyData
                          <$> aopt companyField (fslI MsgUserSupervisorCompany) Nothing
                          <*> aopt (textField & cfStrip & addDatalist suggestionSupervision) (fslI MsgUserSupervisorReason  & setTooltip MsgStarKeepsEmptyDeletes) (Just $ Just "*")
                      , singletonMap ASRemoveAssociation $ pure ASRemoveAssociationData
                      ]
          in renderAForm FormStandard $ (, mempty) . First . Just <$> multiActionA acts (fslI MsgTableAction) Nothing
      , dbParamsFormEvaluate = liftHandler . runFormPost
      , dbParamsFormResult   = id
      , dbParamsFormIdent    = def
      }
    dbtCsvEncode = noCsvEncode
    dbtCsvDecode = Nothing
    dbtExtraReps = []

    postprocess :: FormResult (First ActSupervisionData, DBFormResult UserSupervisorId Bool TblSupervisionData)
                -> FormResult (      ActSupervisionData, Set UserSupervisorId)
    postprocess inp = do
        (First (Just act), jobMap) <- inp
        let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
        return (act, jobSet)


getFirmsSupervisionR, postFirmsSupervisionR :: Handler Html
getFirmsSupervisionR = postFirmsSupervisionR
postFirmsSupervisionR = do
  (svRes, svTbl) <- runDB mkSupervisionTable
  formResult svRes $ \case
    (ASRemoveAssociationData, relations) -> do
      nrDel <- runDB $ deleteWhereCount [UserSupervisorId <-. Set.toList relations]
      addMessageOutOfI MsgSupervisionsRemoved nrDel $ Set.size relations
      reloadKeepGetParams FirmsSupervisionR
    (ASChangeCompanyData{..}, relations) -> do
      let rsnChg = case asTblReason of
                      Just "*" -> Nothing
                      _        -> Just $ UserSupervisorReason =. asTblReason
          chgs = mcons rsnChg [UserSupervisorCompany =. CompanyKey <$> canonical asTblCompany]
      nrChg <- runDB $ updateWhereCount [UserSupervisorId <-. Set.toList relations] chgs
      addMessageOutOfI MsgSupervisionsEdited nrChg $ Set.size relations
      reloadKeepGetParams FirmsSupervisionR
  -- TODO: Bug Firmenwechsel: Bestehende Ansprechpartnerbeziehung - Firma ändern!
  let heading = MsgMenuFirmsSupervision
  siteLayoutMsg heading $ do
    setTitleI heading
    [whamlet|$newline never
      <p>
        _{MsgFirmSupervisionRInfo} In folgenden Ansprechpartnerbeziehungen gehören entweder der Ansprechpartner oder der Angesprochene #
        nicht mehr der Firma an, welche als Begründung für die Beziehung eingetragen ist:
      <p>
        ^{svTbl}
    |]
