chore(lms): use array_agg for print job acknowledgements
This commit is contained in:
Steffen Jost
parent
0054544d1d
commit
fb82dcbb33
@ -40,7 +40,7 @@ module Database.Esqueleto.Utils
|
||||
, selectMaybe
|
||||
, day, diffDays, diffTimes
|
||||
, exprLift
|
||||
, explicitUnsafeCoerceSqlExprValue
|
||||
, explicitUnsafeCoerceSqlExprValue
|
||||
, module Database.Esqueleto.Utils.TH
|
||||
) where
|
||||
|
||||
@ -104,7 +104,7 @@ justValList = E.valList . map Just
|
||||
|
||||
infixl 4 =?.
|
||||
(=?.) :: PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
|
||||
(=?.) a b = E.just a E.==. b
|
||||
(=?.) = (E.==.) . E.just
|
||||
|
||||
infixl 4 ?=.
|
||||
(?=.) :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value Bool)
|
||||
@ -267,26 +267,26 @@ mkContainsFilterWith cast lenslike row criterias
|
||||
|
||||
mkDayFilter :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
|
||||
-> t -- ^ query row
|
||||
-> Last Day -- ^ a day to filter for
|
||||
-> Last Day -- ^ a day to filter for
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
mkDayFilter lenslike row criterias
|
||||
mkDayFilter lenslike row criterias
|
||||
| Last (Just crit) <- criterias = day (lenslike row) E.==. E.val crit
|
||||
| otherwise = true
|
||||
|
||||
|
||||
mkDayFilterFrom :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
|
||||
-> t -- ^ query row
|
||||
-> Last Day -- ^ a day range to filter for
|
||||
-> Last Day -- ^ a day range to filter for
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
mkDayFilterFrom lenslike row criterias
|
||||
mkDayFilterFrom lenslike row criterias
|
||||
| Last (Just crit) <- criterias = day (lenslike row) E.>=. E.val crit
|
||||
| otherwise = true
|
||||
|
||||
mkDayFilterTo :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
|
||||
-> t -- ^ query row
|
||||
-> Last Day -- ^ a day range to filter for
|
||||
-> Last Day -- ^ a day range to filter for
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
mkDayFilterTo lenslike row criterias
|
||||
mkDayFilterTo lenslike row criterias
|
||||
| Last (Just crit) <- criterias = day (lenslike row) E.<=. E.val crit
|
||||
| otherwise = true
|
||||
|
||||
@ -478,7 +478,7 @@ infixl 8 #>>.
|
||||
|
||||
fromSqlKey :: (ToBackendKey SqlBackend entity, PersistField (Key entity)) => E.SqlExpr (E.Value (Key entity)) -> E.SqlExpr (E.Value Int64)
|
||||
fromSqlKey = E.veryUnsafeCoerceSqlExprValue
|
||||
|
||||
|
||||
unKey :: ( Coercible (Key entity) a
|
||||
, PersistField (Key entity), PersistField a
|
||||
)
|
||||
@ -503,7 +503,7 @@ selectCountDistinct q = do
|
||||
-> return res'
|
||||
_other
|
||||
-> error "E.countDistinct did not return exactly one result"
|
||||
|
||||
|
||||
selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r)
|
||||
selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
|
||||
|
||||
@ -512,11 +512,11 @@ day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
|
||||
day = E.unsafeSqlCastAs "date"
|
||||
|
||||
infixl 6 `diffDays`, `diffTimes`
|
||||
|
||||
|
||||
diffDays :: E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Int)
|
||||
-- ^ PostgreSQL is weird.
|
||||
diffDays a b = E.veryUnsafeCoerceSqlExprValue $ a E.-. b
|
||||
|
||||
|
||||
diffTimes :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value NominalDiffTime)
|
||||
diffTimes a b = unsafeExtract "EPOCH" $ a E.-. b
|
||||
|
||||
@ -540,7 +540,7 @@ instance (PersistField a, PersistField b, Finite a) => ExprLift (E.SqlExpr (E.Va
|
||||
| v' <- universeF
|
||||
]
|
||||
(E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ()))))
|
||||
|
||||
|
||||
instance (PersistField a1, PersistField a2, PersistField b, Finite a1, Finite a2) => ExprLift (E.SqlExpr (E.Value a1) -> E.SqlExpr (E.Value a2) -> E.SqlExpr (E.Value b)) (a1 -> a2 -> b) where
|
||||
exprLift f v1 v2 = E.case_
|
||||
[ E.when_ ( v1 E.==. E.val v1'
|
||||
@ -551,4 +551,4 @@ instance (PersistField a1, PersistField a2, PersistField b, Finite a1, Finite a2
|
||||
, v2' <- universeF
|
||||
]
|
||||
(E.else_ $ E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ()))))
|
||||
|
||||
|
||||
|
||||
@ -36,6 +36,7 @@ import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Conduit.List as C
|
||||
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
@ -267,7 +268,7 @@ queryLmsUser = $(sqlLOJproj 3 2)
|
||||
queryPrintJob :: LmsTableExpr -> E.SqlExpr (Maybe (Entity PrintJob))
|
||||
queryPrintJob = $(sqlLOJproj 3 3)
|
||||
|
||||
type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity PrintJob), E.Value (Maybe UTCTime))
|
||||
type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity PrintJob), E.Value (Maybe [Maybe UTCTime]))
|
||||
|
||||
resultQualUser :: Lens' LmsTableData (Entity QualificationUser)
|
||||
resultQualUser = _dbrOutput . _1
|
||||
@ -281,7 +282,7 @@ resultLmsUser = _dbrOutput . _3 . _Just
|
||||
resultPrintJob :: Traversal' LmsTableData (Entity PrintJob)
|
||||
resultPrintJob = _dbrOutput . _4 . _Just
|
||||
|
||||
resultPrintAck :: Traversal' LmsTableData UTCTime
|
||||
resultPrintAck :: Traversal' LmsTableData [Maybe UTCTime]
|
||||
resultPrintAck = _dbrOutput . _5 . _unValue . _Just
|
||||
|
||||
instance HasEntity LmsTableData User where
|
||||
@ -320,7 +321,7 @@ lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Enti
|
||||
, E.SqlExpr (Entity User)
|
||||
, E.SqlExpr (Maybe (Entity LmsUser))
|
||||
, E.SqlExpr (Maybe (Entity PrintJob))
|
||||
, E.SqlExpr (E.Value (Maybe UTCTime))
|
||||
, E.SqlExpr (E.Value (Maybe [Maybe UTCTime]))
|
||||
)
|
||||
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;
|
||||
@ -339,7 +340,7 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.Left
|
||||
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.joinV $ E.max_ $ pj E.^. PrintJobAcknowledged
|
||||
pure $ E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) [E.asc $ pj E.^. PrintJobCreated]
|
||||
return (qualUser, user, lmsUser, printJob, printAcknowledged)
|
||||
|
||||
|
||||
@ -522,7 +523,7 @@ postLmsR sid qsh = do
|
||||
in if notNotified
|
||||
then mempty
|
||||
else cIcon <> spacerCell <> cDate
|
||||
, sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> foldMap dateTimeCell d
|
||||
, sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> textCell (show d)
|
||||
, sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d
|
||||
]
|
||||
where
|
||||
|
||||
Loading…
Reference in New Issue
Block a user