Use deep sql magic (window functions) instead of multiple queries

This commit is contained in:
Gregor Kleen 2018-06-01 11:56:40 +02:00
parent d70781659e
commit 457f63ad19
3 changed files with 21 additions and 15 deletions

View File

@ -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

View File

@ -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|
<a href=@{CourseListTermR tid}>
#{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

View File

@ -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