chore(firm): filter firm users by primary company

towards #157

messages/uniworx/categories/firm/de-de-formal.msg

@@ -48,6 +48,7 @@ FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh
 FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
 FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
 FilterFirmExtern: Externe Firma
+FilterFirmPrimary: Ist primäre Firma in FRADrive
 FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
 FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
 FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}

messages/uniworx/categories/firm/en-eu.msg

@@ -48,6 +48,7 @@ FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
 FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
 FilterForeignSupervisor: Has company-external supervisors
 FilterFirmExtern: External company
+FilterFirmPrimary: Is primary company in FRADrive
 FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
 FirmSupervisorIndependent: Independent supervisors
 FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users

src/Handler/Firm.hs

@@ -796,7 +796,7 @@ 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)
+type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64) -- , E.Value Bool)
 
 resultUserUser :: Lens' UserCompanyTableData (Entity User)
 resultUserUser = _dbrOutput . _1
@@ -810,6 +810,9 @@ resultUserCompanySupervisors = _dbrOutput . _3 . _unValue
 resultUserCompanyReroutes :: Lens' UserCompanyTableData Word64
 resultUserCompanyReroutes = _dbrOutput . _4 . _unValue
 
+-- resultUserCompanyPrimary :: Lens' UserCompanyTableData Bool
+-- resultUserCompanyPrimary = _dbrOutput . _5 . _unValue
+
 instance HasEntity UserCompanyTableData User where
   hasEntity = resultUserUser
 
@@ -837,20 +840,24 @@ mkFirmUserTable isAdmin cid = 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)
+        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
+          -- let isPrimary = E.notExists (do
+          --         other <- E.from $ E.table @UserCompany
+          --         E.where_ $ other E.^. UserCompanyUser     E.==. usrCmp E.^. UserCompanyUser
+          --             E.&&.  other E.^. UserCompanyPriority E.>.  usrCmp E.^. UserCompanyPriority
+          --         )
           return (usr, usrCmp, firmCountUserSupervisors usrCmp, firmCountUserSupervisorsReroute usrCmp)
         dbtRowKey = queryUserUser >>> (E.^. UserId)
         dbtProj = dbtProjId
@@ -928,15 +935,25 @@ mkFirmUserTable isAdmin cid = 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
+          , singletonMap "is-primary-company" $ FilterColumn $ \row (getLast -> criterion) ->
+              let checkPrimary = do
+                    other <- E.from $ E.table @UserCompany
+                    E.where_ $ other E.^. UserCompanyUser     E.==. queryUserUserCompany row E.^. UserCompanyUser
+                        E.&&.  other E.^. UserCompanyPriority E.>.  queryUserUserCompany row E.^. UserCompanyPriority                  
+              in case criterion of
+                  Nothing     -> E.true
+                  Just False  -> E.exists    checkPrimary
+                  Just True   -> E.notExists checkPrimary
           ]
         -- 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-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)
+          , prismAForm (singletonFilter "is-primary-company"     . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI   MsgFilterFirmPrimary)
           ]
         dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
         acts :: Map FirmUserAction (AForm Handler FirmUserActionData)