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

chore(lms): failed attempt to use groupBy in dbTable

Browse Source
This commit is contained in:
Steffen Jost 2022-04-01 15:21:38 +02:00
parent 37c0f273b1
commit 5d8614cc1a
1 changed files with 58 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
src/Handler/LMS.hs
View File

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