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

chore(lms): fix build, provide alternative print ack date

Browse Source
This commit is contained in:
Steffen Jost 2022-10-27 15:20:42 +02:00
parent e485f2e697
commit ad49a5095b
2 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Handler/LMS.hs
View File

@ -106,13 +106,13 @@ mkLmsAllTable = do
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
where where
dbtSQLQuery quali = do dbtSQLQuery quali = do
cusers <- pure . Ex.subSelectCount $ do let cusers = 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
cactive <- pure . Ex.subSelectCount $ do cactive = 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
E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val (utctDay now) E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val (utctDay now)
-- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
return (quali, cactive, cusers) return (quali, cactive, cusers)
dbtRowKey = (E.^. QualificationId) dbtRowKey = (E.^. QualificationId)
@ -267,7 +267,7 @@ queryLmsUser = $(sqlLOJproj 3 2)
queryPrintJob :: LmsTableExpr -> E.SqlExpr (Maybe (Entity PrintJob)) queryPrintJob :: LmsTableExpr -> E.SqlExpr (Maybe (Entity PrintJob))
queryPrintJob = $(sqlLOJproj 3 3) queryPrintJob = $(sqlLOJproj 3 3)
type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity PrintJob)) type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity PrintJob), E.Value (Maybe UTCTime))
resultQualUser :: Lens' LmsTableData (Entity QualificationUser) resultQualUser :: Lens' LmsTableData (Entity QualificationUser)
resultQualUser = _dbrOutput . _1 resultQualUser = _dbrOutput . _1
@ -281,6 +281,9 @@ resultLmsUser = _dbrOutput . _3 . _Just
resultPrintJob :: Traversal' LmsTableData (Entity PrintJob) resultPrintJob :: Traversal' LmsTableData (Entity PrintJob)
resultPrintJob = _dbrOutput . _4 . _Just resultPrintJob = _dbrOutput . _4 . _Just
resultPrintAck :: Traversal' LmsTableData UTCTime
resultPrintAck = _dbrOutput . _5 . _unValue . _Just
instance HasEntity LmsTableData User where instance HasEntity LmsTableData User where
hasEntity = resultUser hasEntity = resultUser
@ -317,6 +320,7 @@ lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Enti
, E.SqlExpr (Entity User) , E.SqlExpr (Entity User)
, E.SqlExpr (Maybe (Entity LmsUser)) , E.SqlExpr (Maybe (Entity LmsUser))
, E.SqlExpr (Maybe (Entity PrintJob)) , E.SqlExpr (Maybe (Entity PrintJob))
, E.SqlExpr (E.Value (Maybe UTCTime))
) )
lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do
-- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting -- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting
@ -325,7 +329,11 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.Left
E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause
E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification
return (qualUser, user, lmsUser, printJob) let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do
E.where_ $ E.isJust (pj E.^. PrintJobLmsUser)
E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (pj E.^. PrintJobLmsUser))
pure $ E.max_ $ pj E.^. PrintJobAcknowledged
return (qualUser, user, lmsUser, printJob, E.joinV printAcknowledged)
mkLmsTable :: forall h p cols act act'. mkLmsTable :: forall h p cols act act'.
@ -507,6 +515,7 @@ postLmsR sid qsh = do
in if notNotified in if notNotified
then mempty then mempty
else cIcon <> spacerCell <> cDate else cIcon <> spacerCell <> cDate
, sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> foldMap dateTimeCell d
, sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d , sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d
] ]
where where

14
src/Handler/Qualification.hs
View File

@ -61,13 +61,13 @@ mkLmsAllTable = do
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
where where
dbtSQLQuery quali = do dbtSQLQuery quali = do
cusers <- pure . Ex.subSelectCount $ do let cusers = 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
cactive <- pure . Ex.subSelectCount $ do cactive = 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
E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val (utctDay now) E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val (utctDay now)
-- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
return (quali, cactive, cusers) return (quali, cactive, cusers)
dbtRowKey = (E.^. QualificationId) dbtRowKey = (E.^. QualificationId)