fraport/fradrive-old
Archived
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.Lens
import Utils.Form import Utils.Form
import Handler.Utils import Handler.Utils
import Handler.Utils.Delete -- import Handler.Utils.Delete
import Control.Monad.Writer (MonadWriter(..), execWriterT) import Control.Monad.Writer (MonadWriter(..), execWriterT)
@ -72,12 +72,32 @@ fetchMaterial tid ssh csh mnm = do
return (cid, matEnt) return (cid, matEnt)
getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR = error "unimplemented" -- TODO getMaterialListR = error "unimplemented" -- TODO
getMShowR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html 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 :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMEditR = postMEditR getMEditR = postMEditR
@ -169,7 +189,7 @@ getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand -> MaterialName ->
getMDelR = postMDelR getMDelR = postMDelR
postMDelR tid ssh csh mnm = do postMDelR tid ssh csh mnm = do
(_cid, _matEnt) <- runDB $ fetchMaterial tid ssh csh mnm (_cid, _matEnt) <- runDB $ fetchMaterial tid ssh csh mnm
error "todo" error "todo" -- CONTINUE HERE
{- {-
deleteR DeleteRoute deleteR DeleteRoute
{ drRecords = Set.singleton $ entityKey matEnt { 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 -- let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid ssh csh (SheetFileR shn fType fName),modified)) fileNameTypes
-- with Colonnade -- 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 -- Restrict to consistent rows that correspond to each other
E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile) E.on (sheetFile E.^. SheetFileFile E.==. file E.^. FileId)
E.on (sheetFile E.^. SheetFileSheet E.==. sheet' E.^. SheetId)
-- filter to requested file -- 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) E.&&. E.not_ (E.isNothing $ file E.^. FileContent)
-- 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)
@ -325,7 +324,7 @@ getSShowR tid ssh csh shn = do
& defaultSorting [SortAscBy "type", SortAscBy "path"] & defaultSorting [SortAscBy "type", SortAscBy "path"]
(Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable (Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable
{ dbtSQLQuery = fileData { dbtSQLQuery = fileData
, dbtRowKey = \(_ `E.InnerJoin` _ `E.InnerJoin` file) -> file E.^. FileId , dbtRowKey = \(_ `E.InnerJoin` file) -> file E.^. FileId
, dbtColonnade = colonnadeFiles , dbtColonnade = colonnadeFiles
, dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) } , dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) }
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn $ SFileR fType fName) False) -> 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 , dbtIdent = "files" :: Text
, dbtSorting = Map.fromList , dbtSorting = Map.fromList
[ ( "type" [ ( "type"
, SortColumn $ \(_sheet `E.InnerJoin` sheetFile `E.InnerJoin` _file) -> sheetFile E.^. SheetFileType , SortColumn $ \(sheetFile `E.InnerJoin` _file) -> sheetFile E.^. SheetFileType
) )
, ( "path" , ( "path"
, SortColumn $ \(_sheet `E.InnerJoin` _sheetFile `E.InnerJoin` file) -> file E.^. FileTitle , SortColumn $ \(_sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
) )
, ( "time" , ( "time"
, SortColumn $ \(_sheet `E.InnerJoin` _sheetFile `E.InnerJoin` file) -> file E.^. FileModified , SortColumn $ \(_sheetFile `E.InnerJoin` file) -> file E.^. FileModified
) )
] ]
, dbtParams = def , dbtParams = def