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

---------------------------
-- Firm specific utilities
-- for filters and counts 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 (FirmAllActionData, Set CompanyId), Widget)
mkFirmAllTable isAdmin uid = do
  -- now <- liftIO getCurrentTime
  let
    resultDBTable = DBTable{..}
      where
        dbtSQLQuery cmpy = do
          unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies
            usrCmpy <- E.from $ E.table @UserCompany
            E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
                E.&&.  usrCmpy E.^. UserCompanyUser    E.==. E.val uid
          return  ( cmpy                                        --  1
                  , cmpy & firmCountUsers                       --  2
                  , cmpy & 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 FirmAllAction (AForm Handler FirmAllActionData)
        acts = mconcat
          [ singletonMap FirmAllActNotify           $ pure FirmAllActNotifyData
          , singletonMap FirmAllActResetSupervision $      FirmAllActResetSupervisionData
              <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep)         (Just $ Just False)
              <*> aopt checkBoxField                                      (fslI MsgFirmAllActResetMutualSupervision) (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"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []

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

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


getFirmAllR, postFirmAllR :: Handler Html
getFirmAllR = postFirmAllR
postFirmAllR = do
  uid <- requireAuthId
  isAdmin <- hasReadAccessTo AdminR
  (firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
  formResult firmRes $ \case    
    (_, fids) | null fids -> addMessageI Error MsgNoCompanySelected

    (FirmAllActResetSupervisionData{..}, fids) -> do
      runDB $ do
        delSupers <- if firmAllActResetKeepOldSupers == 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 (firmAllActResetMutualSupervision /= Just False) fids         
        addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
      reloadKeepGetParams FirmAllR -- reload to reflect changes

    (FirmAllActNotifyData          , 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 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, Read, Show, Generic)

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

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

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

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

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

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

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

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

instance HasEntity UserCompanyTableData User where 
  hasEntity = resultUserUser

instance HasUser UserCompanyTableData where 
  hasUser = resultUserUser . _entityVal


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
          ]
        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 _PathPiece) 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 MsgFirmAllActResetSuperKeep)         (Just $ Just False)
              -- <*> aopt checkBoxField                                      (fslI MsgFirmAllActResetMutualSupervision) (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 FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
    resultDBTableValidator = def
      & defaultSorting  [SortAscBy "user-name"]
  over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable


getFirmUsersR, postFirmUsersR :: CompanyShorthand -> Handler Html
getFirmUsersR  = postFirmUsersR
postFirmUsersR fsh = do
  isAdmin <- hasReadAccessTo AdminR
  let 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{..}, uids) -> do 
      nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. firmUserActMkSuperReroute]
      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{..}, Set.toList -> uids') -> do
      let uids = fromList uids' -- 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

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


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

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

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

data FirmSuperActionData = FirmSuperActNotifyData
                         | FirmSuperActRMSuperDefData
                         | FirmSuperActRMSuperAllData
  deriving (Eq, Ord, Read, 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
          }

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

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 MsgASReqPostal & setTooltip MsgASReqPostalTip)  (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.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)
          ]
        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 $ pure FirmSuperActRMSuperDefData
          , singletonMap FirmSuperActRMSuperAll $ pure FirmSuperActRMSuperAllData
          ]
        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, uids) -> do 
      nrRmSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False]
      addMessageI Info $ MsgRemoveDefaultSupervisors nrRmSuper
      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
    (FirmSuperActRMSuperAllData, uids) -> addMessage Info $ text2Html $ "Make "  <> tshow (length uids) <> " default and active supervisors. TODO"
    (FirmSuperActNotifyData    , uids) -> do 
      cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
      redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])

  ((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"
    $(i18nWidgetFile "firm-supervisors")
    

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 csKey = CompanyKey <$> cs
  -- get employees of chosen companies
  empys <- E.unValue <<$>> runDB (E.select $ do 
      (emp :& 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 csKey
      return $ emp E.^. UserId
    )
  -- get supervisors of employees
  sprs <- E.unValue <<$>> runDB (E.select $ do 
      spr <- E.from $ E.table @User
      E.where_ $ 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 empys
      return $ spr E.^. UserId
    )
  -- get companies of all supervisors
  sprCmpys <- E.unValue <<$>> runDB (E.select $ do
      cmpy <- E.from $ E.table @Company
      E.where_ $ E.exists $ do
        usrCmpy <- E.from $ E.table @UserCompany
        E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
            E.&&.  usrCmpy E.^. UserCompanyUser   `E.in_` E.valList sprs
      return $ cmpy E.^.CompanyId
    )
  let 
    queryLoners :: E.SqlQuery (E.SqlExpr (Entity User)) -- get supervisors without any company affiliation
    queryLoners = do
      spr <- E.from $ E.table @User
      E.where_ $ spr E.^. UserId `E.in_` E.valList empys
        E.&&. E.notExists (do
            sprCmp <- E.from $ E.table @UserCompany
            E.where_ $ sprCmp E.^. UserCompanyUser E.==. spr E.^. UserId
          )
      return spr

    queryCmpy :: Bool -> CompanyId -> E.SqlQuery (E.SqlExpr (Entity User))
    queryCmpy sORe acid = 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.==. E.val acid
          E.&&. (if sORe 
            then -- supervisors only
              E.exists $ do 
                usrSpr <- E.from $ E.table @UserSupervisor 
                E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId 
                    E.&&.  usrSpr E.^. UserSupervisorUser `E.in_` E.valList empys
            else E.true
          )
      return usr

  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)))]
      [(RGFirmSupervisor $ unCompanyKey acid, queryCmpy True  acid)  | acid <- sprCmpys ] ++
       (RGFirmIndependent, queryLoners) :
      [(RGFirmEmployees  $ unCompanyKey acid, queryCmpy False acid)  | acid <- csKey ]
    }

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