fix(dbtable): fix pagination bug
This commit is contained in:
parent
6bbcc2006b
commit
b43f2364bb
1
routes
1
routes
@ -269,7 +269,6 @@
|
||||
/lms LmsAllR GET POST
|
||||
/lms/#SchoolId LmsSchoolR GET
|
||||
/lms/#SchoolId/#QualificationShorthand LmsR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/limit/#Int64/skip/#Int64 LmsLSR GET POST -- FIXME Pagination does not work here somehow
|
||||
/lms/#SchoolId/#QualificationShorthand/edit LmsEditR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET
|
||||
/lms/#SchoolId/#QualificationShorthand/users/direct LmsUsersDirectR GET !token -- LMS
|
||||
|
||||
@ -175,9 +175,6 @@ breadcrumb (LmsSchoolR ssh ) = useRunDB . maybeT (i18nCrumb MsgBrea
|
||||
breadcrumb (LmsR ssh qsh) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ LmsSchoolR ssh) $ do
|
||||
guardM . lift . existsBy $ SchoolQualificationShort ssh qsh
|
||||
return (CI.original qsh, Just $ LmsSchoolR ssh)
|
||||
breadcrumb (LmsLSR ssh qsh _ _) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ LmsSchoolR ssh) $ do
|
||||
guardM . lift . existsBy $ SchoolQualificationShort ssh qsh
|
||||
return (CI.original qsh, Just $ LmsSchoolR ssh)
|
||||
breadcrumb (LmsEditR ssh qsh) = i18nCrumb MsgMenuLmsEdit $ Just $ LmsR ssh qsh
|
||||
breadcrumb (LmsUsersR ssh qsh) = i18nCrumb MsgMenuLmsUsers $ Just $ LmsR ssh qsh
|
||||
breadcrumb (LmsUsersDirectR ssh qsh) = i18nCrumb MsgMenuLmsUsers $ Just $ LmsUsersR ssh qsh -- never displayed, TypedContent
|
||||
@ -2329,48 +2326,6 @@ pageActions (LmsR sid qsh) = return
|
||||
-- navLink = defNavLink MsgMenuLmsFake $ LmsFakeR sid qsh
|
||||
-- }
|
||||
]
|
||||
pageActions (LmsLSR sid qsh pagLimit pagOffset) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuPrevPage $ LmsLSR sid qsh pagLimit $ pred pagOffset
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuPageIncrease $ LmsLSR sid qsh (pagLimit + 500) pagOffset
|
||||
, defNavLink MsgMenuPageDecrease $ LmsLSR sid qsh (pagLimit - 500) pagOffset
|
||||
]
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuNextPage $ LmsLSR sid qsh pagLimit $ succ pagOffset
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuPageIncrease $ LmsLSR sid qsh (pagLimit + 500) pagOffset
|
||||
, defNavLink MsgMenuPageDecrease $ LmsLSR sid qsh (pagLimit - 500) pagOffset
|
||||
]
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuLmsUsers $ LmsUsersR sid qsh
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuLmsDirectDownload $ LmsUsersDirectR sid qsh
|
||||
]
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuLmsUserlist $ LmsUserlistR sid qsh
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuLmsUpload $ LmsUserlistUploadR sid qsh
|
||||
, defNavLink MsgMenuLmsDirectUpload $ LmsUserlistDirectR sid qsh
|
||||
]
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuLmsResult $ LmsResultR sid qsh
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuLmsUpload $ LmsResultUploadR sid qsh
|
||||
, defNavLink MsgMenuLmsDirectUpload $ LmsResultDirectR sid qsh
|
||||
]
|
||||
}
|
||||
, NavPageActionSecondary {
|
||||
navLink = defNavLink MsgMenuLmsEdit $ LmsEditR sid qsh
|
||||
}
|
||||
-- , NavPageActionSecondary {
|
||||
-- navLink = defNavLink MsgMenuLmsFake $ LmsFakeR sid qsh
|
||||
-- }
|
||||
]
|
||||
pageActions ApiDocsR = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
|
||||
@ -35,30 +35,6 @@ import qualified Database.Esqueleto.Experimental as X (from, on) -- needs TypeAp
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
-- import Database.Esqueleto.Utils.TH
|
||||
|
||||
---------------------------
|
||||
-- PAGINATION WORKAROUND --
|
||||
|
||||
|
||||
data PaginationParameters = PaginationParameters { pagLimit, pagOffset:: Int64 }
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Default PaginationParameters where
|
||||
def = PaginationParameters { pagLimit = 100, pagOffset = 0}
|
||||
|
||||
makePaginationForm :: Maybe PaginationParameters -> Form PaginationParameters
|
||||
makePaginationForm tmpl = identifyForm FIDPaginationWorkaround . validateForm validatePaginationForm $ \html ->
|
||||
flip (renderAForm FormStandard) html $ PaginationParameters
|
||||
<$> areq intField (fslI MsgPaginationSize) (pagLimit <$> tmpl)
|
||||
<*> areq intField (fslI MsgPaginationPage) (pagOffset <$> tmpl)
|
||||
|
||||
validatePaginationForm :: FormValidator PaginationParameters Handler ()
|
||||
validatePaginationForm = do
|
||||
PaginationParameters{..} <- State.get
|
||||
guardValidation MsgPaginationError $ pagLimit >= 0 && pagOffset >= 0
|
||||
|
||||
|
||||
-- END PAGINATION WORKAROUND --
|
||||
-------------------------------
|
||||
|
||||
-- avoids repetition of local definitions
|
||||
single :: (k,a) -> Map k a
|
||||
@ -398,18 +374,14 @@ getProblemAvsSynchR = do
|
||||
if oks < no_revokes
|
||||
then addMessageI Error MsgRevokeUnknownLicencesFail
|
||||
else addMessageI Info MsgRevokeUnknownLicencesOk
|
||||
redirect ProblemAvsSynchR
|
||||
|
||||
currentRoute <- fromMaybe (error "getProblemsAvsSynchR called from 404-handler") <$> liftHandler getCurrentRoute
|
||||
((fromMaybe def . formResultToMaybe -> pagResult, pagWidget), pagEnctype) <- runFormGet $ makePaginationForm def
|
||||
let pagForm = wrapForm pagWidget def { formMethod = GET, formEncoding = pagEnctype, formAction = Just $ SomeRoute currentRoute }
|
||||
redirect ProblemAvsSynchR
|
||||
|
||||
-- licence differences
|
||||
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
|
||||
<$> mkLicenceTable pagResult "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
||||
<*> mkLicenceTable pagResult "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||
<*> mkLicenceTable pagResult "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
||||
<*> mkLicenceTable pagResult "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
||||
<$> mkLicenceTable "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
||||
<*> mkLicenceTable "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||
<*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
||||
<*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
@ -488,8 +460,8 @@ instance HasUser LicenceTableData where
|
||||
hasUser = resultUser . _entityVal
|
||||
|
||||
|
||||
mkLicenceTable :: PaginationParameters -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||
mkLicenceTable PaginationParameters{..} dbtIdent aLic apids = do
|
||||
mkLicenceTable :: Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||
mkLicenceTable dbtIdent aLic apids = do
|
||||
currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
|
||||
avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] []
|
||||
now <- liftIO getCurrentTime
|
||||
@ -503,8 +475,7 @@ mkLicenceTable PaginationParameters{..} dbtIdent aLic apids = do
|
||||
E.on $ qual E.?. QualificationId E.==. qualUser E.?. QualificationUserQualification
|
||||
E.on $ user E.^. UserId E.=?. qualUser E.?. QualificationUserUser
|
||||
E.on $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
|
||||
E.where_ $ fltrLic qual E.&&. (usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids)
|
||||
when (pagLimit > 0) $ E.limit pagLimit >> E.offset (pagLimit * pagOffset) -- TODO: why does pagination not work here?
|
||||
E.where_ $ fltrLic qual E.&&. (usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids)
|
||||
return (usrAvs, user, qualUser, qual)
|
||||
dbtRowKey = queryUserAvs >>> (E.^. UserAvsPersonId) -- ) &&& (queryQualification >>> (E.?. QualificationId)) -- WHY IS THIS AN ERROR?
|
||||
-- Not sure what changes here:
|
||||
|
||||
@ -10,7 +10,6 @@ module Handler.LMS
|
||||
( getLmsAllR , postLmsAllR
|
||||
, getLmsSchoolR
|
||||
, getLmsR , postLmsR
|
||||
, getLmsLSR , postLmsLSR
|
||||
, getLmsEditR , postLmsEditR
|
||||
, getLmsUsersR , getLmsUsersDirectR
|
||||
, getLmsUserlistR , postLmsUserlistR
|
||||
@ -326,13 +325,13 @@ isRenewPinAct LmsActNotifyData = False
|
||||
isRenewPinAct LmsActRenewNotifyData = True
|
||||
isRenewPinAct LmsActRenewPinData = True
|
||||
|
||||
lmsTableQuery :: QualificationId -> LmsTableExpr -> Int64 -> Int64
|
||||
lmsTableQuery :: QualificationId -> LmsTableExpr
|
||||
-> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
|
||||
, E.SqlExpr (Entity User)
|
||||
, E.SqlExpr (Maybe (Entity LmsUser))
|
||||
, E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) -- outer maybe indicates, whether a printJob exists, inner maybe indicates all acknowledged printJobs
|
||||
)
|
||||
lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) nlimit noffset = do
|
||||
lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do
|
||||
-- RECALL: another outer join on PrintJob did not work out well, since
|
||||
-- - E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting;
|
||||
-- - using noExsists on printJob join condition works, but only deliver single value;
|
||||
@ -341,7 +340,6 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) nlimit
|
||||
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_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification
|
||||
when (nlimit > 0) $ E.limit nlimit >> E.offset (nlimit * noffset) -- FIXME Pagination does not work here somehow
|
||||
-- TODO: decide whether to use subSelect or LeftOuterJoin and delete the other!
|
||||
-- Letztes Datum anzeigen, wenn mehrere, dann diese in klickbaren Tooltip verstecken!
|
||||
let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do
|
||||
@ -366,14 +364,13 @@ mkLmsTable :: forall h p cols act act'.
|
||||
, Ord act, PathPiece act, RenderMessage UniWorX act
|
||||
, AsCornice h p LmsTableData (DBCell (MForm Handler) (FormResult (First act', DBFormResult UserId Bool LmsTableData))) cols
|
||||
)
|
||||
=> Int64 -> Int64
|
||||
-> Bool
|
||||
=> Bool
|
||||
-> Entity Qualification
|
||||
-> Map act (AForm Handler act')
|
||||
-> cols
|
||||
-> PSValidator (MForm Handler) (FormResult (First act', DBFormResult UserId Bool LmsTableData))
|
||||
-> DB (FormResult (act', Set UserId), Widget)
|
||||
mkLmsTable nlimit noffset 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
|
||||
@ -383,18 +380,18 @@ mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "qualification"
|
||||
dbtSQLQuery q = lmsTableQuery qid q nlimit noffset
|
||||
dbtSQLQuery q = lmsTableQuery qid q
|
||||
dbtRowKey = queryUser >>> (E.^. UserId)
|
||||
--dbtProj = dbtProjFilteredPostId
|
||||
dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do
|
||||
qusr <- view $ _dbtProjRow . resultQualUser
|
||||
user <- view $ _dbtProjRow . resultUser
|
||||
lusr <- preview $ _dbtProjRow . resultLmsUser
|
||||
pjac <- preview $ _dbtProjRow . resultPrintAck
|
||||
forMM_ (view $ _dbtProjFilter . _ltProjFilterMayAccess) $ \b -> do
|
||||
euid <- encrypt $ user ^. _entityKey
|
||||
guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ ForProfileDataR euid -- TODO create a page with proper rights; this is only for admins!
|
||||
return (qusr,user,lusr,E.Value pjac)
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
-- dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do
|
||||
-- qusr <- view $ _dbtProjRow . resultQualUser
|
||||
-- user <- view $ _dbtProjRow . resultUser
|
||||
-- lusr <- preview $ _dbtProjRow . resultLmsUser
|
||||
-- pjac <- preview $ _dbtProjRow . resultPrintAck
|
||||
-- forMM_ (view $ _dbtProjFilter . _ltProjFilterMayAccess) $ \b -> do
|
||||
-- euid <- encrypt $ user ^. _entityKey
|
||||
-- guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ ForProfileDataR euid -- TODO create a page with proper rights; this is only for admins!
|
||||
-- return (qusr,user,lusr,E.Value pjac)
|
||||
|
||||
dbtColonnade = cols
|
||||
dbtSorting = mconcat
|
||||
@ -416,8 +413,8 @@ mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single ("may-access" , FilterProjected $ (_ltProjFilterMayAccess ?~) . getAny)
|
||||
, single $ fltrUserNameEmail queryUser
|
||||
[ --single ("may-access" , FilterProjected $ (_ltProjFilterMayAccess ?~) . getAny)
|
||||
single $ fltrUserNameEmail queryUser
|
||||
, single ("lms-ident" , FilterColumn . E.mkContainsFilterWith (Just . LmsIdent) $ views (to queryLmsUser) (E.?. LmsUserIdent))
|
||||
-- , single ("lms-status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
|
||||
-- , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
|
||||
@ -517,13 +514,7 @@ mkLmsTable nlimit noffset isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
|
||||
getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
|
||||
getLmsR = postLmsR
|
||||
postLmsR sid qsh = redirect $ LmsLSR sid qsh 2000 0
|
||||
|
||||
getLmsLSR, postLmsLSR :: SchoolId -> QualificationShorthand -> Int64 -> Int64 -> Handler Html
|
||||
getLmsLSR = postLmsLSR
|
||||
postLmsLSR sid qsh nlimit noffset
|
||||
| nlimit < 0 || noffset < 0 = redirect $ LmsLSR sid qsh 2000 0
|
||||
| otherwise = do
|
||||
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
|
||||
@ -600,8 +591,8 @@ postLmsLSR sid qsh nlimit noffset
|
||||
where
|
||||
-- i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
||||
i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
|
||||
psValidator = def & forceFilter "may-access" (Any True)
|
||||
tbl <- mkLmsTable nlimit noffset isAdmin qent acts colChoices psValidator
|
||||
psValidator = def -- & forceFilter "may-access" (Any True)
|
||||
tbl <- mkLmsTable isAdmin qent acts colChoices psValidator
|
||||
return (tbl, qent)
|
||||
|
||||
formResult lmsRes $ \case
|
||||
|
||||
@ -234,7 +234,7 @@ mkPJTable = do
|
||||
, single ("course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName))
|
||||
, single ("qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
|
||||
, single ("lmsid" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob) (E.^. PrintJobLmsUser))
|
||||
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
|
||||
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ prismAForm (singletonFilter "name" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobName)
|
||||
@ -248,7 +248,7 @@ mkPJTable = do
|
||||
, prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse)
|
||||
, prismAForm (singletonFilter "qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification)
|
||||
, prismAForm (singletonFilter "lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser)
|
||||
, prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
|
||||
, prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
|
||||
dbtIdent :: Text
|
||||
@ -280,7 +280,7 @@ mkPJTable = do
|
||||
let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
|
||||
return (act, jobSet)
|
||||
psValidator = def & defaultSorting [SortAscBy "created"]
|
||||
-- & defaultFilter (singletonMap "acknowledged" [toPathPiece False]) -- TODO: interferes with sorting!
|
||||
-- & defaultFilter (singletonMap "acknowledged" [toPathPiece False]) -- TODO: sorting with Nothing restores this filter
|
||||
over _1 postprocess <$> dbTable psValidator DBTable{..}
|
||||
|
||||
getPrintCenterR, postPrintCenterR :: Handler Html
|
||||
|
||||
@ -1171,10 +1171,10 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
filterSql :: Map FilterKey (Maybe (_ -> E.SqlExpr (E.Value Bool)))
|
||||
filterSql = map (\(fc, args) -> ($ args) <$> filterColumn fc) $ psFilter'
|
||||
|
||||
selectPagesize = primarySortSql
|
||||
&& all (is _Just) filterSql
|
||||
-- selectPagesize = primarySortSql
|
||||
-- && all (is _Just) filterSql
|
||||
|
||||
psLimit' = bool PagesizeAll psLimit selectPagesize
|
||||
-- psLimit' = bool PagesizeAll psLimit selectPagesize
|
||||
|
||||
rows' <- E.select . E.from $ \t -> do
|
||||
res <- dbtSQLQuery t
|
||||
@ -1185,8 +1185,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
_other -> do
|
||||
case previousKeys of
|
||||
Nothing
|
||||
| PagesizeLimit l <- psLimit'
|
||||
, selectPagesize
|
||||
| PagesizeLimit l <- psLimit
|
||||
-- , selectPagesize
|
||||
, hasn't (_FormSuccess . _DBCsvExport) csvMode
|
||||
-> do
|
||||
E.limit l
|
||||
@ -1199,7 +1199,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
let mapMaybeM' f = mapMaybeM $ \(k, v) -> (,) <$> pure k <*> f v
|
||||
firstRow :: Int64
|
||||
firstRow
|
||||
| PagesizeLimit l <- psLimit'
|
||||
| PagesizeLimit l <- psLimit
|
||||
= succ (psPage * l)
|
||||
| otherwise
|
||||
= 1
|
||||
@ -1432,9 +1432,9 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
lift $ sendResponse =<< altRep
|
||||
|
||||
let
|
||||
rowCount
|
||||
| selectPagesize = fromMaybe 0 $ rows' ^? _head . _1 . _Value
|
||||
| otherwise = olength64 rows
|
||||
rowCount = fromMaybe 0 $ rows' ^? _head . _1 . _Value
|
||||
-- | selectPagesize = fromMaybe 0 $ rows' ^? _head . _1 . _Value
|
||||
-- | otherwise = olength64 rows
|
||||
|
||||
rawAction = tblLink
|
||||
$ setParam (wIdent "sorting") Nothing
|
||||
@ -1534,7 +1534,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
return $(widgetFile "table/colonnade")
|
||||
|
||||
pageCount
|
||||
| PagesizeLimit l <- psLimit'
|
||||
| PagesizeLimit l <- psLimit
|
||||
= max 1 . ceiling $ rowCount % l
|
||||
| otherwise
|
||||
= 1
|
||||
@ -1549,7 +1549,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
, formAnchor = Just $ wIdent "pagesize-form"
|
||||
}
|
||||
showPagesizeWdgt = toEnum (fromIntegral rowCount) > minimum (pagesizeOptions referencePagesize)
|
||||
&& selectPagesize
|
||||
-- && selectPagesize
|
||||
|
||||
csvWdgt = $(widgetFile "table/csv-transcode")
|
||||
|
||||
|
||||
@ -306,8 +306,7 @@ data FormIdentifier
|
||||
| FIDAvsQueryLicence
|
||||
| FIDAvsSetLicence
|
||||
| FIDBtnAvsImportUnknown
|
||||
| FIDBtnAvsRevokeUnknown
|
||||
| FIDPaginationWorkaround
|
||||
| FIDBtnAvsRevokeUnknown
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
instance PathPiece FormIdentifier where
|
||||
|
||||
@ -36,8 +36,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
zwischen dem AVS und den in FRADrive vorliegenden Fahrberechtigungen. #
|
||||
Es wird dringend empfohlen, die Fahrberechtigungen im AVS anzupassen
|
||||
und nicht umgekehrt.
|
||||
<p>
|
||||
^{pagForm}
|
||||
|
||||
<h3>
|
||||
Fahrberechtigung Rollfeld gültig in FRADrive, fehlt aber im AVS
|
||||
|
||||
@ -29,8 +29,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
The following sections show all discrepancies
|
||||
between AVS and FRADrive with respect to driving licences. #
|
||||
It is recommended to adjust AVS driving licences and keep FRADrive as it is.
|
||||
<p>
|
||||
^{pagForm}
|
||||
|
||||
<h3>
|
||||
Maneuvering area driving licence 'R' valid in FRADrive, but not in AVS
|
||||
|
||||
Loading…
Reference in New Issue
Block a user