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

{-# OPTIONS -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
{-# LANGUAGE TypeApplications #-}

module Handler.Firm
  ( getFirmAllR   , postFirmAllR
  , 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.Persist.Postgresql
import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Legacy as EL (on)
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
                | FirmActAddSupersvisors
                | FirmActChangeContactFirm
                | FirmActChangeContactUser
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

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

data FirmActionData = FirmActNotifyData
                    | FirmActResetSupervisionData
                        { firmActResetKeepOldSupers       :: Maybe Bool
                        , firmActResetMutualSupervision   :: Maybe Bool
                        }
                    | FirmActAddSupersvisorsData
                        { firmActAddSupervisorIds         :: Set Text
                        , firmActAddSupervisorReroute     :: Bool
                        , firmActAddSupervisorPostal      :: Maybe Bool
                        }
                    | FirmActChangeContactFirmData
                        { firmActCCFPostalAddr            :: Maybe StoredMarkup
                        , firmActCCFEmail                 :: Maybe UserEmail
                        , firmActCCFPostalPref            :: Maybe Bool
                        }
                    | FirmActChangeContactUserData
                        { firmActCCUPostalAddr            :: Maybe StoredMarkup
                        , firmActCCUPostalPref            :: Maybe Bool
                        }
  deriving (Eq, Ord, Read, Show, Generic)

firmActionMap :: (_ -> Text) -> Bool -> [FirmAction] -> Map FirmAction (AForm Handler FirmActionData)
firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts)
  where
    mkAct True  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 _     FirmActAddSupersvisors   = singletonMap FirmActAddSupersvisors   $ FirmActAddSupersvisorsData
                  <$> areq (textField & cfAnySeparatedSet)  (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip)  Nothing
                  <*> areq checkBoxField                    (fslI MsgTableIsDefaultReroute)                                                             (Just True)
                  <*> aopt postalEmailField                 (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip)                                Nothing
    mkAct _     FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData
                  <$> aopt htmlField                        (fslI MsgPostAddress      & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
                  <*> aopt (emailField & cfStrip & cfCI)    (fslI MsgUserDisplayEmail & setTooltip MsgUtilEmptyNoChangeTip) Nothing
                  <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip)   Nothing
                  <*  aformMessage (Message Info (toHtml $ mr MsgFirmActChangeContactFirmInfo) (Just IconNotificationNonactive))
    mkAct _     FirmActChangeContactUser = singletonMap FirmActChangeContactUser $ FirmActChangeContactUserData
                  <$> aopt htmlField                        (fslI MsgPostAddress      & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
                  <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip) Nothing
    mkAct _  _ = mempty

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

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

firmActionHandler :: Route UniWorX -> Bool -> FormResult (FirmActionData, Set CompanyId) -> Handler ()
firmActionHandler route isAdmin = flip formResult faHandler
  where
    faHandler (_,fids) | null fids = addMessageI Error MsgNoCompanySelected

    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 (FirmActResetSupervisionData{..}, fids) = do
      madId <- bool maybeAuthId (return Nothing) isAdmin
      let suprFltr = if
            | isAdmin                 -> const E.true
            | (Just suprId) <- madId  -> \spr -> spr E.^. UserSupervisorSupervisor E.==. E.val suprId
            | otherwise               -> const E.false
      runDB $ do
        delSupers <- if firmActResetKeepOldSupers == Just False
          then E.deleteCount $ do
                spr <- E.from $ E.table @UserSupervisor
                E.where_ $ suprFltr spr E.&&. 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 <- addDefaultSupervisorsFor madId (firmActResetMutualSupervision /= Just False) fids
        addMessageI Success $ MsgFirmResetSupervision delSupers newSupers
      reloadKeepGetParams route -- reload to reflect changes

    faHandler (FirmActAddSupersvisorsData{..}, 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 MsgFirmActAddSupersEmpty
        reloadKeepGetParams route
      runDB $ do
        -- putMany [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] -- putMany always overwrites existing records, which would destroy priority and useCompanyAddress here
        -- upsertManyWhere [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] [copyField UserCompanySupervisor, copyField UserCompanySupervisorReroute] [] [] -- overwrite Supervisor and SupervisorReroute, keep priority and useCompanyAddress
        upsertManyWhere [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] [] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. firmActAddSupervisorReroute] [] -- identical to previous line, but perhaps more clear?
        whenIsJust firmActAddSupervisorPostal $ \prefPostal ->
          updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
        addMessageI Success $ MsgFirmActAddSupersSet (fromIntegral $ length usersFound) firmActAddSupervisorPostal
      redirect route

    faHandler (FirmActChangeContactFirmData{..}, Set.toList -> [cid]) =
      let changes = catMaybes
            [ (CompanyPostAddress   =.) . Just <$> canonical firmActCCFPostalAddr
            , (CompanyEmail         =.) . Just <$> canonical firmActCCFEmail
            , (CompanyPrefersPostal =.)        <$>           firmActCCFPostalPref
            ]
      in unless (null changes) $ do
        runDB $ update cid changes
        addMessageI Success MsgFirmActChangeContactFirmResult
        reloadKeepGetParams route

    faHandler (FirmActChangeContactUserData{..}, Set.toList -> [cid]) =
      let changes = catMaybes
            [ (UserPostAddress   E.=.) . E.justVal <$> canonical firmActCCUPostalAddr  -- note that Nothing means no change and not delete address!
            , (UserPrefersPostal E.=.) . E.val     <$>           firmActCCUPostalPref
            ]
      in unless (null changes) $ do
        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 Success $ MsgFirmUserChanges nrChanged
        reloadKeepGetParams route  -- reload to reflect changes

    faHandler _ = addMessageI Error MsgErrorUnknownFormAction


runFirmActionFormPost :: CompanyId -> Route UniWorX -> Bool -> [FirmAction] -> Handler Widget
runFirmActionFormPost cid route isAdmin acts = do
  mr <- getMessageRender
  ((faRes, faWgt), faEnctype) <- runFormPost . identifyForm FIDFirmAction $ makeFirmActionForm cid mr isAdmin 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 isAdmin faRes
  return [whamlet|
          <section>
            <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
              _{MsgFirmAction}
            <div>
              <p>
                _{MsgFirmActionInfo}
              <P>
                ^{faForm}
        |]


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



-- | remove supervisors for given users; maybe restricted to those linked to a given companies
deleteSupervisors :: NonEmpty UserId -> [CompanyId] -> DB Int64
deleteSupervisors usrs cids = deleteWhereCount $ (UserSupervisorUser <-. toList usrs) : restrictByCompany
  where
    restrictByCompany = guardMonoid (notNull cids) [UserSupervisorCompany <-. (Just <$> cids)]      

-- reset supervisors given employees of a company to default company supervision, deleting all previous company-related supervisors
resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
resetSupervisors cid employees = do
  nr_del <- deleteSupervisors employees [cid]
  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
      E.distinct $ return $ UserSupervisor
        E.<#  (spr E.^. UserCompanyUser)
        E.<&>  usr
        E.<&> (spr E.^. UserCompanySupervisorReroute)
        E.<&> E.justVal cid
        E.<&> E.nothing
    )
    (\_old new -> 
      [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
      , UserSupervisorCompany E.=. E.justVal cid      
      -- , UserSupervisorReason  E.=. new E.^. UserSupervisorReason -- keep any existing reason
      ])

-- like `addDefaultSupervisors`, but selects all employees of given companies from database, optionally filtered by being under supervision of a given individual
addDefaultSupervisorsFor ::  (CompanyId ~ Element mono, MonoFoldable mono) => Maybe UserId -> Bool -> mono -> DB Int64
addDefaultSupervisorsFor mbSuperId 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 ]
                        <>  maybeEmpty mbSuperId (\sprId -> [E.exists $ do
                              superv <- E.from $ E.table @UserSupervisor
                              E.where_ $ superv E.^. UserSupervisorSupervisor E.==. E.val sprId
                                  E.&&.  superv E.^. UserSupervisorUser       E.==. usr E.^. UserCompanyUser
                            ])
                        <>  [          spr E.^. UserCompanySupervisor
                            , spr E.^. UserCompanyCompany `E.in_` E.vals cids
                            , usr E.^. UserCompanyCompany `E.in_` E.vals cids
                            ]
      E.distinct $ return $ UserSupervisor
        E.<#  (spr E.^. UserCompanyUser)
        E.<&> (usr E.^. UserCompanyUser)
        E.<&> (spr E.^. UserCompanySupervisorReroute)
        E.<&> E.just (spr E.^. UserCompanyCompany)
        E.<&> E.nothing
    )
    (\_old new -> 
        [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
        , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
        -- , UserSupervisorReason  E.=. new E.^. UserSupervisorReason   -- keep any existing reaon
        ] )

-- 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
                            ]
      E.distinct $ return $ UserSupervisor
        E.<#  (spr E.^. UserCompanyUser)
        E.<&> (usr E.^. UserCompanyUser)
        E.<&> (spr E.^. UserCompanySupervisorReroute)
        E.<&> E.just (spr E.^. UserCompanyCompany)
        E.<&> E.nothing
    )
    (\_old new -> 
        [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
        , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
        -- , UserSupervisorReason  E.=. new E.^. UserSupervisorReason   -- keep any existing reaon
        ] )


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


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

-- 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
  mr <- getMessageRender
  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 = dbtProjFilteredPostId
        dbtColonnade = formColonnade $ mconcat
          [ 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 (FirmSupersR fsh) $ toWgt fsh
          , sortable (Just "avsnr")         (i18nCell MsgTableCompanyNo)               $ \(view resultAllCompany -> firm) -> numCell $ 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-associate" , 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)
                )
            )
          -- THIS WAS WAY TOO SLOW:
          -- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do  --  too slow
          --     (usr :& usrCmp) <- E.from $ E.table @User
          --       `E.leftJoin` E.table @UserCompany
          --       `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser)
          --     E.where_ $ ((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)
          --       ) E.&&. ((E.isTrue (usrCmp E.?. UserCompanySupervisor) E.&&. usrCmp E.?. UserCompanyCompany E.?=. queryAllCompany row E.^. CompanyId)
          --           E.||. E.exists (do
          --               usrSpr <- E.from $ E.table @UserSupervisor
          --               E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
          --                 E.&&. E.exists (do
          --                     usrSub <- E.from $ E.table @UserCompany
          --                     E.where_ $ usrSub E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorUser
          --                         E.&&.  usrSub E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
          --                   )
          --             )
          --       )
          --   )
          -- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do  --  too slow
          --     usr <- E.from $ E.table @User
          --     E.where_ $ ((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)
          --       ) E.&&. (E.exists (do
          --             usrCmp <- E.from $ E.table @UserCompany
          --             E.where_ $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
          --               E.&&. usrCmp E.^. UserCompanySupervisor
          --               E.&&. usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
          --           ) E.||. E.exists (do
          --             usrSpr <- E.from $ E.table @UserSupervisor
          --             E.where_ $ usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
          --               E.&&. E.exists (do
          --                   usrSub <- E.from $ E.table @UserCompany
          --                   E.where_ $ usrSub E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorUser
          --                       E.&&.  usrSub E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
          --                 )
          --           )
          --       )
          --   )
          -- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do  --  too slow
          --     usr <- E.from $ E.table @User
          --     E.where_ $ ((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)
          --       ) E.&&. E.exists (do
          --             usrCmp <- E.from $ E.table @UserCompany
          --             E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
          --               E.&&. (( usrCmp E.^. UserCompanySupervisor
          --                 E.&&.  usrCmp E.^. UserCompanyUser              E.==. usr E.^. UserId
          --               ) E.||. E.exists (do
          --                 usrSpr <- E.from $ E.table @UserSupervisor
          --                 E.where_ $ usrSpr E.^. UserSupervisorUser       E.==. usrCmp E.^. UserCompanyUser
          --                     E.&&.  usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
          --               ))
          --       )
          --   )
          -- , single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) -> 
          --     case criterion of
          --       Nothing -> E.true
          --       (Just (crit::Text)) -> E.exists $ do
          --             usr <- E.from $ E.table @User
          --             E.where_ $ ((usr E.^. UserDisplayName  `E.hasInfix` E.val crit)
          --                   E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk crit))
          --                   E.||. (usr E.^. UserSurname      `E.hasInfix` E.val crit)
          --               ) E.&&. E.exists (do
          --                     usrCmp <- E.from $ E.table @UserCompany
          --                     E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
          --                       E.&&. (( usrCmp E.^. UserCompanySupervisor
          --                         E.&&.  usrCmp E.^. UserCompanyUser              E.==. usr E.^. UserId
          --                       ) E.||. E.exists (do
          --                         usrSpr <- E.from $ E.table @UserSupervisor
          --                         E.where_ $ usrSpr E.^. UserSupervisorUser       E.==. usrCmp E.^. UserCompanyUser
          --                             E.&&.  usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
          --                       ))
          --               )
          --   )
          , single ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr -> 
              case criterion of
                Nothing -> return True :: DB Bool
                (Just (crit::Text)) -> do
                  critFirms <- memcachedBy (Just . Right $ 3 * diffMinute) ("SVR:"<>crit) $ fmap (Set.fromList . fmap E.unValue) $ E.select $ E.distinct $ do
                    (usr :& cmp) <- E.from  $ E.table @User `E.innerJoin` E.table @Company
                      `E.on` (\(usr :& cmp) -> E.exists (do
                        usrCmp <- E.from $ E.table @UserCompany
                        E.where_ $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
                          E.&&. usrCmp E.^. UserCompanySupervisor
                          E.&&. usrCmp E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
                      ) E.||. E.exists (do
                        usrSpr <- E.from $ E.table @UserSupervisor
                        E.where_ $ usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
                          E.&&. E.exists (do
                            usrSub <- E.from $ E.table @UserCompany
                            E.where_ $ usrSub E.^. UserCompanyUser    E.==. usrSpr E.^. UserSupervisorUser
                                E.&&.  usrSub E.^. UserCompanyCompany E.==. cmp    E.^. CompanyId
                          )
                      ))
                    E.where_ $ (usr E.^. UserDisplayName  `E.hasInfix` E.val        crit )
                        E.||.  (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk crit))
                        E.||.  (usr E.^. UserSurname      `E.hasInfix` E.val        crit )
                    -- E.orderBy [E.asc $ cmp E.^. CompanyId]
                    return $ cmp E.^. CompanyId
                  let cid = dbr ^. resultAllCompanyEntity . _entityKey
                  return $ Set.member cid critFirms
            )
          -- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do  -- too slow
          --     (usr :& usrCmp) <- E.from $ E.table @User
          --       `E.leftJoin` E.table @UserCompany
          --       `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser)
          --     E.where_ $ ((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)
          --       ) E.&&. ((E.isTrue (usrCmp E.?. UserCompanySupervisor) E.&&. usrCmp E.?. UserCompanyCompany E.?=. queryAllCompany row E.^. CompanyId)
          --           E.||. E.exists (do
          --               (usrSpr :& usrSub) <- E.from $ E.table @UserSupervisor `E.innerJoin` E.table @UserCompany `E.on` (\(usrSpr :& usrSub) -> usrSpr E.^. UserSupervisorUser E.==.  usrSub E.^. UserCompanyUser)
          --               E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
          --                 E.&&.    usrSub E.^. UserCompanyCompany       E.==. queryAllCompany row E.^. CompanyId
          --             )
          --       )
          --   )
          , single ("is-default-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_ $ ((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)
                ) E.&&. usrCmp E.^. UserCompanySupervisor
                  E.&&. usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
            )
          , 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-associate")                               mPrev $ aopt textField (fslI MsgTableCompanyUser)
          -- , prismAForm (singletonFilter "is-supervisor0")                             mPrev $ aopt textField (fslI MsgTableSupervisor)
          , prismAForm (singletonFilter "is-supervisor")                              mPrev $ aopt textField (fslI MsgTableSupervisor)
          , prismAForm (singletonFilter "is-default-supervisor")                      mPrev $ aopt textField (fslI MsgFirmSuperDefault)
          , 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 }
        dbtParams = DBParamsForm
          { dbParamsFormMethod = POST
          , dbParamsFormAction = Nothing
          , dbParamsFormAttrs  = []
          , dbParamsFormSubmit = FormSubmit
          , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm mr isAdmin [FirmActNotify, FirmActResetSupervision]
          , 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 <- checkAdmin
  (firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
  firmActionHandler FirmAllR isAdmin firmRes
  siteLayoutMsg MsgMenuFirms $ do
    setTitleI MsgMenuFirms
    $(i18nWidgetFile "firm-all")


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


data FirmUserAction = FirmUserActNotify
                    | FirmUserActResetSupervision
                    | FirmUserActSetSupervisor
                    | FirmUserActMkSuper
                    | FirmUserActChangeContact
  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
                            }
                        | FirmUserActSetSupervisorData
                            {  firmUserActSetSuperNames   :: Maybe (Set Text)
                            ,  firmUserActSetSuperIds     :: Maybe [UserId]
                            ,  firmUserActSetSuperReroute :: Bool
                            ,  firmUserActSetSuperKeep    :: Bool
                            }
                        | FirmUserActMkSuperData
                            { firmUserActMkSuperReroute   :: Maybe Bool }
                        | FirmUserActChangeContactData
                            { firmUserActPostalAddr :: Maybe StoredMarkup
                            , firmUserActPostalPref :: 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
  mr <- getMessageRender
  let
    mkSprOption (E.Value uid, E.Value udn, E.Value mbSpr) = do
      uuid <- toPathPiece <$> encryptUser uid
      return (Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }, mbSpr)

    procOptions rawSupers = do
      procSupers <- traverse mkSprOption rawSupers
      return $ mkOptionListGrouped $ filter (notNull . snd)
             [ (mr MsgFirmSuperDefault  , [opt | (opt, Just True ) <- procSupers])
             , (mr MsgFirmSuperIrregular, [opt | (opt, Just False) <- procSupers])
             , (mr MsgFirmSuperForeign  , [opt | (opt, Nothing   ) <- procSupers])
             ]

  rawSupers <- E.select $ do
    (usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany
            `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.==. E.justVal cid)
    E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor)
        E.||.  E.exists (firmQuerySupervisedBy cid Nothing usr)
    return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor)
  let
    -- supervisorField :: Field Handler UserId
    -- supervisorField  =      selectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers
    supervisorsField = multiSelectField' (Just $ SomeMessage MsgMultiNoSelection) $ 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
          [ dbSelect (applying _2) id (return . view (resultUserUser . _entityKey))
          , colUserNameModalHdr MsgTableCompanyUser ForProfileDataR
          , guardMonoid isAdmin $ sortable (Just "matriculation")   (i18nCell MsgTableMatrikelNr)              $ \(view resultUserUser           -> entUsr ) -> cellHasMatrikelnummerLinkedAdmin 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 & setTooltip MsgMultiSelectTip)
          , 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
          [ guardMonoid isAdmin $ 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 FirmUserActSetSupervisor $ FirmUserActSetSupervisorData
              <$> aopt (textField & cfAnySeparatedSet)                    (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
              <*> aopt supervisorsField                                   (fslI MsgFirmSetSupervisor & setTooltip MsgMultiSelectTip)                          Nothing
              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip)        (Just False)
              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)                                                     (Just False)
          , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
              <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
          , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
              <$> aopt htmlField                        (fslI MsgPostAddress      & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
              <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip) Nothing
          ]
        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 <- checkAdmin
  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
    (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
    (FirmUserActSetSupervisorData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do
      avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser $ maybeMonoid firmUserActSetSuperNames
      let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
          usersFound = mapMaybe snd usersFound'
          newSupers = Set.toList $ Set.fromList (maybeMonoid firmUserActSetSuperIds) <> Set.fromList usersFound
          nrSupers = fromIntegral $ length newSupers
          nrUsers  = fromIntegral $ length uids
      unless (null usersNotFound) $
        let msgContent = [whamlet|
              $newline never
              <ul>
                $forall (usr,_) <- usersNotFound
                  <li>#{usr}
              |]
        in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
      delSupers <- runDB
         $ bool (deleteSupervisors uids [cid]) (return 0) firmUserActSetSuperKeep
        <* putMany [UserSupervisor s u firmUserActSetSuperReroute (Just cid) Nothing | u <- toList uids, s <- newSupers]
      addMessageI Success $ MsgFirmSetSupersReport nrUsers nrSupers delSupers
      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes

    (FirmUserActMkSuperData{..}, Set.toList -> uids) -> do
      nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)]
      addMessageI Info $ MsgFirmActAddSupersSet nrMkSuper Nothing
      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
    (FirmUserActChangeContactData{..}, Set.toList -> uids) ->
      let changes = catMaybes
            [ (UserPostAddress   =.) . Just <$> canonical firmUserActPostalAddr  -- note that Nothing means no change and not delete address!
            , (UserPrefersPostal =.)        <$>           firmUserActPostalPref
            ]
      in unless (null changes) $ do
        nrChanged <- runDB $ updateWhereCount [UserId <-. uids] changes
        addMessageI Success $ MsgFirmUserChanges nrChanged
        reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes

  formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupersvisors, FirmActChangeContactFirm, FirmActChangeContactUser]

  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
                     | FirmSuperActSwitchSuper
                     | FirmSuperActRMSuperDef

  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

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

data FirmSuperActionData = FirmSuperActNotifyData
                         | FirmSuperActSwitchSuperData
                            { firmSuperActSwitchSuper   :: Maybe Bool
                            , firmSuperActSwitchReroute :: Maybe Bool
                            }
                         | FirmSuperActRMSuperDefData
                            { firmSuperActRMSuperActive :: Maybe Bool }

  deriving (Eq, Ord, Show, Generic)


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
  msgSupervisorUnchanged <- messageI Info MsgFirmSuperActSwitchSuperInfo
  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
          [ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey))
          , colUserNameModalHdr MsgTableSupervisor ForProfileDataR
          , guardMonoid isAdmin $ sortable (Just "matriculation")   (i18nCell MsgTableMatrikelNr)              $ \(view   resultSuperUser                         -> entUsr) -> cellHasMatrikelnummerLinkedAdmin 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
          [ guardMonoid isAdmin $ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData
          , singletonMap FirmSuperActSwitchSuper $ FirmSuperActSwitchSuperData
              <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableIsDefaultSupervisor)  (Just $ Just True)
              <*> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableIsDefaultReroute)      Nothing
              <*  aformMessage msgSupervisorUnchanged
          , 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 <- checkAdmin
  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
    (FirmSuperActSwitchSuperData{..}, Set.toList -> uids) -> do
      let (fltrSpr, changes) = case (firmSuperActSwitchSuper, firmSuperActSwitchReroute) of
            (Just True, Nothing)  -> ([UserCompanySupervisor ==. False], [UserCompanySupervisor =. True ])
            (Just True, Just rer) -> ([UserCompanySupervisor ==. False] ||. [UserCompanySupervisorReroute !=. rer]
                                                                       , [UserCompanySupervisor =. True ,        UserCompanySupervisorReroute =. rer  ])
            (Just False, _)       -> ([UserCompanySupervisor ==. True ], [UserCompanySupervisor =. False,        UserCompanySupervisorReroute =. False])
            (Nothing, Just True)  -> ([UserCompanySupervisor ==. True, UserCompanySupervisorReroute ==. False], [UserCompanySupervisorReroute =. True ])
            (Nothing, Just False) -> ([                                UserCompanySupervisorReroute ==. True ], [UserCompanySupervisorReroute =. False])
            (Nothing, Nothing   ) -> ([],[])
      nrSuperChanges <- runDB $ updateWhereCount (fltrSpr <> [UserCompanyUser <-. uids, UserCompanyCompany ==. cid]) changes
      addMessageI Info $ MsgFirmActAddSupersSet nrSuperChanges Nothing
      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) isAdmin [FirmActAddSupersvisors, FirmActResetSupervision, FirmActChangeContactFirm]

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