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

Refactor Sheet Show: unnecessary join removed

Browse Source
This commit is contained in:
Steffen Jost 2019-05-02 09:51:09 +02:00
parent 09d8c0bb07
commit 09467c21f3
2 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Handler/Material.hs
View File

@ -12,7 +12,7 @@ import qualified Database.Esqueleto as E
import Utils.Lens
import Utils.Form
import Handler.Utils
import Handler.Utils.Delete
-- import Handler.Utils.Delete
import Control.Monad.Writer (MonadWriter(..), execWriterT)
@ -72,12 +72,32 @@ fetchMaterial tid ssh csh mnm = do
return (cid, matEnt)
getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR = error "unimplemented" -- TODO
getMShowR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMShowR = error "unimplemented" -- TODO
getMShowR = do -- tid ssh csh mnm = do
-- <- runDB $ do
-- (cid, matEnt) <- fetchMaterial tid ssh csh mnm
-- dbTable psValidator DBTable
-- { dbtSQLQuery
-- }
-- (cid, Entity mid Material{..}, files) <- runDB $ do
-- (cid, matEnt) <- fetchMaterial tid ssh csh mnm
-- fileIds <- E.select . E.from $ \(matFile `E.InnerJoin` file) -> do
-- E.on $ matFile E.^. MaterialFileFile E.==. file E.^. FileId
-- E.where_ $ matFile E.^. MaterialFileMaterial E.==. E.val (entityKey matEnt)
-- return $ file E.^. FileId
-- return (cid, matEnt, (Left . E.unValue) <$> fileIds)
error "unimplemented" -- TODO
getMEditR, postMEditR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMEditR = postMEditR
@ -169,7 +189,7 @@ getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand -> MaterialName ->
getMDelR = postMDelR
postMDelR tid ssh csh mnm = do
(_cid, _matEnt) <- runDB $ fetchMaterial tid ssh csh mnm
error "todo"
error "todo" -- CONTINUE HERE
{-
deleteR DeleteRoute
{ drRecords = Set.singleton $ entityKey matEnt

15
src/Handler/Sheet.hs
View File

@ -305,12 +305,11 @@ getSShowR tid ssh csh shn = do
-- let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid ssh csh (SheetFileR shn fType fName),modified)) fileNameTypes
-- with Colonnade
let fileData (sheet' `E.InnerJoin` sheetFile `E.InnerJoin` file) = do
let fileData (sheetFile `E.InnerJoin` file) = do
-- Restrict to consistent rows that correspond to each other
E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile)
E.on (sheetFile E.^. SheetFileSheet E.==. sheet' E.^. SheetId)
E.on (sheetFile E.^. SheetFileFile E.==. file E.^. FileId)
-- filter to requested file
E.where_ $ sheet' E.^. SheetId E.==. E.val sid
E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sid
E.&&. E.not_ (E.isNothing $ file E.^. FileContent)
-- return desired columns
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
@ -325,7 +324,7 @@ getSShowR tid ssh csh shn = do
& defaultSorting [SortAscBy "type", SortAscBy "path"]
(Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable
{ dbtSQLQuery = fileData
, dbtRowKey = \(_ `E.InnerJoin` _ `E.InnerJoin` file) -> file E.^. FileId
, dbtRowKey = \(_ `E.InnerJoin` file) -> file E.^. FileId
, dbtColonnade = colonnadeFiles
, dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) }
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn $ SFileR fType fName) False)
@ -335,13 +334,13 @@ getSShowR tid ssh csh shn = do
, dbtIdent = "files" :: Text
, dbtSorting = Map.fromList
[ ( "type"
, SortColumn $ \(_sheet `E.InnerJoin` sheetFile `E.InnerJoin` _file) -> sheetFile E.^. SheetFileType
, SortColumn $ \(sheetFile `E.InnerJoin` _file) -> sheetFile E.^. SheetFileType
)
, ( "path"
, SortColumn $ \(_sheet `E.InnerJoin` _sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
, SortColumn $ \(_sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
)
, ( "time"
, SortColumn $ \(_sheet `E.InnerJoin` _sheetFile `E.InnerJoin` file) -> file E.^. FileModified
, SortColumn $ \(_sheetFile `E.InnerJoin` file) -> file E.^. FileModified
)
]
, dbtParams = def