From 457f63ad1909092ea8774de94f1bd00d014cbdb9 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 1 Jun 2018 11:56:40 +0200 Subject: [PATCH] Use deep sql magic (window functions) instead of multiple queries --- src/Handler/Sheet.hs | 8 ++++---- src/Handler/Term.hs | 16 ++++++++-------- src/Handler/Utils/Table/Pagination.hs | 12 +++++++++--- 3 files changed, 21 insertions(+), 15 deletions(-) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 8f3d895cb..5522b0b89 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -209,10 +209,10 @@ getSheetShowR tid csh shn = do -- return desired columns return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType) let colonnadeFiles = mconcat - [ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> textCell $ toPathPiece ftype - , sortable (Just "path") "Dateiname" $ anchorCell (\(E.Value fName,_,E.Value fType) -> CSheetR tid csh (SheetFileR shn fType fName)) - (\(E.Value fName,_,_) -> str2widget fName) - , sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> stringCell $ formatTimeGerWDT modified + [ sortable (Just "type") "Typ" $ \(_, (_,_, E.Value ftype)) -> textCell $ toPathPiece ftype + , sortable (Just "path") "Dateiname" $ anchorCell (\(_, (E.Value fName,_,E.Value fType)) -> CSheetR tid csh (SheetFileR shn fType fName)) + (\(_, (E.Value fName,_,_)) -> str2widget fName) + , sortable (Just "time") "Modifikation" $ \(_, (_,E.Value modified,_)) -> stringCell $ formatTimeGerWDT modified ] fileTable <- dbTable def $ DBTable { dbtSQLQuery = fileData diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index cfbd92ced..1309b666b 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -42,7 +42,7 @@ getTermShowR = do provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData) provideRep $ do let colonnadeTerms = mconcat - [ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do + [ sortable Nothing "Kürzel" $ \(_, (Entity tid Term{..},_)) -> cell $ do -- Scrap this if to slow, create term edit page instead adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False [whamlet| @@ -52,22 +52,22 @@ getTermShowR = do $else #{termToText termName} |] - , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) -> + , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(_, (Entity _ Term{..},_)) -> stringCell $ formatTimeGerWD termLectureStart - , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) -> + , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(_, (Entity _ Term{..},_)) -> stringCell $ formatTimeGerWD termLectureEnd - , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) -> + , sortable Nothing "Aktiv" $ \(_, (Entity _ Term{..},_)) -> textCell $ bool "" tickmark termActive - , sortable Nothing "Kursliste" $ \(Entity tid Term{..}, E.Value numCourses) -> + , sortable Nothing "Kursliste" $ \(_, (Entity tid Term{..}, E.Value numCourses)) -> cell [whamlet| #{show numCourses} Kurse |] - , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) -> + , sortable (Just "start") "Semesteranfang" $ \(_, (Entity _ Term{..},_)) -> stringCell $ formatTimeGerWD termStart - , sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) -> + , sortable (Just "end") "Semesterende" $ \(_, (Entity _ Term{..},_)) -> stringCell $ formatTimeGerWD termEnd - , sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) -> + , sortable Nothing "Feiertage im Semester" $ \(_, (Entity _ Term{..},_)) -> stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays ] table <- dbTable def $ DBTable diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 8969d1a7d..b1f1bcb58 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -22,7 +22,7 @@ import Handler.Utils.Table.Pagination.Types import Import import qualified Database.Esqueleto as E -import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect) +import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect,unsafeSqlValue) import qualified Database.Esqueleto.Internal.Language as E (From) import Text.Blaze (Attribute) import qualified Text.Blaze.Html5.Attributes as Html5 @@ -72,7 +72,7 @@ data DBTable = forall a r h i t. , E.From E.SqlQuery E.SqlExpr E.SqlBackend t ) => DBTable { dbtSQLQuery :: t -> E.SqlQuery a - , dbtColonnade :: Colonnade h r (Cell UniWorX) + , dbtColonnade :: Colonnade h (Int64, r) (Cell UniWorX) , dbtSorting :: Map Text (SortColumn t) , dbtAttrs :: Attribute , dbtIdent :: i @@ -146,7 +146,13 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do mapM_ (addMessageI "warning") errs - (rows, [E.Value rowCount]) <- runDB $ (,) <$> E.select sqlQuery' <*> E.select (E.countRows <$ E.from dbtSQLQuery :: E.SqlQuery (E.SqlExpr (E.Value Int64))) + rows' <- runDB . E.select $ (,) <$> pure (E.unsafeSqlValue "row_number() OVER ()" :: E.SqlExpr (E.Value Int64), E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery' + + let + rowCount + | ((_, E.Value n), _):_ <- rows' = n + | otherwise = 0 + rows = map (\((E.Value i, _), r) -> (i, r)) rows' bool return (sendResponse <=< tblLayout) psShortcircuit $ do getParams <- handlerToWidget $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest