fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

revert(lms): back to working version of qualification table

Browse Source
This commit is contained in:
Steffen Jost 2022-04-01 15:35:51 +02:00
parent 5d8614cc1a
commit 8991bdd41f
1 changed files with 41 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
src/Handler/LMS.hs
View File

@ -45,90 +45,66 @@ getLmsAllR = do
setTitleI MsgMenuQualifications
$(widgetFile "lms-all")
type AllQualicationTableExpr = E.SqlExpr (Entity Qualification) `E.InnerJoin` E.SqlExpr (Entity QualificationUser)
queryAllQualification :: IndexPreservingGetter AllQualicationTableExpr (E.SqlExpr (Entity Qualification))
queryAllQualification = to $(sqlIJproj 2 1)
type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64)
queryAllQualification :: Lens' AllQualificationTableData Qualification
queryAllQualification = _dbrOutput . _1 . _entityVal
queryAllQualificationUser :: IndexPreservingGetter AllQualicationTableExpr (E.SqlExpr (Entity QualificationUser))
queryAllQualificationUser = to $(sqlIJproj 2 2)
type AllQualificationTableData = DBRow (Entity Qualification, Entity QualificationUser) -- E.Value Word64)
resultAllQualification :: Lens' AllQualificationTableData (Entity Qualification)
resultAllQualification = _dbrOutput . _1
--resultAllQualificationCount :: Lens' AllQualificationTableData Word64
--resultAllQualificationCount = _dbrOutput . _2 . _unValue
resultAllQualificationUser :: Lens' AllQualificationTableData (Entity QualificationUser)
resultAllQualificationUser = _dbrOutput . _2
mkLmsAllTable :: DB (Widget)
mkLmsAllTable :: DB (Any, Widget)
mkLmsAllTable = do
let
resultDBTable = DBTable{..}
where
dbtSQLQuery :: AllQualicationTableExpr -> E.SqlQuery _
dbtSQLQuery = runReaderT $ do
quali <- view queryAllQualification
quser <- view queryAllQualificationUser
lift $ do
-- 1. Just a constant dummy for debugging:
-- let x = E.val (42::Word64)
-- return (quali, x)
--
-- 2. SubSelect with old syntax:
-- x <- pure . E.subSelectCount . E.from $ \quser ->
-- E.where_ $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId
-- return (quali, x)
--
-- 3. SubSelect with new syntax:
--x <- pure . Ex.subSelectCount $ do
-- quser <- Ex.from $ Ex.table @QualificationUser
-- Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
--return (quali, x)
--
-- 4. Join / GroupBy
E.on $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId
-- E.groupBy (quali E.^. QualificationId)
return (quali, quser) -- E.count $ quser E.^. QualificationUserId)
dbtRowKey = views queryAllQualification (E.^. QualificationId)
dbtProj :: _ AllQualificationTableData
dbtProj = dbtProjId -- dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = mconcat
[
sortable (Just "qualification-school") (i18nCell MsgTableLmsIdent) $ \(view resultAllQualification -> Entity _ quali) ->
let qsh = qualificationShorthand quali
in anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qsh
]
dbtSorting = mempty
dbtFilter = mempty
dbtFilterUI = mempty
{-
dbtSQLQuery quali = do
-- 1. Just a constant dummy for debugging:
-- let x = E.val (42::Word64)
-- return (quali, x)
--
-- 2. SubSelect with old syntax:
-- x <- pure . E.subSelectCount . E.from $ \quser ->
-- E.where_ $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId
-- return (quali, x)
--
-- 3. SubSelect with new syntax:
x <- pure . Ex.subSelectCount $ do
quser <- Ex.from $ Ex.table @QualificationUser
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
return (quali, x)
--
-- 4. Join / GroupBy
--Ex.on $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
--Ex.groupBy (quali E.^. QualificationId)
--return (quali, count $ quser E.^. QualificationUserId)
dbtRowKey = (E.^. QualificationId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = dbColonnade $ mconcat
[ colSchool $ resultAllQualification . _qualificationSchool
, sortable (Just "qualification-short") (i18nCell MsgTableLmsIdent) $ \(view resultAllQualification -> quali) ->
[ colSchool $ queryAllQualification . _qualificationSchool
, sortable (Just "qualification-short") (i18nCell MsgTableLmsIdent) $ \(view queryAllQualification -> quali) ->
let qsh = qualificationShorthand quali in
anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qsh
, sortable Nothing (i18nCell MsgTableLmsUser) $ \(view $ _dbrOutput . _1 . _entityKey -> qualid) -> sqlCell $ do
num <- fmap (maybe 0 (max 0 . Ex.unValue) . listToMaybe) .
Ex.select $ do
quser <- Ex.from $ Ex.table @QualificationUser
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. Ex.val qualid
pure Ex.countRows
return $ word2widget num
, sortable Nothing (i18nCell MsgMenuAdminTest) $ \(view $ _dbrOutput . _2 . _unValue -> n) -> wgtCell $ word2widget n
] -- TODO: add more columns for manual debugging view !!!
dbtSorting = mconcat
[
sortSchool $ views queryAllQualification (E.^. QualificationSchool)
, singletonMap "qualification-short" $ SortColumn $ views queryAllQualification (E.^. QualificationShorthand)
sortSchool $ to (E.^. QualificationSchool)
, singletonMap "qualification-short" $ SortColumn (E.^. QualificationShorthand)
]
dbtFilter = mconcat
[
fltrSchool $ views queryAllQualification (E.^. QualificationSchool)
fltrSchool $ to (E.^. QualificationSchool)
]
dbtFilterUI = mconcat
[
fltrSchoolUI
]
-}
dbtStyle = def -- { dbsFilterLayout = defaultDBSFilterLayout }
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtParams = def
dbtIdent :: Text
dbtIdent = "qualification-overview"
@ -137,7 +113,7 @@ mkLmsAllTable = do
dbtExtraReps = []
resultDBTableValidator = def
-- & defaultSorting [SortAscBy "school", SortAscBy "qualification-short"]
& defaultSorting [SortAscBy "school", SortAscBy "qualification-short"]
dbTable resultDBTableValidator resultDBTable
@ -249,7 +225,7 @@ getLmsR = postLmsR
postLmsR sid qsh = do
(lmsTable, quali) <- runDB $ do
Entity qid quali <- getBy404 $ SchoolQualificationShort sid qsh
tbl <- mkLmsTable qid
tbl <- view _2 <$> mkLmsTable qid
return (tbl, quali)
let heading = citext2widget $ qualificationName quali
siteLayout heading $ do