143 lines
8.5 KiB
Haskell
143 lines
8.5 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Utils.Sheet where
|
|
|
|
import Import.NoFoundation
|
|
import qualified Database.Esqueleto.Legacy as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
import qualified Data.Conduit.Combinators as C
|
|
|
|
-- DB Queries for Sheets that are used in several places
|
|
|
|
sheetCurrent :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SqlReadT m (Maybe SheetName)
|
|
sheetCurrent tid ssh csh = do
|
|
now <- liftIO getCurrentTime
|
|
sheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
|
|
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
|
E.where_ $ E.maybe E.true (E.>. E.val now) (sheet E.^. SheetActiveTo)
|
|
E.&&. sheet E.^. SheetActiveFrom E.<=. E.just (E.val now)
|
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
|
E.orderBy [E.asc $ sheet E.^. SheetActiveTo]
|
|
E.limit 1
|
|
return $ sheet E.^. SheetName
|
|
return $ case sheets of
|
|
[] -> Nothing
|
|
[E.Value shn] -> Just shn
|
|
_ -> error "SQL Query with limit 1 returned more than one result"
|
|
|
|
|
|
sheetOldUnassigned :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SqlReadT m (Maybe SheetName)
|
|
sheetOldUnassigned tid ssh csh = do
|
|
now <- liftIO getCurrentTime
|
|
sheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
|
|
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
|
E.where_ $ sheet E.^. SheetActiveTo E.<=. E.just (E.val now)
|
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
|
E.where_ . E.exists . E.from $ \submission ->
|
|
E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
|
|
E.&&. E.isNothing (submission E.^. SubmissionRatingBy)
|
|
E.orderBy [E.asc $ sheet E.^. SheetActiveTo]
|
|
E.limit 1
|
|
return $ sheet E.^. SheetName
|
|
return $ case sheets of
|
|
[] -> Nothing
|
|
[E.Value shn] -> Just shn
|
|
_ -> error "SQL Query with limit 1 returned more than one result"
|
|
|
|
-- | Return a specfic file from a `Sheet`
|
|
sheetFileQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe UserId -> SheetFileType -> FilePath -> ConduitT () (Either (Entity SheetFile) (Entity PersonalisedSheetFile)) (SqlPersistT m) ()
|
|
sheetFileQuery tid ssh csh shn muid sft title = sqlSelect .| C.map toEither
|
|
where
|
|
sqlSelect = E.selectSource . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` (sFile `E.FullOuterJoin` psFile)) -> do
|
|
-- Restrict to consistent rows that correspond to each other
|
|
E.on $ psFile E.?. PersonalisedSheetFileType E.==. sFile E.?. SheetFileType
|
|
E.&&. psFile E.?. PersonalisedSheetFileTitle E.==. sFile E.?. SheetFileTitle
|
|
E.&&. psFile E.?. PersonalisedSheetFileSheet E.==. sFile E.?. SheetFileSheet
|
|
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
|
E.on $ sFile E.?. SheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
|
E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
|
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
|
-- filter to requested file
|
|
E.where_ $ (sFile E.?. SheetFileTitle E.==. E.justVal title E.||. psFile E.?. PersonalisedSheetFileTitle E.==. E.justVal title)
|
|
E.&&. (sFile E.?. SheetFileType E.==. E.justVal sft E.||. psFile E.?. PersonalisedSheetFileType E.==. E.justVal sft)
|
|
E.&&. sheet E.^. SheetName E.==. E.val shn
|
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
|
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
|
-- return file entity
|
|
return (sFile, psFile)
|
|
toEither (_, Just psFile) = Right psFile
|
|
toEither (Just sFile, _) = Left sFile
|
|
toEither _ = error "sqlSelect returned incoherent result"
|
|
|
|
-- | Return all files of a certain `SheetFileType` for a `Sheet`
|
|
sheetFilesAllQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe UserId -> SheetFileType -> ConduitT () (Either (Entity SheetFile) (Entity PersonalisedSheetFile)) (SqlPersistT m) ()
|
|
sheetFilesAllQuery tid ssh csh shn muid sft = sqlSelect .| C.map toEither
|
|
where
|
|
sqlSelect = E.selectSource . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` (sFile `E.FullOuterJoin` psFile)) -> do
|
|
-- Restrict to consistent rows that correspond to each other
|
|
E.on $ psFile E.?. PersonalisedSheetFileType E.==. sFile E.?. SheetFileType
|
|
E.&&. psFile E.?. PersonalisedSheetFileTitle E.==. sFile E.?. SheetFileTitle
|
|
E.&&. psFile E.?. PersonalisedSheetFileSheet E.==. sFile E.?. SheetFileSheet
|
|
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
|
E.on $ sFile E.?. SheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
|
E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
|
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
|
-- filter to requested file
|
|
E.where_ $ (sFile E.?. SheetFileType E.==. E.justVal sft E.||. psFile E.?. PersonalisedSheetFileType E.==. E.justVal sft)
|
|
E.&&. sheet E.^. SheetName E.==. E.val shn
|
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
|
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
|
-- return file entity
|
|
return (sFile, psFile)
|
|
toEither (_, Just psFile) = Right psFile
|
|
toEither (Just sFile, _) = Left sFile
|
|
toEither _ = error "sqlSelect returned incoherent result"
|
|
|
|
-- | Return all files of certain `SheetFileTypes` for a `Sheet`
|
|
sheetFilesSFTsQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe UserId -> [SheetFileType] -> ConduitT () (Either (Entity SheetFile) (Entity PersonalisedSheetFile)) (SqlPersistT m) ()
|
|
sheetFilesSFTsQuery tid ssh csh shn muid sfts = sqlSelect .| C.map toEither
|
|
where
|
|
sqlSelect = E.selectSource . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` (sFile `E.FullOuterJoin` psFile)) -> do
|
|
-- Restrict to consistent rows that correspond to each other
|
|
E.on $ psFile E.?. PersonalisedSheetFileType E.==. sFile E.?. SheetFileType
|
|
E.&&. psFile E.?. PersonalisedSheetFileTitle E.==. sFile E.?. SheetFileTitle
|
|
E.&&. psFile E.?. PersonalisedSheetFileSheet E.==. sFile E.?. SheetFileSheet
|
|
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
|
E.on $ sFile E.?. SheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
|
E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
|
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
|
-- filter to requested file
|
|
E.where_ $ (sFile E.?. SheetFileType `E.in_` E.justValList sfts E.||. psFile E.?. PersonalisedSheetFileType `E.in_` E.justValList sfts)
|
|
E.&&. sheet E.^. SheetName E.==. E.val shn
|
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
|
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
|
-- return file entity
|
|
return (sFile, psFile)
|
|
toEither (_, Just psFile) = Right psFile
|
|
toEither (Just sFile, _) = Left sFile
|
|
toEither _ = error "sqlSelect returned incoherent result"
|
|
|
|
-- | Check whether a sheet has any files for a given file type
|
|
hasSheetFileQuery :: E.SqlExpr (Entity Sheet) -> E.SqlExpr (E.Value (Maybe UserId)) -> SheetFileType -> E.SqlExpr (E.Value Bool)
|
|
hasSheetFileQuery sheet muid sft = sheetFile E.||. personalisedSheetFile
|
|
where sheetFile = E.exists . E.from $ \sFile ->
|
|
E.where_ $ sFile E.^. SheetFileSheet E.==. sheet E.^. SheetId
|
|
E.&&. sFile E.^. SheetFileType E.==. E.val sft
|
|
personalisedSheetFile = E.exists . E.from $ \psFile ->
|
|
E.where_ $ psFile E.^. PersonalisedSheetFileSheet E.==. sheet E.^. SheetId
|
|
E.&&. psFile E.^. PersonalisedSheetFileType E.==. E.val sft
|
|
E.&&. E.just (psFile E.^. PersonalisedSheetFileUser) E.==. muid
|