refactor(lms): failed attempts to find reason for missing pagination. REf #23
This commit is contained in:
Steffen Jost
parent
2aa5d503d1
commit
88ba30379c
@ -477,8 +477,8 @@ mkLicenceTable dbtIdent aLic apids = do
|
||||
return (usrAvs, user, qualUser, qual)
|
||||
dbtRowKey = queryUserAvs >>> (E.^. UserAvsPersonId) -- ) &&& (queryQualification >>> (E.?. QualificationId)) -- WHY IS THIS AN ERROR?
|
||||
-- Not sure what changes here:
|
||||
-- dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali)
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali)
|
||||
-- dbtProj = dbtProjFilteredPostId
|
||||
dbtColonnade = mconcat
|
||||
[ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId)
|
||||
-- $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal
|
||||
|
||||
@ -118,11 +118,11 @@ mkLmsAllTable isAdmin = do
|
||||
cactive = Ex.subSelectCount $ do
|
||||
quser <- Ex.from $ Ex.table @QualificationUser
|
||||
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
|
||||
E.&&. validQualification (utctDay now) quser
|
||||
E.&&. validQualification (utctDay now) quser
|
||||
-- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
|
||||
return (quali, cactive, cusers)
|
||||
dbtRowKey = (E.^. QualificationId)
|
||||
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
|
||||
dbtProj = dbtProjId -- TODO: or dbtProjSimple what is the difference?
|
||||
adminable = if isAdmin then sortable else \_ _ _ -> mempty
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ colSchool $ resultAllQualification . _qualificationSchool
|
||||
@ -351,17 +351,9 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do
|
||||
return (qualUser, user, lmsUser, printAcknowledged)
|
||||
|
||||
|
||||
newtype LmsTableFilterProj = LmsTableFilterProj { ltProjFilterMayAccess :: Maybe Bool }
|
||||
|
||||
instance Default LmsTableFilterProj where
|
||||
def = LmsTableFilterProj
|
||||
{ ltProjFilterMayAccess = Nothing }
|
||||
|
||||
makeLenses_ ''LmsTableFilterProj
|
||||
|
||||
mkLmsTable :: forall h p cols act act'.
|
||||
( Functor h, ToSortable h
|
||||
, Ord act, PathPiece act, RenderMessage UniWorX act
|
||||
--, Ord act, PathPiece act, RenderMessage UniWorX act
|
||||
, AsCornice h p LmsTableData (DBCell (MForm Handler) (FormResult (First act', DBFormResult UserId Bool LmsTableData))) cols
|
||||
)
|
||||
=> Bool
|
||||
@ -370,18 +362,18 @@ mkLmsTable :: forall h p cols act act'.
|
||||
-> cols
|
||||
-> PSValidator (MForm Handler) (FormResult (First act', DBFormResult UserId Bool LmsTableData))
|
||||
-> DB (FormResult (act', Set UserId), Widget)
|
||||
mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
mkLmsTable _isAdmin (Entity qid quali) _acts cols psValidator = do
|
||||
now <- liftIO getCurrentTime
|
||||
-- currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute -- we know the route here
|
||||
let
|
||||
currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali)
|
||||
-- currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali)
|
||||
nowaday = utctDay now
|
||||
_mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
|
||||
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "qualification"
|
||||
dbtSQLQuery q = lmsTableQuery qid q
|
||||
dbtRowKey = queryUser >>> (E.^. UserId)
|
||||
dbtRowKey = \x -> ((queryUser >>> (E.^. UserId)) x, (queryLmsUser >>> (E.^. LmsUserId)) x)
|
||||
dbtProj = dbtProjId -- dbtProjFilteredPostId
|
||||
-- dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do
|
||||
-- qusr <- view $ _dbtProjRow . resultQualUser
|
||||
@ -435,7 +427,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
-- , if isNothing mbRenewal then mempty
|
||||
-- else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
|
||||
-- ]
|
||||
dbtStyle = def -- { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
dbtCsvEncode = Just DBTCsvEncode
|
||||
{ dbtCsvExportForm = pure ()
|
||||
, dbtCsvDoEncode = \() -> C.map (doEncode' . view _2)
|
||||
@ -463,20 +455,21 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
<*> (join . preview (resultLmsUser . _entityVal . _lmsUserEnded))
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
dbtParams = if not isAdmin then def {dbParamsFormAction = Nothing, dbParamsFormSubmit = FormNoSubmit} else
|
||||
DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Just $ SomeRoute currentRoute
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional
|
||||
= renderAForm FormStandard
|
||||
$ (, mempty) . First . Just
|
||||
<$> multiActionA acts (fslI MsgTableAction) Nothing
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
dbtParams = def
|
||||
-- dbtParams = if not isAdmin then def {dbParamsFormAction = Nothing, dbParamsFormSubmit = FormNoSubmit} else
|
||||
-- DBParamsForm
|
||||
-- { dbParamsFormMethod = POST
|
||||
-- , dbParamsFormAction = Just $ SomeRoute currentRoute
|
||||
-- , dbParamsFormAttrs = []
|
||||
-- , dbParamsFormSubmit = FormSubmit
|
||||
-- , dbParamsFormAdditional
|
||||
-- = renderAForm FormStandard
|
||||
-- $ (, mempty) . First . Just
|
||||
-- <$> multiActionA acts (fslI MsgTableAction) Nothing
|
||||
-- , dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
-- , dbParamsFormResult = id
|
||||
-- , dbParamsFormIdent = def
|
||||
-- }
|
||||
|
||||
-- acts :: Map LmsTableAction (AForm Handler LmsTableActionData)
|
||||
-- acts = mconcat
|
||||
@ -500,7 +493,7 @@ getLmsR = postLmsR
|
||||
postLmsR sid qsh = do
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
|
||||
((lmsRes, lmsTable), Entity qid quali) <- runDB $ do
|
||||
(mkTbl, Entity qid quali) <- runDB $ do
|
||||
qent <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
let acts :: Map LmsTableAction (AForm Handler LmsTableActionData)
|
||||
acts = mconcat
|
||||
@ -510,7 +503,7 @@ postLmsR sid qsh = do
|
||||
]
|
||||
colChoices = mconcat
|
||||
[ --if not isAdmin then mempty else dbSelectIf (applying _2) id (return . view (resultUser . _entityKey)) (\r -> isJust $ r ^? resultLmsUser) -- TODO: refactor using function "is"
|
||||
colUserNameLinkHdr MsgLmsUser AdminUserR
|
||||
colUserNameLinkHdr MsgLmsUser AdminUserR
|
||||
, colUserEmail
|
||||
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
|
||||
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
|
||||
@ -572,9 +565,11 @@ postLmsR sid qsh = do
|
||||
where
|
||||
-- i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
||||
_i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
|
||||
psValidator = def & defaultPagesize (PagesizeLimit 10) -- & forceFilter "may-access" (Any True)
|
||||
tbl <- mkLmsTable isAdmin qent acts colChoices psValidator
|
||||
return (tbl, qent)
|
||||
psValidator = def -- & defaultPagesize (PagesizeLimit 10) -- & forceFilter "may-access" (Any True)
|
||||
-- tbl <- mkLmsTable isAdmin qent acts colChoices psValidator
|
||||
let mkTbl = mkLmsTable isAdmin qent acts colChoices psValidator
|
||||
return (mkTbl, qent)
|
||||
(lmsRes, lmsTable) <- runDB mkTbl -- maybe it needs to be within its own runDB? NOPE, that is not the reason. :(
|
||||
|
||||
formResult lmsRes $ \case
|
||||
_ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page
|
||||
|
||||
@ -527,6 +527,7 @@ fillDb = do
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True Nothing Nothing
|
||||
insertMany_ [Qualification mi sh ln Nothing Nothing Nothing Nothing False Nothing Nothing | n <- [111..333], let sh = CI.mk $ "T" <> tshow n, let ln = CI.mk $ "Testqualifikation " <> tshow n]
|
||||
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) (Just $ QualificationBlocked (n_day $ -5) "LMS") True -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) Nothing True -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing True -- TODO: better dates!
|
||||
|
||||
Reference in New Issue
Block a user