refactor(firm): dbTable form for firm all with selection box working now
This commit is contained in:
parent
19eea7abe8
commit
dfa03f8ba8
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user