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

{-# OPTIONS -Wno-unused-top-binds -Wno-unused-imports #-}      -- TODO: remove me, for debugging only
{-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
{-# LANGUAGE TypeApplications #-}

module Handler.Firm
  ( getFirmAllR   , postFirmAllR
  , getFirmR      , postFirmR
  , getFirmUsersR , postFirmUsersR
  , getFirmSupersR, postFirmSupersR
  )
  where

import Import

-- import Jobs
import Handler.Utils

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 (updateWhereCount)
import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Legacy as EL (from, on)
-- import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH


-- avoids repetition of local definitions
single :: (k,a) -> Map k a
single = uncurry Map.singleton


getFirmR,  postFirmR :: CompanyShorthand -> Handler Html
getFirmR = postFirmR
postFirmR fsh = do
  let fshId = CompanyKey fsh
  cusers <- runDB $ do
    cusers <- selectList [UserCompanyCompany ==. fshId] []
    selectList [UserId <-. fmap (userCompanyUser . entityVal) cusers] [Asc UserDisplayName]
  csuper <- runDB $ do
    csuper <- selectList [UserCompanyCompany ==. fshId, UserCompanySupervisor ==. True] []
    selectList [UserId <-. fmap (userCompanyUser . entityVal) csuper] [Asc UserDisplayName]
  cactSuper <- runDB $ E.select $ do
      (usr :& spr :& scmpy) <- E.from $
                        E.table @User
          `E.innerJoin` E.table @UserSupervisor
          `E.on` (\(usr :& spr         ) -> spr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId)
          `E.leftJoin`  E.table @UserCompany
          `E.on` (\(_   :& spr :& scmpy) -> spr E.^. UserSupervisorSupervisor E.=?. scmpy E.?. UserCompanyUser)
      E.where_ $ (spr E.^. UserSupervisorUser) `E.in_` E.valList (entityKey <$> cusers)
      E.groupBy (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany)
      E.orderBy [E.asc $ usr E.^. UserId, E.asc $ usr E.^. UserDisplayName, E.asc $ usr E.^. UserSurname, E.asc $ scmpy E.?. UserCompanyCompany]
      let countRows' :: E.SqlExpr (E.Value Int64) = E.countRows
      return    (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany, countRows', usr E.^. UserPrefersPostal)

  siteLayoutMsg (SomeMessage fsh) $ do
    setTitle $ citext2Html fsh
    [whamlet|
      <h2>PROVISORISCHE DEBUG SEITE 
      <p>Diese Seite wird in der finalen Version nicht mehr enthalten sein.

      <h3>#{length csuper} Company Default Supervisors (non-foreign only)
      <ul>
        $forall u <- csuper
          <li>^{linkUserWidget ForProfileDataR u}

      <h3>#{length cactSuper} Active Supervisors for Employees
      <ul>
        $forall (E.Value _, E.Value dn, E.Value sn, E.Value mbCsh, E.Value nr, E.Value prefPost) <- cactSuper
          <li>#{nr} Employees supervised by ^{nameWidget dn sn} #
            #{iconLetterOrEmail prefPost} #
            $maybe csh <- mbCsh
              $if csh /= fshId
                from foreign company #{unCompanyKey csh}
              $else
                from this company
            $nothing
              having no associated company

      <h3>#{length cusers} Employees
      <ul>
        $forall u <- cusers
          <li>^{linkUserWidget ForProfileDataR u}

      In the end, this needs to be a dbTable, of course!
    |]


-----------------------
-- All Firms Table

data FirmAllAction = FirmAllActNotify
                   | FirmAllActResetSupervision
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
embedRenderMessage ''UniWorX ''FirmAllAction id

data FirmAllActionData = FirmAllActNotifyData
                   | FirmAllActResetSupervisionData
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

-- just in case for future extensions
type AllCompanyTableExpr = E.SqlExpr (Entity Company)
queryAllCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
queryAllCompany = id

type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64)
resultAllCompanyEntity          :: Lens' AllCompanyTableData (Entity Company)
resultAllCompanyEntity          = _dbrOutput . _1

resultAllCompany                  :: Lens' AllCompanyTableData Company
resultAllCompany                  = resultAllCompanyEntity . _entityVal

resultAllCompanyUsers             :: Lens' AllCompanyTableData Word64
resultAllCompanyUsers             = _dbrOutput . _2 . _unValue

resultAllCompanySupervisors       :: Lens' AllCompanyTableData Word64
resultAllCompanySupervisors       = _dbrOutput . _3 . _unValue

resultAllCompanyEmployeeSupervised :: Lens' AllCompanyTableData Word64
resultAllCompanyEmployeeSupervised = _dbrOutput . _4 . _unValue

resultAllCompanyEmployeeRerouted  :: Lens' AllCompanyTableData Word64
resultAllCompanyEmployeeRerouted  = _dbrOutput . _5 . _unValue

resultAllCompanyEmpRerPost        :: Lens' AllCompanyTableData Word64
resultAllCompanyEmpRerPost        = _dbrOutput . _6 . _unValue

resultAllCompanyForeignSupers     :: Lens' AllCompanyTableData Word64
resultAllCompanyForeignSupers     = _dbrOutput . _7 . _unValue

resultAllCompanyDefaultReroutes   :: Lens' AllCompanyTableData Word64
resultAllCompanyDefaultReroutes   = _dbrOutput . _8 . _unValue

resultAllCompanyActiveReroutes    :: Lens' AllCompanyTableData Word64
resultAllCompanyActiveReroutes    = _dbrOutput . _9 . _unValue

resultAllCompanyActiveReroutes'   :: Lens' AllCompanyTableData Word64
resultAllCompanyActiveReroutes'   = _dbrOutput . _10 . _unValue

fromUserCompany :: Maybe (E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity Company) -> E.SqlQuery ()
fromUserCompany mbFltr cmpy = do
  usrCmpy <- E.from $ E.table @UserCompany
  let basecond = usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
  E.where_ $ maybe basecond ((basecond E.&&.).($ usrCmpy)) mbFltr

firmCountUsers        :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountUsers        = E.subSelectCount . fromUserCompany Nothing

firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountSupervisors  = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
-- firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-- firmCountSupervisors cmpy = E.subSelectCount $ E.distinct $ do
--   usrCmpy <- E.from $ E.table @UserCompany
--   E.where_ $ (usrCmpy E.^. UserCompanyCompany    E.==. cmpy E.^. CompanyId)
--       E.&&.  (usrCmpy E.^. UserCompanySupervisor E.==. E.true)
--   return $ usrCmpy E.^. UserCompanyUser

firmCountDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountDefaultReroutes = E.subSelectCount . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute))

firmCountEmployeeSupervised :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountEmployeeSupervised = E.subSelectCount . fromUserCompany (Just fltr)
  where
    fltr :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)
    fltr usrc = E.exists $ do
      usrSuper <- E.from $ E.table @UserSupervisor
      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser

firmCountEmployeeRerouted :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountEmployeeRerouted = E.subSelectCount . fromUserCompany (Just fltr)
  where   
    fltr usrc = E.exists $ do
      usrSuper <- E.from $ E.table @UserSupervisor
      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
        E.&&.    usrSuper E.^. UserSupervisorRerouteNotifications

firmCountEmployeeRerPost :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountEmployeeRerPost = E.subSelectCount . fromUserCompany (Just fltr)
  where 
    fltr usrc = E.exists $ do
      (usrSuper :& usr) <-
        E.from $ E.table @UserSupervisor
        `E.innerJoin` E.table @User
        `E.on` (\(usrSuper :& usr) -> usrSuper E.^. UserSupervisorSupervisor E.==. usr E.^. UserId)
      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
        E.&&.    usrSuper E.^. UserSupervisorRerouteNotifications
        E.&&.              usr E.^. UserPrefersPostal
        E.&&.    E.isJust (usr E.^. UserPostAddress)


-- firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-- firmCountForeignSupervisors cmpy = E.coalesceDefault
--   [E.subSelect $ do
--     usrSuper <- E.from $ E.table @UserSupervisor
--     E.groupBy (usrSuper E.^. UserSupervisorSupervisor)
--     E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
--       E.&&.  E.notExists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor) cmpy)
--     return E.countRows
--   ] (E.val 0)

firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountForeignSupervisors cmpy = E.subSelectCountDistinct $ do
    usrSuper <- E.from $ E.table @UserSupervisor
    E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
      E.&&.  E.notExists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor) cmpy)
    pure $ usrSuper E.^. UserSupervisorSupervisor

firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do
    usrSuper <- E.from $ E.table @UserSupervisor
    E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
      E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications
    pure $ usrSuper E.^. UserSupervisorSupervisor

firmCountActiveReroutes' :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountActiveReroutes' cmpy = E.subSelectCount $ do
    usrSuper <- E.from $ E.table @UserSupervisor
    E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
      E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications


mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
mkFirmAllTable isAdmin uid = do
  -- now <- liftIO getCurrentTime
  let
    resultDBTable = DBTable{..}
      where
        dbtSQLQuery cmpy = do
          unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies
            usrCmpy <- E.from $ E.table @UserCompany
            E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
                E.&&.  usrCmpy E.^. UserCompanyUser    E.==. E.val uid
          return  ( cmpy                                        --  1
                  , cmpy & firmCountUsers                       --  2
                  , cmpy & firmCountSupervisors                 --  3
                  , cmpy & firmCountEmployeeSupervised          --  4
                  , cmpy & firmCountEmployeeRerouted            --  5
                  , cmpy & firmCountEmployeeRerPost             --  6
                  , cmpy & firmCountForeignSupervisors          --  7
                  , cmpy & firmCountDefaultReroutes             --  8
                  , cmpy & firmCountActiveReroutes              --  9
                  , cmpy & firmCountActiveReroutes'             -- 10
                  )
        dbtRowKey = (E.^. CompanyId)
        dbtProj = dbtProjId
        dbtColonnade = formColonnade $ mconcat
          [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
          , sortable (Just "name")          (i18nCell MsgTableCompany)                 $ \(view resultAllCompany -> firm) ->
              anchorCell (FirmUsersR $ companyShorthand firm) . toWgt $ companyName firm
          , sortable (Just "short")         (i18nCell MsgTableCompanyShort)            $ \(view resultAllCompany -> firm) ->
              let fsh = companyShorthand firm
              in  anchorCell (FirmUsersR fsh) $ toWgt fsh
          , sortable (Just "avsnr")         (i18nCell MsgTableCompanyNo)               $ \(view resultAllCompany -> firm) ->
              anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
          , sortable (Just "users")         (i18nCell MsgTableCompanyNrUsers)          $ \(view resultAllCompanyUsers               -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "supervisors")   (i18nCell MsgTableCompanyNrSupersDefault)  $ \row -> 
              anchorCell (FirmSupersR $ row ^. resultAllCompany . _companyShorthand) $ word2widget $ row ^. resultAllCompanySupervisors
          , sortable (Just "reroute-def")   (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes     -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "emp-supervised")(i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultAllCompanyEmployeeSupervised  -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "emp-rerouted")  (i18nCell MsgTableCompanyNrEmpRerouted)    $ \(view resultAllCompanyEmployeeRerouted    -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "emp-rer-post")  (i18nCell MsgTableCompanyNrEmpRerPost)     $ \(view resultAllCompanyEmpRerPost          -> nr) -> wgtCell $ word2widget nr          
          , sortable (Just "foreigners")    (i18nCell MsgTableCompanyNrForeignSupers)  $ \(view resultAllCompanyForeignSupers       -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "reroute-act")   (i18nCell MsgTableCompanyNrRerouteActive)  $ \(view resultAllCompanyActiveReroutes      -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "reroute-all")   (i18nCell MsgTableCompanyNrRerouteActive)  $ \(view resultAllCompanyActiveReroutes'     -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "postal-pref")   (i18nCell MsgTableCompanyPostalPreference) $ \(view $ resultAllCompany . _companyPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
          ]
        dbtSorting = mconcat
          [ singletonMap "name"           $ SortColumn (E.^. CompanyName)
          , singletonMap "short"          $ SortColumn (E.^. CompanyShorthand)
          , singletonMap "avsnr"          $ SortColumn (E.^. CompanyAvsId)
          , singletonMap "postal-pref"    $ SortColumn (E.^. CompanyPrefersPostal)
          , singletonMap "users"          $ SortColumn firmCountUsers
          , singletonMap "supervisors"    $ SortColumn firmCountSupervisors
          , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised
          , singletonMap "emp-rerouted"   $ SortColumn firmCountEmployeeRerouted
          , singletonMap "emp-rer-post"   $ SortColumn firmCountEmployeeRerPost
          , singletonMap "reroute-def"    $ SortColumn firmCountDefaultReroutes
          , singletonMap "foreigners"     $ SortColumn firmCountForeignSupervisors
          , singletonMap "reroute-act"    $ SortColumn firmCountActiveReroutes
          , singletonMap "reroute-all"    $ SortColumn firmCountActiveReroutes'
          ]
        dbtFilter = mconcat
          [ single $ fltrCompanyNameNr queryAllCompany
          , single ("is-supervisor", FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do              
              (usr :& usrCmp) <- E.from $ E.table @User
                `E.innerJoin` E.table @UserCompany
                `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser)              
              E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
                E.&&. (  (usr E.^. UserDisplayName  `E.hasInfix` E.val criterion)
                  E.||.  (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk criterion))
                  E.||.  (usr E.^. UserSurname      `E.hasInfix` E.val criterion)
                )
            )
          ]
        dbtFilterUI mPrev = mconcat        
          [ fltrCompanyNameNrUI mPrev
          , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
          ]
        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
        acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
        acts = mconcat
          [ singletonMap FirmAllActNotify           $ pure FirmAllActNotifyData
          , singletonMap FirmAllActResetSupervision $ pure FirmAllActResetSupervisionData
          ]
        dbtParams = DBParamsForm
          { dbParamsFormMethod = POST
          , dbParamsFormAction = Nothing
          , dbParamsFormAttrs  = []
          , dbParamsFormSubmit = FormSubmit
          , dbParamsFormAdditional
              = renderAForm FormStandard $ (, mempty) . First . Just
                  <$> multiActionA acts (fslI MsgTableAction) Nothing
          , dbParamsFormEvaluate = liftHandler . runFormPost
          , dbParamsFormResult   = id
          , dbParamsFormIdent    = def
          }
        dbtIdent :: Text
        dbtIdent = "firm"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []

    postprocess :: FormResult (First FirmAllActionData, DBFormResult CompanyId Bool AllCompanyTableData)
                -> FormResult (      FirmAllActionData, Set CompanyId)
    postprocess inp = do
        (First (Just act), cmpMap) <- inp
        let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap
        return (act, cmpSet)

    -- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
    resultDBTableValidator = def
      & defaultSorting  [SortAscBy "short"]
  over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable


getFirmAllR, postFirmAllR :: Handler Html
getFirmAllR = postFirmAllR
postFirmAllR = do
  uid <- requireAuthId
  isAdmin <- hasReadAccessTo AdminR
  (firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
  formResult firmRes $ \case
    (FirmAllActNotifyData          , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " companies. TODO"
    (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset "  <> tshow (length fids) <> " companies. TODO"
  siteLayoutMsg MsgMenuFirms $ do
    setTitleI MsgMenuFirms
    $(i18nWidgetFile "firm-all")


-----------------------
-- Firm Users Table

data FirmUserAction = FirmUserActNotify 
                    | FirmUserActMkSuper
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''FirmUserAction $ camelToPathPiece' 3
embedRenderMessage ''UniWorX ''FirmUserAction id

data FirmUserActionData = FirmUserActNotifyData
                        | FirmUserActMkSuperData
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

type UserCompanyTableExpr = E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity UserCompany)

queryUserUser :: UserCompanyTableExpr -> E.SqlExpr (Entity User)
queryUserUser = $(sqlIJproj 2 1)

queryUserUserCompany :: UserCompanyTableExpr -> E.SqlExpr (Entity UserCompany)
queryUserUserCompany = $(sqlIJproj 2 2)

type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64)

resultUserUser :: Lens' UserCompanyTableData (Entity User)
resultUserUser = _dbrOutput . _1 

resultUserUserCompany :: Lens' UserCompanyTableData (Entity UserCompany)
resultUserUserCompany = _dbrOutput . _2

resultUserCompanySupervisors :: Lens' UserCompanyTableData Word64
resultUserCompanySupervisors = _dbrOutput . _3 . _unValue

resultUserCompanyReroutes :: Lens' UserCompanyTableData Word64
resultUserCompanyReroutes = _dbrOutput . _4 . _unValue

instance HasEntity UserCompanyTableData User where 
  hasEntity = resultUserUser

instance HasUser UserCompanyTableData where 
  hasUser = resultUserUser . _entityVal


firmCountUserSupervisors :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Word64)
firmCountUserSupervisors usrCmp = E.subSelectCount $ do
  usrSpr <- E.from $ E.table @UserSupervisor
  E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
  
firmCountUserSupervisorsReroute :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Word64)
firmCountUserSupervisorsReroute usrCmp = E.subSelectCount $ do
  usrSpr <- E.from $ E.table @UserSupervisor
  E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
      E.&&.  usrSpr E.^. UserSupervisorRerouteNotifications

mkFirmUserTable :: Bool -> CompanyId -> DB (FormResult (FirmUserActionData, Set UserId), Widget)
mkFirmUserTable isAdmin cid = do
  let
    fsh = unCompanyKey cid
    resultDBTable = DBTable{..}
      where
        dbtSQLQuery = \(usr `E.InnerJoin` usrCmp) -> do
          EL.on $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
          E.where_ $ usrCmp E.^. UserCompanyCompany E.==. E.val cid
          return (usr, usrCmp, firmCountUserSupervisors usrCmp, firmCountUserSupervisorsReroute usrCmp)
        dbtRowKey = queryUserUser >>> (E.^. UserId)
        dbtProj = dbtProjId
        dbtColonnade = formColonnade $ mconcat
          [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultUserUser . _entityKey))
          , colUserNameModalHdr MsgTableCompanyUser ForProfileDataR
          , sortable (Just "matriculation")   (i18nCell MsgTableMatrikelNr)              $ \(view resultUserUser           -> entUsr ) -> cellHasMatrikelnummerLinked entUsr
          , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber)        $ \(view $ resultUserUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t
          , sortable (Just "supervisors")     (i18nCell MsgTableCompanyNrSupers       )  $ \(view resultUserCompanySupervisors  -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "reroutes")        (i18nCell MsgTableCompanyNrRerouteActive)  $ \(view resultUserCompanyReroutes     -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "postal-pref")     (i18nCell MsgPrefersPostal)                $ \(view $ resultUserUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
          , colUserEmail
          ]
        dbtSorting = mconcat
          [ single $ sortUserNameLink queryUserUser
          , single $ sortUserEmail    queryUserUser
          , singletonMap "postal-pref"      $ SortColumn $ queryUserUser        >>> (E.^. UserPrefersPostal)
          , singletonMap "matriculation"    $ SortColumn $ queryUserUser        >>> (E.^. UserMatrikelnummer)
          , singletonMap "personal-number"  $ SortColumn $ queryUserUser        >>> (E.^. UserCompanyPersonalNumber)
          , singletonMap "supervisors"      $ SortColumn $ queryUserUserCompany >>> firmCountUserSupervisors
          , singletonMap "reroutes"         $ SortColumn $ queryUserUserCompany >>> firmCountUserSupervisorsReroute
          ]
        dbtFilter = mconcat
          [ single $ fltrUserNameEmail queryUserUser
          , singletonMap "has-supervisor" $ FilterColumn $ \row (getLast -> criterion) -> 
              let checkSuper = do 
                    usrSpr <- E.from $ E.table @UserSupervisor
                    E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
              in case criterion of
                  Nothing     -> E.true
                  Just True   -> E.exists    checkSuper
                  Just False  -> E.notExists checkSuper
          , singletonMap "has-company-supervisor" $ FilterColumn $ \row (getLast -> criterion) -> 
              let checkSuper = do 
                    usrSpr <- E.from $ E.table @UserSupervisor
                    E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
                        E.&&.  E.exists (do
                                  spr <- E.from $  E.table @UserCompany
                                  E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid
                                    E.&&.    spr E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorSupervisor
                                )
              in case criterion of
                  Nothing     -> E.true
                  Just True   -> E.exists    checkSuper
                  Just False  -> E.notExists checkSuper
          ]
        dbtFilterUI mPrev = mconcat
          [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
          , prismAForm (singletonFilter "has-supervisor"         . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
          , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh)
          ]
        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
        acts :: Map FirmUserAction (AForm Handler FirmUserActionData)
        acts = mconcat
          [ singletonMap FirmUserActNotify  $ pure FirmUserActNotifyData
          , singletonMap FirmUserActMkSuper $ pure FirmUserActMkSuperData
          ]
        dbtParams = DBParamsForm
          { dbParamsFormMethod = POST
          , dbParamsFormAction = Nothing
          , dbParamsFormAttrs  = []
          , dbParamsFormSubmit = FormSubmit
          , dbParamsFormAdditional
              = renderAForm FormStandard $ (, mempty) . First . Just
                  <$> multiActionA acts (fslI MsgTableAction) Nothing
          , dbParamsFormEvaluate = liftHandler . runFormPost
          , dbParamsFormResult   = id
          , dbParamsFormIdent    = def
          }
        dbtIdent :: Text
        dbtIdent = "firm-users"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []

    postprocess :: FormResult (First FirmUserActionData, DBFormResult UserId Bool UserCompanyTableData)
                -> FormResult (      FirmUserActionData, Set UserId)
    postprocess inp = do
        (First (Just act), m) <- inp
        let s = Map.keysSet . Map.filter id $ getDBFormResult (const False) m
        return (act, s)

    -- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
    resultDBTableValidator = def
      & defaultSorting  [SortAscBy "user-name"]
  over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable


getFirmUsersR, postFirmUsersR :: CompanyShorthand -> Handler Html
getFirmUsersR  = postFirmUsersR
postFirmUsersR fsh = do
  isAdmin <- hasReadAccessTo AdminR
  let fshId = CompanyKey fsh
  (Company{..}, (fusrRes, fusrTable)) <- runDB $ (,) 
    <$> get404 fshId
    <*> mkFirmUserTable isAdmin fshId
  formResult fusrRes $ \case
    (FirmUserActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " employees. TODO"
    (FirmUserActMkSuperData, fids) -> addMessage Info $ text2Html $ "Make "  <> tshow (length fids) <> " employees to supervisors. TODO"
  siteLayout (citext2widget companyName) $ do
    setTitle $ toHtml $ CI.original companyShorthand <> " (" <> tshow companyAvsId <> ")"
    [whamlet|
      <section> 
        <p>
          #{companyPostAddress}
        <p>
          Benachrichtigungs-Voreinstellung für neue Firmangehörige: #
            $if companyPrefersPostal
              #{icon IconLetter} Briefversand
            $else 
              #{icon IconAt} Email
      <section>
        <h4>
          Company associated users, excluding foreign supervisors
        <p>
          ^{fusrTable}
    |]


-----------------------------
-- Firm Supervisors Table

getFirmSupersR, postFirmSupersR :: CompanyShorthand ->  Handler Html
getFirmSupersR = postFirmSupersR
postFirmSupersR fsh = do
  let _fshId = CompanyKey fsh
  siteLayout (citext2widget fsh) $ do
    setTitle $ citext2Html fsh
    [whamlet|!!!STUB!!!TO DO!!!|]