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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Sheet.hs
View File

@ -209,10 +209,10 @@ getSheetShowR tid csh shn = do
-- return desired columns -- return desired columns
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType) return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
let colonnadeFiles = mconcat let colonnadeFiles = mconcat
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> textCell $ toPathPiece ftype [ 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)) , sortable (Just "path") "Dateiname" $ anchorCell (\(_, (E.Value fName,_,E.Value fType)) -> CSheetR tid csh (SheetFileR shn fType fName))
(\(E.Value fName,_,_) -> str2widget fName) (\(_, (E.Value fName,_,_)) -> str2widget fName)
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> stringCell $ formatTimeGerWDT modified , sortable (Just "time") "Modifikation" $ \(_, (_,E.Value modified,_)) -> stringCell $ formatTimeGerWDT modified
] ]
fileTable <- dbTable def $ DBTable fileTable <- dbTable def $ DBTable
{ dbtSQLQuery = fileData { dbtSQLQuery = fileData

16
src/Handler/Term.hs
View File

@ -42,7 +42,7 @@ getTermShowR = do
provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData) provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData)
provideRep $ do provideRep $ do
let colonnadeTerms = mconcat 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 -- Scrap this if to slow, create term edit page instead
adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False
[whamlet| [whamlet|
@ -52,22 +52,22 @@ getTermShowR = do
$else $else
#{termToText termName} #{termToText termName}
|] |]
, sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) -> , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(_, (Entity _ Term{..},_)) ->
stringCell $ formatTimeGerWD termLectureStart stringCell $ formatTimeGerWD termLectureStart
, sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) -> , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(_, (Entity _ Term{..},_)) ->
stringCell $ formatTimeGerWD termLectureEnd stringCell $ formatTimeGerWD termLectureEnd
, sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) -> , sortable Nothing "Aktiv" $ \(_, (Entity _ Term{..},_)) ->
textCell $ bool "" tickmark termActive textCell $ bool "" tickmark termActive
, sortable Nothing "Kursliste" $ \(Entity tid Term{..}, E.Value numCourses) -> , sortable Nothing "Kursliste" $ \(_, (Entity tid Term{..}, E.Value numCourses)) ->
cell [whamlet| cell [whamlet|
<a href=@{CourseListTermR tid}> <a href=@{CourseListTermR tid}>
#{show numCourses} Kurse #{show numCourses} Kurse
|] |]
, sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) -> , sortable (Just "start") "Semesteranfang" $ \(_, (Entity _ Term{..},_)) ->
stringCell $ formatTimeGerWD termStart stringCell $ formatTimeGerWD termStart
, sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) -> , sortable (Just "end") "Semesterende" $ \(_, (Entity _ Term{..},_)) ->
stringCell $ formatTimeGerWD termEnd stringCell $ formatTimeGerWD termEnd
, sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) -> , sortable Nothing "Feiertage im Semester" $ \(_, (Entity _ Term{..},_)) ->
stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays
] ]
table <- dbTable def $ DBTable table <- dbTable def $ DBTable

12
src/Handler/Utils/Table/Pagination.hs
View File

@ -22,7 +22,7 @@ import Handler.Utils.Table.Pagination.Types
import Import import Import
import qualified Database.Esqueleto as E 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 qualified Database.Esqueleto.Internal.Language as E (From)
import Text.Blaze (Attribute) import Text.Blaze (Attribute)
import qualified Text.Blaze.Html5.Attributes as Html5 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 , E.From E.SqlQuery E.SqlExpr E.SqlBackend t
) => DBTable ) => DBTable
{ dbtSQLQuery :: t -> E.SqlQuery a { dbtSQLQuery :: t -> E.SqlQuery a
, dbtColonnade :: Colonnade h r (Cell UniWorX) , dbtColonnade :: Colonnade h (Int64, r) (Cell UniWorX)
, dbtSorting :: Map Text (SortColumn t) , dbtSorting :: Map Text (SortColumn t)
, dbtAttrs :: Attribute , dbtAttrs :: Attribute
, dbtIdent :: i , dbtIdent :: i
@ -146,7 +146,13 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do
mapM_ (addMessageI "warning") errs 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 bool return (sendResponse <=< tblLayout) psShortcircuit $ do
getParams <- handlerToWidget $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest getParams <- handlerToWidget $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest