From dfa03f8ba80009f01bb80cbc0b57d61e5b212df3 Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Tue, 24 Oct 2023 10:07:12 +0000
Subject: [PATCH] refactor(firm): dbTable form for firm all with selection box
 working now

---
 src/Handler/Firm.hs                   | 253 +++++++++++++++-----------
 src/Handler/Utils/Table/Pagination.hs |  14 +-
 2 files changed, 156 insertions(+), 111 deletions(-)

diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs
index 45b47f9da..5aafa0ed9 100644
--- a/src/Handler/Firm.hs
+++ b/src/Handler/Firm.hs
@@ -7,7 +7,7 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Handler.Firm
-  ( getFirmAllR   , postFirmAllR  
+  ( getFirmAllR   , postFirmAllR
   , getFirmR      , postFirmR
   , getFirmUsersR , postFirmUsersR
   , getFirmSupersR, postFirmSupersR
@@ -43,14 +43,14 @@ getFirmR,  postFirmR :: CompanyShorthand -> Handler Html
 getFirmR = postFirmR
 postFirmR fsh = do
   let fshId = CompanyKey fsh
-  cusers <- runDB $ do 
+  cusers <- runDB $ do
     cusers <- selectList [UserCompanyCompany ==. fshId] []
     selectList [UserId <-. fmap (userCompanyUser . entityVal) cusers] [Asc UserDisplayName]
-  csuper <- runDB $ do 
+  csuper <- runDB $ do
     csuper <- selectList [UserCompanyCompany ==. fshId, UserCompanySupervisor ==. True] []
     selectList [UserId <-. fmap (userCompanyUser . entityVal) csuper] [Asc UserDisplayName]
-  cactSuper <- runDB $ E.select $ do 
-      (usr :& spr :& scmpy) <- E.from $ 
+  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)
@@ -61,28 +61,28 @@ postFirmR fsh = do
       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')
-  
-  siteLayoutMsg (SomeMessage fsh) $ do 
+
+  siteLayoutMsg (SomeMessage fsh) $ do
     setTitle $ citext2Html fsh
-    [whamlet|      
+    [whamlet|
       <h3>#{length csuper} Company Default Supervisors (non-foreign only)
-      <ul> 
+      <ul>
         $forall u <- csuper
           <li>^{linkUserWidget ForProfileDataR u}
 
       <h3>#{length cactSuper} Active Supervisors for Employees
-      <ul> 
+      <ul>
         $forall (E.Value _, E.Value dn, E.Value sn, E.Value mbCsh, E.Value nr) <- cactSuper
-          <li>#{nr} Employees supervised by ^{nameWidget dn sn} 
+          <li>#{nr} Employees supervised by ^{nameWidget dn sn}
             $maybe csh <- mbCsh
               $if csh /= fshId
                 from foreign company #{unCompanyKey csh}
-              $else 
-                from this company                
+              $else
+                from this company
             $nothing
               having no associated company
 
-      <h3>#{length cusers} Employees 
+      <h3>#{length cusers} Employees
       <ul>
         $forall u <- cusers
           <li>^{linkUserWidget ForProfileDataR u}
@@ -102,17 +102,17 @@ data FirmAllAction = FirmAllActNotify
 nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
 embedRenderMessage ''UniWorX ''FirmAllAction id
 
-data FirmAllActionData = FirmAllActNotifyData 
+data FirmAllActionData = FirmAllActNotifyData
                    | FirmAllActResetSupervisionData
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 
 type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64)
 resultAllCompanyEntity          :: Lens' AllCompanyTableData (Entity Company)
-resultAllCompanyEntity          = _dbrOutput . _1 
+resultAllCompanyEntity          = _dbrOutput . _1
 
 resultAllCompany                :: Lens' AllCompanyTableData Company
-resultAllCompany                = resultAllCompanyEntity . _entityVal 
+resultAllCompany                = resultAllCompanyEntity . _entityVal
 
 resultAllCompanyUsers           :: Lens' AllCompanyTableData Word64
 resultAllCompanyUsers           = _dbrOutput . _2 . _unValue
@@ -133,7 +133,7 @@ resultAllCompanyActiveReroutes' :: Lens' AllCompanyTableData Word64
 resultAllCompanyActiveReroutes' = _dbrOutput . _7 . _unValue
 
 fromUserCompany :: Maybe (E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity Company) -> E.SqlQuery ()
-fromUserCompany mbFltr cmpy = do 
+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
@@ -142,9 +142,9 @@ 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.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
 -- firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
--- firmCountSupervisors cmpy = E.subSelectCount $ E.distinct $ do 
+-- 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)
@@ -156,48 +156,48 @@ firmCountDefaultReroutes = E.subSelectCount . fromUserCompany (Just (\uc -> uc E
 -- firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
 -- firmCountForeignSupervisors cmpy = E.coalesceDefault
 --   [E.subSelect $ do
---     usrSuper <- E.from $ E.table @UserSupervisor  
+--     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)      
+--       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    
+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    
+    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    
+    usrSuper <- E.from $ E.table @UserSupervisor
     E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
       E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications
 
 
-mkFirmAllTable :: 
+mkFirmAllTable ::
   -- ( Functor h, ToSortable h
-  -- , AsCornice h p FirmAllActionData 
-  --     (DBCell (MForm Handler) 
+  -- , AsCornice h p FirmAllActionData
+  --     (DBCell (MForm Handler)
   --       (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
   --     ) cols
-  -- ) => 
+  -- ) =>
   Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
-mkFirmAllTable isAdmin uid = do 
+mkFirmAllTable isAdmin uid = do
   -- now <- liftIO getCurrentTime
-  let 
+  let
     resultDBTable = DBTable{..}
-      where 
-        dbtSQLQuery cmpy = do         
+      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
@@ -212,17 +212,50 @@ mkFirmAllTable isAdmin uid = do
                   )
         dbtRowKey = (E.^. CompanyId)
         dbtProj = dbtProjId
-        dbtColonnade = -- formColonnade $ 
+        dbtColonnade = formColonnade $
           mconcat
           [ -- if not isAdmin then mempty else -- guardOnM idAdmin $
-            -- hole :: (x -> f x) -> r -> f r
+            {- hole :: (x -> f x) -> r -> f r
+            (FormResult
+                (DBFormResult (Key Company) Bool (DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64))
+                )
+            -> f (FormResult
+                      (DBFormResult
+                         (Key Company)
+                         Bool
+                         (DBRow
+                            (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64,
+                             E.Value Word64, E.Value Word64, E.Value Word64)))))
+             -> FormResult
+                  (First FirmAllActionData,
+                   DBFormResult CompanyId Bool FirmAllActionData)
+             -> f (FormResult
+                     (First FirmAllActionData,
+                      DBFormResult CompanyId Bool FirmAllActionData))
+                      
+              -------
+              
+                  (    (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData))
+                  -> f (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData))
+                  )
+                  ->   (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
+                  -> f (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
+                      
+              ------
+                Lens' (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData)) 
+                      (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
+              ------
+                Lens' (FormResult                           (Map (Key Company) (AllCompanyTableData,Bool -> Bool)))
+                      (FormResult (First FirmAllActionData, (Map (CompanyId)   (FirmAllActionData  ,Bool -> Bool))))
+              -- applying bringt uns unter das FormResult
+            -}
             dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
-          , sortable (Just "name")        (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) -> 
+          , sortable (Just "name")        (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
               anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm
-          , sortable (Just "short")       (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) -> 
-              let fsh = companyShorthand firm 
+          , sortable (Just "short")       (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) ->
+              let fsh = companyShorthand firm
               in  anchorCell (FirmR fsh) $ toWgt fsh
-          , sortable (Just "avsnr")       (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> 
+          , 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)  $ \(view resultAllCompanySupervisors     -> nr) -> wgtCell $ word2widget nr
@@ -230,7 +263,7 @@ mkFirmAllTable isAdmin uid = do
           , 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
-          ] 
+          ]
         dbtSorting = mconcat
           [ singletonMap "name"         $ SortColumn (E.^. CompanyName)
           , singletonMap "short"        $ SortColumn (E.^. CompanyShorthand)
@@ -243,14 +276,14 @@ mkFirmAllTable isAdmin uid = do
           , singletonMap "reroute-all"  $ SortColumn firmCountActiveReroutes'
           ]
         dbtFilter = mconcat
-          [            
+          [
           ]
         dbtFilterUI = mconcat
-          [           
+          [
           ]
         dbtStyle =  def -- { dbsFilterLayout = defaultDBSFilterLayout }
         acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
-        acts = mconcat 
+        acts = mconcat
           [ singletonMap FirmAllActNotify           $ pure FirmAllActNotifyData
           , singletonMap FirmAllActResetSupervision $ pure FirmAllActResetSupervisionData
           ]
@@ -268,18 +301,18 @@ mkFirmAllTable isAdmin uid = do
           , dbParamsFormIdent    = def
           }
         dbtIdent :: Text
-        dbtIdent = "firm"        
+        dbtIdent = "firm"
         dbtCsvEncode = noCsvEncode
         dbtCsvDecode = Nothing
         dbtExtraReps = []
 
-    postprocess :: FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)
+    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)) -- This type signature is not optional!
     resultDBTableValidator = def
       & defaultSorting  [SortAscBy "short"]
@@ -295,10 +328,10 @@ postFirmAllR = do
   formResult firmRes $ \case
     (FirmAllActNotifyData          , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " companies. TODO"
     (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset "  <> tshow (length fids) <> " companies. TODO"
-  siteLayoutMsg MsgMenuFirms $ do 
+  siteLayoutMsg MsgMenuFirms $ do
     setTitleI MsgMenuFirms
     --     $(widgetFile "firm-all")
-    [whamlet|!!!STUB!!!TO DO!!!        
+    [whamlet|!!!STUB!!!TO DO!!!
         ^{firmTable}
     |]
 
@@ -308,9 +341,9 @@ postFirmAllR = do
 
 getFirmUsersR, postFirmUsersR :: CompanyShorthand -> Handler Html
 getFirmUsersR  = postFirmUsersR
-postFirmUsersR fsh = do 
+postFirmUsersR fsh = do
   let _fshId = CompanyKey fsh
-  siteLayout (citext2widget fsh) $ do 
+  siteLayout (citext2widget fsh) $ do
     setTitle $ citext2Html fsh
     [whamlet|!!!STUB!!!TO DO!!!|]
 
@@ -320,9 +353,9 @@ postFirmUsersR fsh = do
 
 getFirmSupersR, postFirmSupersR :: CompanyShorthand ->  Handler Html
 getFirmSupersR = postFirmSupersR
-postFirmSupersR fsh = do 
+postFirmSupersR fsh = do
   let _fshId = CompanyKey fsh
-  siteLayout (citext2widget fsh) $ do 
+  siteLayout (citext2widget fsh) $ do
     setTitle $ citext2Html fsh
     [whamlet|!!!STUB!!!TO DO!!!|]
 
@@ -335,7 +368,7 @@ postFirmSupersR fsh = do
 --   , qtcValidUntil     :: Day
 --   , qtcLastRefresh    :: Day
 --   , qtcBlockStatus    :: Maybe Bool
---   , qtcBlockFrom      :: Maybe UTCTime  
+--   , qtcBlockFrom      :: Maybe UTCTime
 --   , qtcScheduleRenewal:: Bool
 --   , qtcLmsStatusTxt   :: Maybe Text
 --   , qtcLmsStatusDay   :: Maybe UTCTime
@@ -352,7 +385,7 @@ postFirmSupersR fsh = do
 --     , qtcValidUntil     = compDay
 --     , qtcLastRefresh    = compDay
 --     , qtcBlockStatus    = Nothing
---     , qtcBlockFrom      = Nothing    
+--     , qtcBlockFrom      = Nothing
 --     , qtcScheduleRenewal= True
 --     , qtcLmsStatusTxt   = Just "Success"
 --     , qtcLmsStatusDay   = Just compTime
@@ -390,7 +423,7 @@ postFirmSupersR fsh = do
 --     , ('qtcBlockFrom      , SomeMessage MsgInfoQualificationBlockFrom)
 --     , ('qtcScheduleRenewal, SomeMessage MsgQualificationScheduleRenewalTooltip)
 --     , ('qtcLmsStatusTxt   , SomeMessage MsgTableLmsStatus)
---     , ('qtcLmsStatusDay   , SomeMessage MsgTableLmsStatusDay)    
+--     , ('qtcLmsStatusDay   , SomeMessage MsgTableLmsStatusDay)
 --     ]
 
 
@@ -445,15 +478,15 @@ postFirmSupersR fsh = do
 -- --   hasQualificationUserBlock = resultQualBlock
 
 
--- data QualificationTableAction 
---   = QualificationActExpire 
+-- data QualificationTableAction
+--   = QualificationActExpire
 --   | QualificationActUnexpire
 --   | QualificationActBlockSupervisor
 --   | QualificationActBlock
 --   | QualificationActUnblock
 --   | QualificationActRenew
 --   | QualificationActGrant
---   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)  
+--   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 -- instance Universe QualificationTableAction
 -- instance Finite QualificationTableAction
@@ -468,15 +501,15 @@ postFirmSupersR fsh = do
 -- isAdminAct _ = True
 -- -}
 
--- data QualificationTableActionData 
---   = QualificationActExpireData 
---   | QualificationActUnexpireData  
+-- data QualificationTableActionData
+--   = QualificationActExpireData
+--   | QualificationActUnexpireData
 --   | QualificationActBlockSupervisorData
 --   | QualificationActBlockData           { qualTableActBlockReason :: Text, qualTableActNotify :: Bool, qualTableActRemoveSupervisors :: Bool }
 --   | QualificationActUnblockData         { qualTableActBlockReason :: Text, qualTableActNotify :: Bool}
 --   | QualificationActRenewData
---   | QualificationActGrantData           { qualTableActGrantUntil  :: Day }   
---   deriving (Eq, Ord, Show, Generic)  
+--   | QualificationActGrantData           { qualTableActGrantUntil  :: Day }
+--   deriving (Eq, Ord, Show, Generic)
 
 -- isExpiryAct :: QualificationTableActionData -> Bool
 -- isExpiryAct QualificationActExpireData    = True
@@ -514,14 +547,14 @@ postFirmSupersR fsh = do
 --                 )
 -- qualificationTableQuery now qid fltr (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` qualBlock) = do
 --   -- E.distinctOnOrderBy will not work: sorting with dbTable should work, except that columns contained in distinctOnOrderBy cannot be sorted inversely by user; but PostgreSQL leftJoin with distinct filters too many results, see SQL Example lead/lag under jost/misc DevOps
---   -- 
+--   --
 --     E.on $  qualBlock E.?. QualificationUserBlockQualificationUser E.?=. qualUser E.^. QualificationUserId
 --       E.&&. qualBlock `isLatestBlockBefore` E.val now
 --     E.on $ user E.^. UserId E.=?. lmsUser  E.?. LmsUserUser
 --             E.&&. E.val qid E.=?. lmsUser  E.?. LmsUserQualification            -- NOTE: condition was once erroneously placed in where-clause, which does not work
 --     E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
---     E.where_ $    fltr qualUser 
---             E.&&. (E.val qid E.==. qualUser E.^. QualificationUserQualification)            
+--     E.where_ $    fltr qualUser
+--             E.&&. (E.val qid E.==. qualUser E.^. QualificationUserQualification)
 --     return (qualUser, user, lmsUser, qualBlock)
 
 
@@ -531,15 +564,15 @@ postFirmSupersR fsh = do
 --               )
 --            => Bool
 --            -> Entity Qualification
---            -> Map QualificationTableAction (AForm Handler QualificationTableActionData)           
+--            -> Map QualificationTableAction (AForm Handler QualificationTableActionData)
 --            -> (Map CompanyId Company -> cols)
 --            -> PSValidator (MForm Handler) (FormResult (First QualificationTableActionData, DBFormResult UserId Bool QualificationTableData))
 --            -> DB (FormResult (QualificationTableActionData, Set UserId), Widget)
 -- mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
 --   svs <- getSupervisees
---   now <- liftIO getCurrentTime  
---   -- lookup all companies   
---   cmpMap <- memcachedBy (Just . Right $ 5 * diffMinute) ("CompanyDictionary"::Text) $ do 
+--   now <- liftIO getCurrentTime
+--   -- lookup all companies
+--   cmpMap <- memcachedBy (Just . Right $ 5 * diffMinute) ("CompanyDictionary"::Text) $ do
 --     cmps <- selectList [] [] -- [Asc CompanyShorthand]
 --     return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
 --   let
@@ -584,14 +617,14 @@ postFirmSupersR fsh = do
 --     dbtFilter = mconcat
 --       [ single $ fltrUserNameEmail   queryUser
 --       , single ("avs-number"  , FilterColumn . E.mkExistsFilter $ \row criterion ->
---               E.from $ \usrAvs -> -- do 
+--               E.from $ \usrAvs -> -- do
 --                 E.where_ $ usrAvs E.^. UserAvsUser      E.==. queryUser row E.^. UserId
 --                     E.&&.  ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
 --                           (E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) ))
 --       , single ("avs-card"  , FilterColumn $ \(queryUser -> user) (criterion :: Set.Set Text) -> case readAvsFullCardNo =<< Set.lookupMin criterion of
 --             Nothing -> E.false
 --             Just cardNo -> E.exists $ E.from $ \(avsCard `E.InnerJoin` usrAvs) -> do
---                 E.on     $ usrAvs E.^. UserAvsPersonId  E.==. avsCard E.^. UserAvsCardPersonId  
+--                 E.on     $ usrAvs E.^. UserAvsPersonId  E.==. avsCard E.^. UserAvsCardPersonId
 --                 E.where_ $ usrAvs E.^. UserAvsUser      E.==. user    E.^. UserId
 --                     E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo)
 --           )
@@ -600,14 +633,14 @@ postFirmSupersR fsh = do
 --           | otherwise         -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
 --         )
 --       , single ("user-company", FilterColumn . E.mkExistsFilter $ \row criterion ->
---               E.from $ \(usrComp `E.InnerJoin` comp) -> do 
+--               E.from $ \(usrComp `E.InnerJoin` comp) -> do
 --                 let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
 --                                 (E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
 --                     testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
 --                     testcrit = maybe testname testnumber $ readMay $ CI.original criterion
 --                 E.on $     usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
 --                 E.where_ $ usrComp E.^. UserCompanyUser    E.==. queryUser row E.^. UserId E.&&. testcrit
---         )                                  
+--         )
 --       , single ("validity"    , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification now))
 --       , single ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion ->
 --           if | Just renewal <- mbRenewal
@@ -626,7 +659,7 @@ postFirmSupersR fsh = do
 --       , prismAForm (singletonFilter "user-company")                             mPrev $ aopt textField (fslI MsgTableCompany)
 --       , prismAForm (singletonFilter "personal-number" )                         mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
 --       , prismAForm (singletonFilter "avs-card" )                                mPrev $ aopt textField (fslI MsgAvsCardNo)
---       , prismAForm (singletonFilter "avs-number" )                              mPrev $ aopt textField (fslI MsgAvsPersonNo)            
+--       , prismAForm (singletonFilter "avs-number" )                              mPrev $ aopt textField (fslI MsgAvsPersonNo)
 --       , prismAForm (singletonFilter "validity"         . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
 --       , if isNothing mbRenewal then mempty
 --         else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
@@ -651,31 +684,31 @@ postFirmSupersR fsh = do
 --           <*> (view     resultCompanyUser >>= getCompanies)
 --           <*> (view     resultCompanyUser >>= getCompanyNos)
 --           <*>  view    (resultQualUser . _entityVal . _qualificationUserValidUntil)
---           <*>  view    (resultQualUser . _entityVal . _qualificationUserLastRefresh)                  
+--           <*>  view    (resultQualUser . _entityVal . _qualificationUserLastRefresh)
 --           <*>  preview (resultQualBlock. _entityVal . _qualificationUserBlockUnblock . _not)
---           <*>  preview (resultQualBlock. _entityVal . _qualificationUserBlockFrom)          
+--           <*>  preview (resultQualBlock. _entityVal . _qualificationUserBlockFrom)
 --           <*>  view    (resultQualUser . _entityVal . _qualificationUserScheduleRenewal)
 --           <*>  getStatusPlusTxt
 --           <*>  getStatusPlusDay
---         getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of 
+--         getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of
 --           []        -> pure   Nothing
 --           somecmps  -> pure $ Just $ intercalate ", " $ fmap (view (_companyName . _CI)) somecmps
 --         getCompanyNos = pure . CsvSemicolonList . mapMaybe (preview (_Just . _companyAvsId) . flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany))
 
---         getStatusPlusTxt = 
---           (join . preview (resultLmsUser  . _entityVal . _lmsUserStatus)) >>= \case 
+--         getStatusPlusTxt =
+--           (join . preview (resultLmsUser  . _entityVal . _lmsUserStatus)) >>= \case
 --             Just LmsBlocked{} -> return $ Just "Failed"
 --             Just LmsExpired{} -> return $ Just "Expired"
 --             Just LmsSuccess{} -> return $ Just "Success"
 --             Nothing -> maybeM (return Nothing) (const $ return $ Just "Open") $
 --               preview (resultLmsUser  . _entityVal . _lmsUserStarted)
---         getStatusPlusDay = 
---           (join . preview (resultLmsUser  . _entityVal . _lmsUserStatusDay)) >>= \case 
+--         getStatusPlusDay =
+--           (join . preview (resultLmsUser  . _entityVal . _lmsUserStatusDay)) >>= \case
 --             lsd@(Just _) -> return lsd
 --             Nothing -> preview (resultLmsUser  . _entityVal . _lmsUserStarted)
-          
+
 --     dbtCsvDecode = Nothing
---     dbtExtraReps = []    
+--     dbtExtraReps = []
 --     dbtParams = DBParamsForm
 --       { dbParamsFormMethod = POST
 --       , dbParamsFormAction = Nothing
@@ -704,7 +737,7 @@ postFirmSupersR fsh = do
 
 -- getQualificationR,  postQualificationR :: SchoolId -> QualificationShorthand -> Handler Html
 -- getQualificationR = postQualificationR
--- postQualificationR sid qsh = do  
+-- postQualificationR sid qsh = do
 --   isAdmin <- hasReadAccessTo AdminR
 --   msgGrantWarning <- messageIconI Warning IconWarning MsgQualificationActGrantWarning
 --   msgUnexpire     <- messageIconI Info    IconWarning MsgQualificationActUnexpireWarning
@@ -719,13 +752,13 @@ postFirmSupersR fsh = do
 --       }} <- getBy404 $ SchoolQualificationShort sid qsh
 
 --     -- Block copied to Handler/Qualifications TODO: refactor
---     let getBlockReasons unblk = E.select $ do 
---           (quser :& qblock) <- E.from $ E.table @QualificationUser 
+--     let getBlockReasons unblk = E.select $ do
+--           (quser :& qblock) <- E.from $ E.table @QualificationUser
 --             `E.innerJoin` E.table @QualificationUserBlock
 --             `E.on` (\(quser :& qblock) -> quser E.^. QualificationUserId E.==. qblock E.^. QualificationUserBlockQualificationUser)
 --           E.where_ $     quser  E.^. QualificationUserQualification E.==. E.val qid
 --             E.&&. unblk (qblock E.^. QualificationUserBlockUnblock)
---           E.groupBy     (qblock E.^. QualificationUserBlockReason)        
+--           E.groupBy     (qblock E.^. QualificationUserBlockReason)
 --           let countRows' :: E.SqlExpr (E.Value Int64) = E.countRows
 --           E.orderBy [E.desc countRows']
 --           E.limit 7
@@ -739,34 +772,34 @@ postFirmSupersR fsh = do
 --         acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
 --         acts = mconcat $
 --           [ singletonMap QualificationActExpire   $ pure QualificationActExpireData
---           , singletonMap QualificationActUnexpire $      QualificationActUnexpireData 
---               <$ aformMessage msgUnexpire        
---           ] ++ bool 
+--           , singletonMap QualificationActUnexpire $      QualificationActUnexpireData
+--               <$ aformMessage msgUnexpire
+--           ] ++ bool
 --           -- nonAdmin actions, ie. Supervisor
---           [ singletonMap QualificationActBlockSupervisor $ pure QualificationActBlockSupervisorData ] 
+--           [ singletonMap QualificationActBlockSupervisor $ pure QualificationActBlockSupervisorData ]
 --           -- Admin-only actions
 --           [ singletonMap QualificationActUnblock         $      QualificationActUnblockData
 --               <$> apreq (textField & cfStrip & addDatalist suggestionsUnblock)  (fslI MsgQualificationGrantReason)             Nothing
 --               <*> areq  (boolField . Just $ SomeMessage MsgBoolIrrelevant)      (fslI MsgQualificationBlockNotify)            (Just False)
---           , singletonMap QualificationActBlock           $      QualificationActBlockData 
+--           , singletonMap QualificationActBlock           $      QualificationActBlockData
 --               <$> apreq (textField & cfStrip & addDatalist suggestionsBlock)    (fslI MsgQualificationBlockReason)             Nothing
 --               <*> areq  (boolField . Just $ SomeMessage MsgBoolIrrelevant)      (fslI MsgQualificationBlockNotify)            (Just False)
 --               <*> areq  (boolField . Just $ SomeMessage MsgBoolIrrelevant)      (fslI MsgQualificationBlockRemoveSupervisor)  (Just False)
 --           , singletonMap QualificationActRenew           $ pure QualificationActRenewData
---           , singletonMap QualificationActGrant           $      QualificationActGrantData 
+--           , singletonMap QualificationActGrant           $      QualificationActGrantData
 --                 <$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry
 --                 <*  aformMessage msgGrantWarning
 --           ] isAdmin
 --         linkLmsUser     = toMaybe isAdmin (LmsUserR sid qsh)
---         linkUserName    = bool ForProfileR ForProfileDataR isAdmin        
+--         linkUserName    = bool ForProfileR ForProfileDataR isAdmin
 --         colChoices cmpMap = mconcat
 --           [ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
 --           , colUserNameModalHdr MsgLmsUser linkUserName
---           , colUserEmail          
+--           , colUserEmail
 --           , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
 --               let icnSuper = text2markup " " <> icon IconSupervisor
---                   cs =  [ (cmpName, cmpSpr) 
---                         | Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps                        
+--                   cs =  [ (cmpName, cmpSpr)
+--                         | Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
 --                         , let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
 --                         ]
 --                   companies = intercalate (text2markup ", ") $
@@ -775,9 +808,9 @@ postFirmSupersR fsh = do
 --           , guardMonoid isAdmin colUserMatriclenr
 --           -- , sortable (Just "validity")      (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
 --           , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $    \(   view $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> dayCell d
---           , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh)$    \(   view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d)  -> dayCell d          
+--           , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh)$    \(   view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d)  -> dayCell d
 --           , sortable (Just "valid-until")   (i18nCell MsgLmsQualificationValidUntil)  (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil))
---           , sortable (Just "blocked")       (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row -> 
+--           , sortable (Just "blocked")       (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row ->
 --               qualificationValidReasonCell' (Just $ LmsUserR sid qsh) isAdmin nowaday (row ^? resultQualBlock) row
 --           , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
 --                                                                                     )     $ \(   view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
@@ -788,13 +821,13 @@ postFirmSupersR fsh = do
 --         psValidator = def & defaultSorting [SortDescBy "last-refresh"]
 --     tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
 --     return (tbl, qent)
-  
+
 --   formResult lmsRes $ \case
 --     (QualificationActRenewData, selectedUsers) | isAdmin -> do
---       noks <- runDB $ renewValidQualificationUsers qid Nothing $ Set.toList selectedUsers      
+--       noks <- runDB $ renewValidQualificationUsers qid Nothing $ Set.toList selectedUsers
 --       addMessageI (if noks > 0 && noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
 --       reloadKeepGetParams $ QualificationR sid qsh
---     (QualificationActGrantData grantValidday, selectedUsers) | isAdmin -> do      
+--     (QualificationActGrantData grantValidday, selectedUsers) | isAdmin -> do
 --       runDB . forM_ selectedUsers $ upsertQualificationUser qid nowaday grantValidday Nothing
 --       addMessageI  (if 0 < Set.size selectedUsers then Success else Warning) . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
 --       reloadKeepGetParams $ QualificationR sid qsh
@@ -807,18 +840,18 @@ postFirmSupersR fsh = do
 --           msgVal  = upd & if isUnexpire then MsgQualificationSetUnexpire else MsgQualificationSetExpire
 --       addMessageI msgKind msgVal
 --       reloadKeepGetParams $ QualificationR sid qsh
---     (action, selectedUsers) | isBlockAct action && (isAdmin || action == QualificationActBlockSupervisorData)  -> do      
+--     (action, selectedUsers) | isBlockAct action && (isAdmin || action == QualificationActBlockSupervisorData)  -> do
 --       let selUserIds = Set.toList selectedUsers
---           (unblock, reason) = case action of 
---               QualificationActBlockSupervisorData -> (False, Right QualificationBlockReturnedByCompany)              
+--           (unblock, reason) = case action of
+--               QualificationActBlockSupervisorData -> (False, Right QualificationBlockReturnedByCompany)
 --               QualificationActBlockData{..}       -> (False, Left qualTableActBlockReason)
 --               QualificationActUnblockData{..}     -> (True , Left qualTableActBlockReason)
 --               _ -> error "Handle.Qualification.isBlockAct returned non-block action" -- cannot occur due to earlier checks
---           notify = case action of 
+--           notify = case action of
 --               QualificationActBlockData{qualTableActNotify} -> qualTableActNotify
 --               _ -> False
-          
---       oks <- runDB $ do 
+
+--       oks <- runDB $ do
 --         when (blockActRemoveSupervisors action) $ deleteWhere [UserSupervisorUser <-. selUserIds]
 --         qualificationUserBlocking qid selUserIds unblock Nothing reason notify
 --       let nrq = length selectedUsers
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index a2a5fc381..2e44c6323 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -1,10 +1,20 @@
--- SPDX-FileCopyrightText: 2022 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-23 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
+
+{- FOP - Frequently occurring problems using dbTable:
+
+  - When changing a dbTable to a form, eg. using `dbSelect` then change the colonnade defnition from `dbColonnade` to `formColonnade`!
+    Both functions are equal to id, but the types are quite different.
+
+  - Don't mix up the row type alias traditionally ending with ...Data and the Action-Result-Type also ending with ...Data
+
+-}
+
 module Handler.Utils.Table.Pagination
   ( module Handler.Utils.Table.Pagination.Types
   , dbFilterKey
@@ -1654,10 +1664,12 @@ widgetColonnade :: Colonnade h r (DBCell (HandlerFor UniWorX) x)
                 -> Colonnade h r (DBCell (HandlerFor UniWorX) x)
 widgetColonnade = id
 
+-- | force the column list type for tables that cotain forms, especially those constructed with dbSelect, avoids explicit type signatures
 formColonnade :: Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX)) (FormResult a))
               -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX)) (FormResult a))
 formColonnade = id
 
+-- | force the column list type for simple tables that do not contain forms, and especially no dbSelect, avoids explicit type signatures
 dbColonnade :: Colonnade h r (DBCell DB x)
             -> Colonnade h r (DBCell DB x)
 dbColonnade = id