diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index b31133192..7ed7b332b 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -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 ())))) - + diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index e83c47b19..825223418 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -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