-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.Company where


import Import

-- import Data.CaseInsensitive (CI)
-- import qualified Data.CaseInsensitive as CI
-- import qualified Data.Char as Char
-- import qualified Data.Text as Text
import Database.Persist.Postgresql

import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Utils        as E
import qualified Database.Esqueleto.PostgreSQL   as E

import Handler.Utils.Users
import Handler.Utils.Widgets

company2msg :: CompanyId -> SomeMessage UniWorX
company2msg = text2message . ciOriginal . unCompanyKey

wgtCompanies :: UserId -> DB (Maybe Widget)
wgtCompanies = \uid -> do
    companies <- E.select $ do 
      (usrComp :& comp) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @Company
        `E.on` (\(usrComp :& comp) -> usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId)
      E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
      E.orderBy [E.asc (comp E.^. CompanyName)]
      return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor, usrComp E.^. UserCompanyPriority)
    let (mPri, topCmp, otherCmp) = procCmp mPri companies
        resWgt = 
          [whamlet|
            $forall c <- topCmp
              <p>
                ^{c}
            $forall c <- otherCmp
              <p>
                #{c}
          |]
    return $ toMaybe (notNull topCmp) resWgt
  where 
    procCmp _ [] = (0, [],[])
    procCmp maxPri ((E.Value cmpSh, E.Value cmpName, E.Value cmpSpr, E.Value cmpPrio) : cs) =
      let cmpWgt = companyWidget (cmpSh, cmpName, cmpSpr)
          isTop  = cmpPrio >= maxPri
          (accPri,accTop,accRem) = procCmp maxPri cs
      in (max cmpPrio accPri, bool accTop (cmpWgt : accTop) isTop, bool (cmpName : accRem) accRem isTop) -- lazy evaluation after repmin example

-- TODO: use this function in company view Handler.Firm #157
-- | add all company supervisors for a given users
addCompanySupervisors :: (MonadIO m, BackendCompatible SqlBackend backend, PersistQueryWrite backend, PersistUniqueWrite backend) 
                      => Key Company -> Key User -> ReaderT backend m ()
addCompanySupervisors cid uid = 
  E.insertSelectWithConflict
    UniqueUserSupervisor
    ( do 
        userCompany <- E.from $ E.table @UserCompany
        E.where_ $ userCompany E.^. UserCompanyCompany E.==. E.val cid
            E.&&.  userCompany E.^. UserCompanySupervisor
        return $ UserSupervisor
          E.<#  (userCompany E.^. UserCompanyUser)
          E.<&>  E.val uid
          E.<&> (userCompany E.^. UserCompanySupervisorReroute)
          E.<&>  E.justVal cid
          E.<&>  E.justVal (tshow SupervisorReasonCompanyDefault)
    )
    (\current excluded -> -- Supervision between chosen individuals exists already; keep old reason and company, if exists
        [ UserSupervisorCompany E.=. E.coalesce [current  E.^. UserSupervisorCompany, excluded E.^. UserSupervisorCompany] -- do we want this? Ok, since we delete unconditionally first?!
        , UserSupervisorReason  E.=. E.coalesce [current  E.^. UserSupervisorReason , excluded E.^. UserSupervisorReason ]
        ] 
    )


-- | removes user supervisorship on switch. WARNING: problems are not yet written to DB via reportProblem yet
switchAvsUserCompany :: Bool -> Bool -> UserId -> CompanyId -> DB ([Update User], [AdminProblem])
switchAvsUserCompany usrPostAddrUpd keepOldCompanySupervs uid newCompanyId = do
    usrRec      <- get404 uid
    newCompany  <- get404 newCompanyId 
    mbUsrComp   <- getUserPrimaryCompany uid
    mbOldComp   <- (get . userCompanyCompany) `traverseJoin` mbUsrComp
    mbUsrAvs    <- if usrPostAddrUpd then getBy (UniqueUserAvsUser uid) else return Nothing
    let usrPostAddr :: Maybe StoredMarkup = userPostAddress usrRec
        avsPostAddr :: Maybe StoredMarkup = mbUsrAvs ^? _Just . _entityVal . _userAvsLastFirmInfo . _Just . _avsFirmPostAddress . _Just
        usrPostUp = toMaybe (usrPostAddrUpd && fromMaybe False (liftA2 isSimilarMarkup usrPostAddr avsPostAddr))
                      (UserPostAddress =. Nothing)                                                   -- use company address indirectyl instead
        usrPrefPost = userPrefersPostal usrRec
        usrPrefPostUp = toMaybe (Just usrPrefPost == (mbOldComp ^? _Just . _companyPrefersPostal)) 
                      (UserPrefersPostal  =. companyPrefersPostal newCompany)
        usrUpdate = catMaybes [usrPostUp, usrPrefPostUp]
                --  [UserPostAddress =. Nothing, UserPrefersPostal =. companyPrefersPostal newCompany] -- unconditional
    -- update uid usrUpdate    
    -- repsertSuperiorSupervisor is not called here, since the Superior is indepentent of the actual company association
    case mbUsrComp of
      Nothing -> do -- create company user
        void $ insertUnique newUserComp
        addCompanySupervisors newCompanyId uid
        return (usrUpdate, mempty)
      Just UserCompany{userCompanyCompany=oldCompanyId, userCompanyPriority=oldPrio, userCompanySupervisor=oldSuper, userCompanySupervisorReroute=oldSuperReroute}
        | newCompanyId == oldCompanyId -> return mempty -- nothing to do
        | otherwise -> do -- switch company             
            void $ upsertBy (UniqueUserCompany uid newCompanyId) newUserComp
              [UserCompanyPriority =. succ oldPrio, UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False, UserCompanyUseCompanyAddress =. True]
            -- supervised by uid            
            supervisees :: [(Entity UserSupervisor, E.Value Bool)] <- E.select $ do
              usrSup <- E.from $ E.table @UserSupervisor
              E.where_ $ usrSup E.^. UserSupervisorSupervisor E.==. E.val uid
                  E.&&.  usrSup E.^. UserSupervisorCompany    E.~=. E.val oldCompanyId
                  E.&&.  usrSup E.^. UserSupervisorReason     E.~=. E.val superReasonComDef
              let singleSup = E.notExists $ do
                    othSup <- E.from $ E.table @UserSupervisor
                    E.where_ $ usrSup E.^. UserSupervisorUser     E.==. othSup E.^. UserSupervisorUser
                        E.&&.  othSup E.^. UserSupervisorCompany  E.~=. E.val oldCompanyId
                        E.&&.  othSup E.^. UserSupervisorReason   E.~=. E.val superReasonComDef                    
              return (usrSup, singleSup)
            newlyUnsupervised <- guardMonoidM (notNull supervisees) $ do
              E.delete $ do 
                usrSup <- E.from $ E.table @UserSupervisor
                E.where_ $ usrSup E.^. UserSupervisorId `E.in_` E.vals (fmap (entityKey . fst) supervisees)
              return $  [ AdminProblemSupervisorLeftCompany subid oldCompanyId oldSuperReroute
                        | (Entity{entityVal=UserSupervisor{userSupervisorUser=subid}}, E.Value True)  <- supervisees ]              
            -- supervisors of uid
            let superDeftFltr     = (UserSupervisorUser ==. uid) : (UserSupervisorReason  ~=. superReasonComDef)
                oldSubFltr        = (UserSupervisorCompany ~=. oldCompanyId) <> superDeftFltr
            oldAPs <- if keepOldCompanySupervs
              then updateWhereCount oldSubFltr [UserSupervisorReason =. Nothing]
              else deleteWhereCount oldSubFltr
            addCompanySupervisors newCompanyId uid
            newAPs <- count $ (UserSupervisorCompany ==. Just newCompanyId) : superDeftFltr
            let isNoLongerSupervised = not keepOldCompanySupervs && oldAPs > 0 && newAPs <= 0
                problems = bcons oldSuper             (AdminProblemSupervisorNewCompany uid oldCompanyId newCompanyId oldSuperReroute)
                         $ bcons isNoLongerSupervised (AdminProblemNewlyUnsupervised uid (Just oldCompanyId) newCompanyId)
                           newlyUnsupervised
            return (usrUpdate ,problems)
  where 
    newUserComp       = UserCompany uid newCompanyId False False 1 True -- default value for new company insertion, if no update can be done
    superReasonComDef = tshow SupervisorReasonCompanyDefault