-- 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 -Wno-unused-binds #-}      -- 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
  , getFirmCommR  , postFirmCommR
  , getFirmsCommR,  postFirmsCommR
  )
  where

import Import

-- import Jobs
import Handler.Utils
import Handler.Utils.Communication
import Handler.Utils.Avs (guessAvsUser)

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.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

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

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

postalEmailField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m Bool
postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgUtilEMail) $ Just $ SomeMessage MsgUtilUnchanged

---------------------------------
-- General firm affecting actions

data FirmAction = FirmActNotify
                | FirmActResetSupervision
                -- | FirmActAddSupervisors
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

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

data FirmActionData = FirmActNotifyData
                    | FirmActResetSupervisionData 
                        { firmActResetKeepOldSupers      :: Maybe Bool 
                        , firmActResetMutualSupervision  :: Maybe Bool
                        }
                    -- | FirmActAddSupervisorsData
                    --     { firmActAddSupervisorIds     :: Set Text
                    --     , firmActAddSupervisorReroute :: Bool
                    --     , firmActAddSupervisorPostal  :: Maybe Bool
                    --     }
  deriving (Eq, Ord, Read, Show, Generic)

firmActionMap :: [FirmAction] -> Map FirmAction (AForm Handler FirmActionData)
firmActionMap acts = mconcat (mkAct <$> acts)
  where
    mkAct FirmActNotify           = singletonMap FirmActNotify           $ pure FirmActNotifyData
    mkAct FirmActResetSupervision = singletonMap FirmActResetSupervision $      FirmActResetSupervisionData
            <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)         (Just $ Just False)
            <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
    -- mkAct FirmActAddSupervisors   = singletonMap FirmActAddSupervisors   $      FirmActAddSupervisorsData
    --         <$> areq (textField & cfAnySeparatedSet)                    (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) (Just mempty)
    --         <*> areq checkBoxField                                      (fslI MsgTableIsDefaultReroute )                          (Just True)
    --         <*> aopt postalEmailField                                   (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip)  (Just Nothing)

firmActionForm :: [FirmAction] -> AForm Handler FirmActionData
firmActionForm acts = multiActionA (firmActionMap acts) (fslI MsgTableAction) Nothing


makeFirmActionForm :: CompanyId -> [FirmAction] -> Form (FirmActionData, Set CompanyId)
makeFirmActionForm cid acts html = flip (renderAForm FormStandard) html $ (,Set.singleton cid) <$> firmActionForm acts

-- makeFirmActionTableForm :: Monoid t => [FirmAction] -> Text.Blaze.Internal.Markup -> Control.Monad.Trans.RWS.Lazy.RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints Handler (FormResult (First FirmActionData, t), WidgetFor UniWorX ())
-- makeFirmActionTableForm acts = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm acts

firmActionHandler :: Route UniWorX -> FormResult (FirmActionData, Set CompanyId) -> Handler ()
firmActionHandler route = flip formResult faHandler 
  where
    faHandler (_,fids) | null fids = addMessageI Error MsgNoCompanySelected
    faHandler (FirmActResetSupervisionData{..}, fids) = do
      runDB $ do
        delSupers <- if firmActResetKeepOldSupers == Just False
          then E.deleteCount $ do
                spr <- E.from $ E.table @UserSupervisor
                E.where_ $ E.exists $ do
                  usr <- E.from $ E.table @UserCompany
                  E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
                      E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser 
          else return 0 
        newSupers <- addDefaultSupervisorsAll (firmActResetMutualSupervision /= Just False) fids         
        addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
      reloadKeepGetParams route -- reload to reflect changes

    faHandler (FirmActNotifyData, Set.toList -> fids) = do
      usrs <- runDB $ E.select $ E.distinct $ do
        (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
        E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids
        return $ usr E.^. UserId
      cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
      redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])

    -- faHandler (FirmActAddSupervisorsData{..}, Set.toList -> [cid]) = do
    --   avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddSupervisorIds
    --   let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
    --       usersFound = mapMaybe snd usersFound'
    --   unless (null usersNotFound) $
    --     let msgContent = [whamlet|
    --           $newline never
    --           <ul>
    --             $forall (usr,_) <- usersNotFound
    --               <li>#{usr}
    --           |]
    --     in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
    --   when (null usersFound) $ do
    --     addMessageI Warning MsgASReqEmpty
    --     reloadKeepGetParams route
    --   runDB $ do
    --     putMany [UserCompany uid cid True firmActAddSupervisorReroute | uid <- usersFound]
    --     whenIsJust firmActAddSupervisorPostal $ \prefPostal ->
    --       updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
    --     addMessageI Info $ MsgASReqSetSupers (fromIntegral $ length usersFound) firmActAddSupervisorPostal
    --   redirect route
    -- faHandler _ = addMessageI Error MsgErrorUnknownFormAction


runFirmActionFormPost :: CompanyId -> Route UniWorX -> [FirmAction] -> Handler Widget
runFirmActionFormPost cid route acts = do 
  -- ((faRes, faWgt), faEnctype) <- runFormPost . identifyForm FIDFirmAction $ makeFirmActionForm cid acts
  ((faRes, faWgt), faEnctype) <- runFormPost $ makeFirmActionForm cid acts
  let faAnchor  = "firm-action-form" :: Text
      faRoute   = route :#: faAnchor
      faForm    = wrapForm faWgt FormSettings  
                        { formMethod = POST
                        , formAction = Just . SomeRoute $ faRoute
                        , formEncoding = faEnctype
                        , formAttrs = []
                        , formSubmit = FormSubmit
                        , formAnchor = Just faAnchor
                        }
  firmActionHandler route faRes
  return [whamlet| 
          <section>
            <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
              _{MsgFirmAction}
            <div> 
              ^{faForm}
        |]
  

---------------------------
-- Firm specific utilities
-- for filters and counts also see before FirmAllR Handlers



-- remove supervisors:
deleteSupervisors :: NonEmpty UserId -> DB Int64
deleteSupervisors usrs = deleteWhereCount [UserSupervisorUser <-. toList usrs]

-- reset supervisors given employees of a company to default company supervision, deleting all other supervisors
resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
resetSupervisors cid employees = do
  nr_del <- deleteSupervisors employees
  nr_add <- addDefaultSupervisors cid employees
  return $ max nr_del nr_add

-- adds the default company supervisors as supervisor to a given set of users, which themselves may belong to any company
addDefaultSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
addDefaultSupervisors cid employees = do 
  E.insertSelectWithConflictCount UniqueUserSupervisor
    (do 
      (spr :& usr) <- E.from $ E.table @UserCompany `E.crossJoin` E.toValues employees
      E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid
          E.&&.  spr E.^. UserCompanySupervisor
      return $ UserSupervisor
        E.<#  (spr E.^. UserCompanyUser)
        E.<&>  usr
        E.<&> (spr E.^. UserCompanySupervisorReroute)
    )
    (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications])

-- like `addDefaultSupervisors`, but selects all employees of given companies from database
addDefaultSupervisorsAll ::  (CompanyId ~ Element mono, MonoFoldable mono) => Bool -> mono -> DB Int64
addDefaultSupervisorsAll mutualSupervision cids = do 
  E.insertSelectWithConflictCount UniqueUserSupervisor
    (do 
      (spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
      E.where_ $ E.and $ guardMonoid (not mutualSupervision) 
                            [ E.not_ $ usr E.^. UserCompanySupervisor ] 
                        <>  [          spr E.^. UserCompanySupervisor
                            , spr E.^. UserCompanyCompany `E.in_` E.vals cids
                            , usr E.^. UserCompanyCompany `E.in_` E.vals cids
                            ]
      return $ UserSupervisor
        E.<#  (spr E.^. UserCompanyUser)
        E.<&> (usr E.^. UserCompanyUser)
        E.<&> (spr E.^. UserCompanySupervisorReroute)
    )
    (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications] )


------------------------------
-- repeatedly useful queries

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

firmHasSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool)
firmHasSupervisors  = E.exists . fromUserCompany (Just (E.^. UserCompanySupervisor))


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

firmHasDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool)
firmHasDefaultReroutes = E.exists . 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

firmQuerySupervisedBy :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlQuery ()
firmQuerySupervisedBy cid mbFltr usr = do
    (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor
                      `E.innerJoin` E.table @UserCompany
                      `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
    let basecond = usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
            E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
    E.where_ $ maybe basecond ((basecond E.&&.).($ usrSpr)) mbFltr

firmCountForSupervisor :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlExpr (E.Value Word64)
firmCountForSupervisor = ((E.subSelectCount .) .) . firmQuerySupervisedBy

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


------------------
-- Debug Handler

getFirmR,  postFirmR :: CompanyShorthand -> Handler Html
getFirmR = postFirmR
postFirmR fsh = do
  let cid = CompanyKey fsh
  cusers <- runDB $ do
    cusers <- selectList [UserCompanyCompany ==. cid] []
    selectList [UserId <-. fmap (userCompanyUser . entityVal) cusers] [Asc UserDisplayName]
  csuper <- runDB $ do
    csuper <- selectList [UserCompanyCompany ==. cid, 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 /= cid
                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 
                          { firmAllActResetKeepOldSupers      :: Maybe Bool 
                          , firmAllActResetMutualSupervision  :: Maybe Bool
                          }
  deriving (Eq, Ord, 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 Bool, E.Value Bool)
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 Bool
resultAllCompanySupervisors       = _dbrOutput . _3 . _unValue

resultAllCompanyDefaultReroutes   :: Lens' AllCompanyTableData Bool
resultAllCompanyDefaultReroutes   = _dbrOutput . _4 . _unValue


mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, 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 E.&&. usrCmpy E.^. UserCompanySupervisor)
                 E.||. E.exists (do 
                  usrSpr <- E.from $  E.table @UserSupervisor
                  E.where_ $ usrSpr E.^. UserSupervisorUser       E.==. usrCmpy E.^. UserCompanyUser
                      E.&&.  usrSpr E.^. UserSupervisorSupervisor E.==. E.val uid
                ))
          return  ( cmpy                                        --  1
                  , cmpy & firmCountUsers                       --  2
                  , cmpy & firmHasSupervisors                   --  3
                  , cmpy & firmHasDefaultReroutes               --  4
                  -- , cmpy & firmCountEmployeeSupervised          --  4
                  -- , cmpy & firmCountEmployeeRerouted            --  5
                  -- , cmpy & firmCountEmployeeRerPost             --  6
                  -- , cmpy & firmCountForeignSupervisors          --  7
                  -- , 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) $ toWgt $ hasTickmark $ row ^. resultAllCompanySupervisors
          , sortable (Just "reroute-def")   (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes     -> ok) -> tickmarkCell ok
          -- , 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 firmHasSupervisors
          -- , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised
          -- , singletonMap "emp-rerouted"   $ SortColumn firmCountEmployeeRerouted
          -- , singletonMap "emp-rer-post"   $ SortColumn firmCountEmployeeRerPost
          , singletonMap "reroute-def"    $ SortColumn firmHasDefaultReroutes
          -- , singletonMap "foreigners"     $ SortColumn firmCountForeignSupervisors
          -- , singletonMap "reroute-act"    $ SortColumn firmCountActiveReroutes
          -- , singletonMap "reroute-all"    $ SortColumn firmCountActiveReroutes'
          ]
        dbtFilter = mconcat
          [ single $ fltrCompanyNameNr queryAllCompany
          , single ("company-number", FilterColumn $ E.mkExactFilterWithComma readMay (queryAllCompany >>> (E.^. CompanyAvsId)))
          , 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)
                )
            )
          , single ("foreign-supervisor", FilterColumn $ \row (getLast -> criterion) -> 
              -- let checkSuper = do -- expensive
              --       usrSpr <- E.from $ E.table @UserSupervisor
              --       E.where_ $ E.notExists (do
              --           spr <- E.from $  E.table @UserCompany
              --           E.where_ $ spr E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
              --             E.&&.    spr E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorSupervisor
              --         ) E.&&. E.exists (do
              --           usr <- E.from $  E.table @UserCompany
              --           E.where_ $ usr E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
              --             E.&&.    usr E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorUser
              --         )
              let checkSuper = do
                    usr <- E.from $ E.table @UserCompany
                    E.where_ $ usr E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
                        E.&&. E.exists (do
                          usrSpr <- E.from $ E.table @UserSupervisor
                          E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usr E.^. UserCompanyUser
                              E.&&. E.notExists (do
                                sprCmp <- E.from $ E.table @UserCompany
                                E.where_ $ sprCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
                                    E.&&.  sprCmp E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorSupervisor
                              )
                        )
              in case criterion of
                Nothing    -> E.true
                Just True  -> E.exists    checkSuper
                Just False -> E.notExists checkSuper
            )
          , single ("company-postal", FilterColumn $ E.mkExactFilterLast $ views (to queryAllCompany) (E.isJust . (E.^. CompanyPostAddress)))
          ]
        dbtFilterUI mPrev = mconcat        
          [ fltrCompanyNameUI mPrev
          , prismAForm (singletonFilter "company-number")                             mPrev $ aopt textField (fslI MsgTableCompanyNo)
          , prismAForm (singletonFilter "is-supervisor")                              mPrev $ aopt textField (fslI MsgTableSupervisor)
          , prismAForm (singletonFilter "foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterForeignSupervisor)
          , prismAForm (singletonFilter "company-postal"     . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern)
          ]
        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
        acts :: Map FirmAction (AForm Handler FirmActionData)
        acts = mconcat
          [ singletonMap FirmActNotify           $ pure FirmActNotifyData
          , singletonMap FirmActResetSupervision $      FirmActResetSupervisionData
              <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)         (Just $ Just False)
              <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
          ]

        dbtParams = DBParamsForm
          { dbParamsFormMethod = POST
          , dbParamsFormAction = Nothing
          , dbParamsFormAttrs  = []
          , dbParamsFormSubmit = FormSubmit
          -- , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm [FirmActNotify, FirmActResetSupervision]
          -- , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just 
          --     <$> multiActionA (firmActionMap [FirmActNotify, FirmActResetSupervision]) (fslI MsgTableAction) Nothing
          , 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 FirmActionData, DBFormResult CompanyId Bool AllCompanyTableData)
                -> FormResult (      FirmActionData, 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 FirmActionData, DBFormResult CompanyId Bool FirmActionData))
    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
  -- firmActionHandler FirmAllR firmRes
  formResult firmRes $ \case    
    (_, fids) | null fids -> addMessageI Error MsgNoCompanySelected

    (FirmActResetSupervisionData{..}, fids) -> do
      runDB $ do
        delSupers <- if firmActResetKeepOldSupers == Just False
          then E.deleteCount $ do
                spr <- E.from $ E.table @UserSupervisor
                E.where_ $ E.exists $ do
                  usr <- E.from $ E.table @UserCompany
                  E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
                      E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser 
          else return 0 
        newSupers <- addDefaultSupervisorsAll (firmActResetMutualSupervision /= Just False) fids         
        addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
      reloadKeepGetParams FirmAllR -- reload to reflect changes

    (FirmActNotifyData          , Set.toList -> fids) -> do
      usrs <- runDB $ E.select $ E.distinct $ do
        (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
        E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids
        return $ usr E.^. UserId
      cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
      redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])

  siteLayoutMsg MsgMenuFirms $ do
    setTitleI MsgMenuFirms
    $(i18nWidgetFile "firm-all")


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

data FirmUserChangeRequest = FirmUserChangeRequest
      { fucrPostalPref :: Maybe Bool 
      , fucrPostalAddr :: Maybe StoredMarkup
      }
  deriving (Eq, Ord, Show, Generic)

instance Default FirmUserChangeRequest where
  def = FirmUserChangeRequest
          { fucrPostalPref = Nothing
          , fucrPostalAddr = Nothing
          }

makeFirmUserChangeRequestForm :: Maybe FirmUserChangeRequest -> Form FirmUserChangeRequest
makeFirmUserChangeRequestForm template html = do 
  flip (renderAForm FormStandard) html $ FirmUserChangeRequest
    <$> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip)  (fucrPostalPref <$> template)
    <*> aopt htmlField        (fslI MsgPostAddress   & setTooltip MsgPostAddressTip) (fucrPostalAddr <$> template)
    

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

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

data FirmUserActionData = FirmUserActNotifyData
                        | FirmUserActResetSupervisionData
                            { firmUserActResetKeepOldSupers     :: Maybe Bool 
                            -- , firmUserActResetMutualSupervision :: Maybe Bool
                            }
                        | FirmUserActMkSuperData
                            { firmUserActMkSuperReroute   :: Maybe Bool }

  deriving (Eq, Ord, 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


mkFirmUserTable :: Bool -> CompanyId -> DB (FormResult (FirmUserActionData, Set UserId), Widget)
mkFirmUserTable isAdmin cid = do
  let
    mkSprOption (E.Value uid, E.Value udn) = do
      uuid <- toPathPiece <$> encryptUser uid
      return Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }
    procOptions = fmap mkOptionList . traverse mkSprOption

  rawSupers <- E.select $ do 
    usr <- E.from $ E.table @User
    E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
    return (usr E.^. UserId, usr E.^. UserDisplayName)
  let
    -- supervisorField :: Field Handler UserId
    supervisorField  =      selectField $ procOptions rawSupers
    supervisorsField = multiSelectField $ procOptions rawSupers

    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
          , sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultUserUser -> entUsr) -> cellEditUserModal entUsr
          ]
        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
          , singletonMap "has-foreign-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.notExists (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
          , singletonMap "supervisor-is" $ FilterColumn $ \row (getLast -> criterion) ->
              case criterion of 
                Just uid -> do 
                  -- uid <- decryptUser uuid
                  E.exists $ do 
                    usrSpr <- E.from $ E.table @UserSupervisor
                    E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
                        E.&&.  usrSpr E.^. UserSupervisorSupervisor E.==. E.val uid
                _otherwise -> E.true
          , singletonMap "supervisors-are" $ FilterColumn $ \row criteria ->
              case criteria of 
                _ | Set.null criteria -> E.true
                  | otherwise -> do
                      -- uids <- traverse decryptUser criteria
                      E.exists $ do 
                        usrSpr <- E.from $ E.table @UserSupervisor
                        E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
                            E.&&.  usrSpr E.^. UserSupervisorSupervisor `E.in_` E.vals criteria
          ]
        -- superField = selectField $ ????
        dbtFilterUI mPrev = mconcat
          [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
          , prismAForm (singletonFilter "supervisor-is"          . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField)  (fslI MsgFilterSupervisor)
          , prismAForm (multiFilter     "supervisors-are"        . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor)
          , 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)
          , prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh)
          ]
        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
        acts :: Map FirmUserAction (AForm Handler FirmUserActionData)
        acts = mconcat
          [ singletonMap FirmUserActNotify      $ pure FirmUserActNotifyData
          , singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData
              <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)         (Just $ Just False)
              -- <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
          , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
              <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
          ]
        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 FirmActionData, DBFormResult CompanyId Bool FirmActionData))
    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 cid = CompanyKey fsh
  ((    Entity{entityVal=Company{..}}
      , E.Value nrCompanyUsers
      , E.Value nrCompanySupervisors
      , E.Value nrCompanyForeignSupers
      , E.Value nrCompanyEmployeeSupervised
      , E.Value nrCompanyEmployeeRerouted
      , E.Value nrCompanyEmployeeRerPost
      , E.Value nrCompanyDefaultReroutes
      , E.Value nrCompanyActiveReroutes
   )  , (fusrRes, fusrTable)) <- runDB $ (,) 
      <$> fromMaybeM notFound (E.selectOne $ do
          cmpy <- E.from $ E.table @Company
          E.where_ $ cmpy E.^. CompanyId E.==. E.val cid
          return  ( cmpy
                  , cmpy & firmCountUsers
                  , cmpy & firmCountSupervisors
                  , cmpy & firmCountForeignSupervisors
                  , cmpy & firmCountEmployeeSupervised
                  , cmpy & firmCountEmployeeRerouted
                  , cmpy & firmCountEmployeeRerPost
                  , cmpy & firmCountDefaultReroutes
                  , cmpy & firmCountActiveReroutes
                  ))
      -- superVs <- E.select $ do 
      --     usr <- E.from $ E.table @User
      --     E.where_ $ E.exists $ firmQuerySupervisedBy cmpyId Nothing usr
      --     return usr
      <*> mkFirmUserTable isAdmin cid      

  formResult fusrRes $ \case    
    (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
    (FirmUserActMkSuperData{..}, Set.toList -> uids) -> do 
      nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)]
      addMessageI Info $ MsgASReqSetSupers nrMkSuper Nothing
      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
    (FirmUserActNotifyData , uids) -> do
      cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
      redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
    (FirmUserActResetSupervisionData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do  -- set guaranteed to be non-empty due to first case clause
      runDB $ do
        delSupers <- if firmUserActResetKeepOldSupers == Just False
          then deleteSupervisors uids
          else return 0 
        newSupers <- addDefaultSupervisors cid uids
        addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
  
  ((fucrRes, fucrWgt), fucrEnctype) <- runFormPost . identifyForm FIDFirmUserChangeRequest $ makeFirmUserChangeRequestForm (Just def)
  let addFormAnchor = "firm-user-change-form" :: Text
      routeForm = FirmUsersR fsh :#: addFormAnchor
      fucrForm = wrapForm fucrWgt FormSettings  
                        { formMethod = POST
                        , formAction = Just . SomeRoute $ routeForm
                        , formEncoding = fucrEnctype
                        , formAttrs = []
                        , formSubmit = FormSubmit
                        , formAnchor = Just addFormAnchor
                        }
  formResult fucrRes $ \FirmUserChangeRequest{fucrPostalPref=fucrPPref, fucrPostalAddr=fucrPAddr} -> do
    -- let fucrPAddr = canonical fucrPAddr' TODO
    when (isJust fucrPPref || isJust fucrPAddr) $ do
      let changes = foldMap (\pp -> [UserPrefersPostal E.=. E.val pp])     fucrPPref <>
                    foldMap (\pa -> [UserPostAddress   E.=. E.justVal pa]) fucrPAddr      -- seems weird, but: Nothing means no change, and not delete address!
      nrChanged <- runDB $ E.updateCount $ \usr -> do
          E.set usr changes 
          E.where_ $ E.exists $ do
            usrCmpy <- E.from $ E.table @UserCompany
            E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
                E.&&.  usrCmpy E.^. UserCompanyUser    E.==. usr E.^. UserId
      addMessageI Info $ MsgFirmUserChanges nrChanged
      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes

  siteLayout (citext2widget companyName) $ do
    setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId
    let firmContactInfo = $(widgetFile "firm-contact-info")
    $(widgetFile "firm-users")


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

data FirmSuperAction = FirmSuperActNotify 
                     | FirmSuperActRMSuperDef
                     
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

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

data FirmSuperActionData = FirmSuperActNotifyData
                         | FirmSuperActRMSuperDefData
                            { firmSuperActRMSuperActive :: Maybe Bool }
                         
  deriving (Eq, Ord, Show, Generic)


data AddSupervisorRequest = AddSupervisorRequest
  {  asReqSupers  :: Set Text
  ,  asReqReroute :: Bool
  ,  asReqPostal  :: Maybe Bool
  } deriving (Eq, Ord, Show, Generic)

instance Default AddSupervisorRequest where 
  def = AddSupervisorRequest 
          { asReqSupers   = mempty
          , asReqReroute  = True
          , asReqPostal   = Nothing
          }

makeAddSupervisorForm :: Maybe AddSupervisorRequest -> Form AddSupervisorRequest
makeAddSupervisorForm template html = do   
  flip (renderAForm FormStandard) html $ AddSupervisorRequest
    <$> areq (textField & cfAnySeparatedSet) 
                              (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) (asReqSupers <$> template)
    <*> areq checkBoxField    (fslI MsgTableIsDefaultReroute )                      (asReqReroute <$> template)
    <*> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip)  (asReqPostal <$> template)


type SuperCompanyTableExpr = E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserCompany))

querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User)
querySuperUser = $(sqlLOJproj 2 1)

querySuperUserCompany :: SuperCompanyTableExpr -> E.SqlExpr (Maybe (Entity UserCompany))
querySuperUserCompany = $(sqlLOJproj 2 2)

type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64
                                    , [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
                                    , E.Value (Maybe Bool), E.Value (Maybe Bool)   -- Maybe (Entity UserCompany)
                                    )

resultSuperUser :: Lens' SuperCompanyTableData (Entity User)
resultSuperUser = _dbrOutput . _1 

resultSuperCompanySupervised :: Lens' SuperCompanyTableData Word64
resultSuperCompanySupervised = _dbrOutput . _2 . _unValue

resultSuperCompanyReroutes :: Lens' SuperCompanyTableData Word64
resultSuperCompanyReroutes = _dbrOutput . _3 . _unValue

resultSuperCompanies :: Lens' SuperCompanyTableData [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
resultSuperCompanies = _dbrOutput . _4

resultSuperCompanyDefaultSuper :: Lens' SuperCompanyTableData (Maybe Bool)
resultSuperCompanyDefaultSuper = _dbrOutput . _5 . _unValue

resultSuperCompanyDefaultReroute :: Lens' SuperCompanyTableData (Maybe Bool)
resultSuperCompanyDefaultReroute = _dbrOutput . _6 . _unValue

instance HasEntity SuperCompanyTableData User where 
  hasEntity = resultSuperUser

instance HasUser SuperCompanyTableData where 
  hasUser = resultSuperUser . _entityVal


mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Set UserId), Widget)
mkFirmSuperTable isAdmin cid = do
  let
    -- fsh = unCompanyKey cid
    resultDBTable = DBTable{..}
      where
        dbtSQLQuery = \(usr `E.LeftOuterJoin` usrCmp) -> do
          EL.on $ usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.?=. E.val cid
          E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor)
              E.||.  E.exists (firmQuerySupervisedBy cid Nothing usr)
          return ( usr
                 , usr & firmCountForSupervisor cid Nothing
                 , usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
                 , usrCmp E.?. UserCompanySupervisor
                 , usrCmp E.?. UserCompanySupervisorReroute
                 )
        dbtRowKey = querySuperUser >>> (E.^. UserId)
        dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute) -> do
            cmps <- E.select $ 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.==. E.val (entityKey usr)
              E.orderBy [E.asc $ cmp E.^. CompanyName]
              return (cmp E.^. CompanyName, cmp E.^. CompanyShorthand, usrCmp E.^. UserCompanySupervisor)
            return (usr, supervised, rerouted, cmps, supervisor, reroute)
        dbtColonnade = formColonnade $ mconcat
          [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey))
          , colUserNameModalHdr MsgTableSupervisor ForProfileDataR
          , sortable (Just "matriculation")   (i18nCell MsgTableMatrikelNr)              $ \(view   resultSuperUser                         -> entUsr) -> cellHasMatrikelnummerLinked entUsr
          , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultSuperCompanies -> cmps) ->
              intercalate semicolonCell [companyCell cmpShort cmpName isSuper | (E.Value cmpName, E.Value cmpShort, E.Value isSuper) <- cmps]
          , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber)        $ \(view $ resultSuperUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t
          , sortable (Just "postal-pref")     (i18nCell MsgPrefersPostal)                $ \(view $ resultSuperUser . _userPrefersPostal         -> b) -> iconFixedCell $ iconLetterOrEmail b
          , colUserEmail
          , sortable (Just "supervised")  (i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "rerouted")    (i18nCell MsgTableCompanyNrEmpRerouted  )  $ \(view resultSuperCompanyReroutes   -> nr) -> wgtCell $ word2widget nr
          , sortable (Just "def-super")   (i18nCell MsgTableIsDefaultSupervisor) $ \(view resultSuperCompanyDefaultSuper   -> mb) -> case mb of { Nothing -> iconCell IconSupervisorForeign; Just True -> iconCell IconSupervisor; Just False -> iconSpacerCell }
          , sortable (Just "def-reroute") (i18nCell MsgTableIsDefaultReroute)    $ \(view resultSuperCompanyDefaultReroute -> mb) -> tickmarkCell (mb == Just True)
          , sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultSuperUser -> entUsr) -> cellEditUserModal entUsr
          ]
        dbtSorting = mconcat
          [ single $ sortUserNameLink querySuperUser
          , single $ sortUserEmail    querySuperUser          
          , singletonMap "matriculation"    $ SortColumn $ querySuperUser        >>> (E.^. UserMatrikelnummer)
          , singletonMap "personal-number"  $ SortColumn $ querySuperUser        >>> (E.^. UserCompanyPersonalNumber)
          , singletonMap "postal-pref"      $ SortColumn $ querySuperUser        >>> (E.^. UserPrefersPostal)
          , singletonMap "supervised"       $ SortColumn $ querySuperUser        >>> firmCountForSupervisor cid Nothing
          , singletonMap "rerouted"         $ SortColumn $ querySuperUser        >>> firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
          , singletonMap "user-company"     $ 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.==. querySuperUser row E.^. UserId
              E.orderBy [E.asc $ cmp E.^. CompanyName]
              return (cmp E.^. CompanyName)
            )
          , singletonMap "def-super"      $ SortColumn $ querySuperUserCompany >>> (E.?. UserCompanySupervisor)
          , singletonMap "def-reroute"    $ SortColumn $ querySuperUserCompany >>> (E.?. UserCompanySupervisorReroute)
          ]
        dbtFilter = mconcat
          [ single $ fltrUserNameEmail querySuperUser
          ]
        dbtFilterUI mPrev = mconcat
          [ fltrUserNameEmailHdrUI MsgTableSupervisor mPrev
          ]
        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
        acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData)
        acts = mconcat
          [ singletonMap FirmSuperActNotify     $ pure FirmSuperActNotifyData
          , singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData 
              <$> aopt checkBoxField (fslI MsgFirmSuperActRMSuperActive) (Just $ Just True)
          ]
        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-supervisors"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []

    postprocess :: FormResult (First FirmSuperActionData, DBFormResult UserId Bool SuperCompanyTableData)
                -> FormResult (      FirmSuperActionData, 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 = def
      & defaultSorting  [SortAscBy "user-name"]
  over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable


getFirmSupersR, postFirmSupersR :: CompanyShorthand ->  Handler Html
getFirmSupersR = postFirmSupersR
postFirmSupersR fsh = do
  isAdmin <- hasReadAccessTo AdminR
  let cid = CompanyKey fsh
  (Company{..},(fsprRes,fsprTable)) <- runDB $ (,)
    <$> get404 cid
    <*> mkFirmSuperTable isAdmin cid

  formResult fsprRes $ \case
    (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
    (FirmSuperActRMSuperDefData{..}, Set.toList -> uids) -> do 
      (nrRmSuper,nrRmActual) <- runDB $ (,)
        <$> updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False]
        <*> if firmSuperActRMSuperActive /= Just True
              then return 0
              else E.deleteCount $ do
                spr <- E.from $ E.table @UserSupervisor
                E.where_ $ spr E.^. UserSupervisorSupervisor `E.in_` E.vals uids
                    E.&&. E.exists (do
                      usr <- E.from $ E.table @UserCompany
                      E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
                          E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser 
                    ) 
      addMessageI Info $ MsgRemoveSupervisors nrRmSuper nrRmActual
      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
    
    (FirmSuperActNotifyData    , uids) -> do 
      cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
      redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])

  formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) [FirmActNotify, FirmActResetSupervision] -- TODO ,FirmActAddSupervisors]

  ((asReqRes, asReqWgt), asReqEnctype) <- runFormPost . identifyForm FIDAddSupervisor $ makeAddSupervisorForm (Just def)
  let addSuperAnchor = "add-supervisors-form" :: Text
      routeAddSuperForm = FirmSupersR fsh :#: addSuperAnchor
      addSuperForm = wrapForm asReqWgt FormSettings  
                        { formMethod = POST
                        , formAction = Just . SomeRoute $ routeAddSuperForm
                        , formEncoding = asReqEnctype
                        , formAttrs = []
                        , formSubmit = FormSubmit
                        , formAnchor = Just addSuperAnchor
                        }
  formResult asReqRes $ \AddSupervisorRequest{..} -> do
    avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser asReqSupers
    let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
        usersFound = mapMaybe snd usersFound'
    unless (null usersNotFound) $
      let msgContent = [whamlet|
            $newline never
            <ul>
              $forall (usr,_) <- usersNotFound
                <li>#{usr}
            |]
       in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
    when (null usersFound) $ do
      addMessageI Warning MsgASReqEmpty
      redirect routeAddSuperForm
    runDB $ do
      putMany [UserCompany uid cid True asReqReroute | uid <- usersFound]
      whenIsJust asReqPostal $ \prefPostal ->
        updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
      addMessageI Info $ MsgASReqSetSupers (fromIntegral $ length usersFound) asReqPostal
    redirect $ FirmSupersR fsh

  siteLayout (citext2widget fsh) $ do
    setTitle $ citext2Html $ fsh <> " Supers"
    let firmContactInfo = $(widgetFile "firm-contact-info")
    $(i18nWidgetFile "firm-supervisors")


------------------------
-- Firm Communications


getFirmCommR,  postFirmCommR :: CompanyShorthand -> Handler Html
getFirmCommR = postFirmCommR
postFirmCommR fsh = handleFirmCommR (SomeRoute $ FirmUsersR fsh) [fsh]


getFirmsCommR,  postFirmsCommR :: Companies -> Handler Html
getFirmsCommR = postFirmsCommR
postFirmsCommR = handleFirmCommR (SomeRoute FirmAllR)


handleFirmCommR :: SomeRoute UniWorX -> Companies -> Handler Html
handleFirmCommR _       [] = invalidArgs ["At least one company name must be provided."]
handleFirmCommR ultDest cs = do
  let 
    queryGiven :: [UserId] -> E.SqlQuery (E.SqlExpr (Entity User)) -- get users from a list of UserIds
    queryGiven usrs = do      
      usr <- E.from $ E.table @User
      E.where_ $ usr E.^. UserId `E.in_` E.valList usrs
      return usr
    mkCompanyUsrList :: [(E.Value (Maybe CompanyId), E.Value UserId)] -> Map.Map (Maybe CompanyId) [UserId]
    mkCompanyUsrList l = Map.fromAscListWith (++) [(c,[u]) | (E.Value c, E.Value u) <- l]
    toGrp  = maybe RGFirmIndependent (RGFirmSupervisor . unCompanyKey)
    csKeys = CompanyKey <$> cs
  mbUser <- maybeAuthId
  -- get employees of chosen companies
  empys <- mkCompanyUsrList <$> runDB (E.select $ do 
      (emp :& cmp) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& cmp) -> emp E.^. UserId E.==. cmp E.^. UserCompanyUser)
      E.where_ $ cmp E.^. UserCompanyCompany `E.in_` E.valList csKeys          
      E.orderBy [E.ascNullsFirst $ cmp E.^. UserCompanyCompany]
      return (E.just $ cmp E.^. UserCompanyCompany, emp E.^. UserId)
    )
  -- get supervisors of employees  
  sprs <- mkCompanyUsrList <$> runDB (E.select $ do   
      (spr :& cmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany `E.on` (\(spr :& cmp) -> spr E.^. UserId E.=?. cmp E.?. UserCompanyUser)
      E.where_ $ (E.isTrue (cmp E.?. UserCompanySupervisor) E.&&. cmp E.?. UserCompanyCompany `E.in_` E.justValList csKeys)
        E.||. (spr E.^. UserId E.=?. E.val mbUser)
        E.||. E.exists (do
          usrSpr <- E.from $ E.table @UserSupervisor
          E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. spr E.^. UserId
              E.&&.  usrSpr E.^. UserSupervisorUser `E.in_` E.valList (concat $ Map.elems empys)
        )
      E.orderBy [E.ascNullsFirst $ cmp E.?. UserCompanyCompany]
      return (cmp E.?. UserCompanyCompany, spr E.^. UserId)
    )  
    
  commR CommunicationRoute
    { crHeading   = SomeMessage $ case cs of { [c] -> MsgFirmNotification      c ; _ -> MsgFirmsNotification }
    , crTitle     = SomeMessage $ case cs of { [c] -> MsgFirmNotificationTitle c ; _ -> MsgFirmsNotificationTitle }
    , crUltDest   = ultDest
    , crJobs      = crJobsFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()    
    , crTestJobs  = crTestFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()    
    , crRecipientAuth = Nothing -- :: Maybe (UserId -> DB AuthResult) -- an optional filter passed to guardAuthResult 
    , crRecipients = -- :: [(RecipientGroup, SqlQuery (SqlExpr (Entity User)))]      
      [(toGrp acid, queryGiven usrs) | (acid, usrs)  <- Map.toAscList sprs ] ++
      [(RGFirmEmployees $ unCompanyKey acid, queryGiven usrs)  | (Just acid, usrs) <- Map.toAscList empys ]
    }

  {- Auswahlbox für Mitteilung:
    Wenn Firma gewählt, dann zeige:
      Alle Supervisor von Leuten in X, gruppiert nach deren Firma 
      Alle Teilnehmer von X 
    Wenn keine Firma gewählt, dann zeige:
      Alle Supervisor von gewählten Leuten, gruppiert nach deren Firma
      Alle gewählten Personen, gruppiert nach deren Firma
  -}