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

Code cleaning; Table for SubmissionGroups.

Browse Source
This commit is contained in:
SJost 2018-09-13 16:51:20 +02:00
parent 9fff50983d
commit 918141da4c
8 changed files with 286 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
messages/uniworx/de.msg
View File

@ -127,8 +127,8 @@ SubmissionArchive: Zip-Archiv der Abgabedatei(en)
SubmissionFile: Datei zur Abgabe
SubmissionFiles: Abgegebene Dateien
SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt.
SubmissionEditUser: Ihre letzte Bearbeitung
SubmissionNoEditUser: Nicht von Ihnen bearbeitet
SubmissionGroupName: Gruppenname
CorrectionsTitle: Zugewiesene Korrekturen
CourseCorrectionsTitle: Korrekturen für diesen Kurs
@ -269,6 +269,8 @@ IllDefinedUTCTime: Der angegebene Zeitpunkt lässt sich nicht zu UTC konvertiere
LastEdits: Letzte Änderungen
EditedBy name@Text time@Text: Durch #{name} um #{time}
LastEdit: Letzte Änderung
LastEditByUser: Ihre letzte Bearbeitung
NoEditByUser: Nicht von Ihnen bearbeitet
SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert:
SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.

2
src/Handler/Course.hs
View File

@ -38,7 +38,7 @@ import qualified Database.Esqueleto as E
import qualified Data.UUID.Cryptographic as UUID
-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School)
colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)

423
src/Handler/Profile.hs
View File

@ -24,7 +24,7 @@ import Utils.Lens
-- import Yesod.Colonnade
import Data.Monoid (Any(..))
import qualified Data.Map as Map
import qualified Data.Set as Set
-- import qualified Data.Set as Set
import qualified Database.Esqueleto as E
-- import Database.Esqueleto ((^.))
@ -149,23 +149,6 @@ postProfileR = do
-- TODO
getProfileR
----------------------------------------
-- TODO: Are these really a good idea?
-- If yes: Move to appropriate Place: Utils.Lens and Utils.Table.Cells
--
-- Or Maybe make Course an instance of Data.Data and use biplate instead?
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [String]
-- ["a","b","c","d","e","f"]
-- it :: [String]
-- *Main Control.Lens Data.Data.Lens
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Int]
-- []
-- it :: [Int]
-- *Main Control.Lens Data.Data.Lens
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Integer]
-- [7,9,8]
-- it :: [Integer]
getProfileDataR :: Handler Html
@ -174,166 +157,13 @@ getProfileDataR = do
-- mr <- getMessageRender
-- Tabelle mit eigenen Kursen
(Any hasRows, ownCourseTable) <- do
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
withType = id
validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)]
dbTableWidget validator $ DBTable
{ dbtIdent = "courseOwnership" :: Text
, dbtStyle = def
, dbtSQLQuery = \(course `E.InnerJoin` lecturer) -> do
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
return ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
, dbtProj = \x -> return $ x & _dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
, dbtColonnade = mconcat
[ dbRow
, sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do
tid <- view (_dbrOutput . _1)
return $ indicatorCell `mappend` termCell tid
, sortable (Just "school") (i18nCell MsgCourseSchool) $
schoolCell <$> view (_dbrOutput . _1 . re _Just)
<*> view (_dbrOutput . _2 )
, sortable (Just "course") (i18nCell MsgCourse) $
courseLinkCell <$> view (_dbrOutput)
]
, dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand) -- consider PatternSynonyms. Drawback: not enclosed with table, since they must be at Top-Level. Maybe make Lenses for InnerJoins then?
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool )
]
, dbtFilter = Map.fromList
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
}
(hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
courseTable <- do
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
withType = id
validator = def
& defaultSorting [("time",SortDesc)]
courseData = \(course `E.InnerJoin` participant) -> do
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
return (course, participant E.^. CourseParticipantRegistration)
dbTableWidget' validator $ DBTable
{ dbtIdent = "courseMembership" :: Text
, dbtSQLQuery = courseData
, dbtProj = \x -> return $ x & _dbrOutput . _2 %~ E.unValue
, dbtColonnade = mconcat
[ dbRow
, sortable (Just "term") (i18nCell MsgTerm) $
termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $
schoolCell <$> view ( _courseTerm . re _Just)
<*> view ( _courseSchool )
, sortable (Just "course") (i18nCell MsgCourse) $
courseCell <$> view (_dbrOutput . _1 . _entityVal)
, sortable (Just "time") (i18nCell MsgRegistered) $ do
regTime <- view $ _dbrOutput . _2
return $ timeCell regTime
]
, dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
, ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
]
, dbtFilter = Map.fromList
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName )
, ( "term" , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
]
, dbtStyle = def
}
enrolledCoursesTable <- mkEnrolledCoursesTable uid
-- Tabelle mit allen Abgaben und Abgabe-Gruppen
submissionTable <- do
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
withType = id
validator = def -- DUPLICATED CODE: Handler.Corrections
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
& restrictSorting (\name _ -> name /= "corrector")
& defaultSorting [("edit",SortDesc)]
lastSubEdit submission = -- latest Edit-Time of this user for submission
E.sub_select . E.from $ \subEdit -> do
E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
E.&&. subEdit E.^. SubmissionEditUser E.==. E.val uid
return . E.max_ $ subEdit E.^. SubmissionEditTime
dbTableWidget' validator $ DBTable
{ dbtIdent = "submissions" :: Text
, dbtStyle = def
, dbtSQLQuery = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do
E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
let sht = ( sheet E.^. SheetName
)
return (crse, sht, submission, lastSubEdit submission)
, dbtProj = \x -> return $ x
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
& _dbrOutput . _2 %~ E.unValue
& _dbrOutput . _4 %~ E.unValue
, dbtColonnade = mconcat
[ dbRow
, sortable (Just "term") (i18nCell MsgTerm) $
termCell <$> view (_dbrOutput . _1 . _1)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
schoolCell <$> view ( _1. re _Just)
<*> view ( _2 )
, sortable (Just "course") (i18nCell MsgCourse) $
courseLinkCell <$> view (_dbrOutput . _1)
, sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
sheetCell <$> view _1
<*> view _2
, sortable (toNothing "submission") (i18nCell MsgSubmission) . magnify _dbrOutput $
submissionCell <$> view _1
<*> view _2
<*> view (_3 . _entityKey)
-- , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do
-- regTime <- view $ _dbrOutput . _4
-- return $ maybe mempty timeCell regTime
, sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $
maybe mempty timeCell <$> view (_dbrOutput . _4)
]
, dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand)
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool )
, ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName )
, ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) -> lastSubEdit submission )
]
, dbtFilter = Map.fromList
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
}
submissionTable <- mkSubmissionTable uid
-- Tabelle mit allen Abgabegruppen
--TODO
submissionGroupTable <- mkSubmissionGroupTable uid
-- Tabelle mit allen Tutorials
tutorialTable <- return [whamlet| TOOD: Tutorials anzeigen |] -- TODO
-- Tabelle mit allen Korrektor-Aufgaben
@ -343,3 +173,246 @@ getProfileDataR = do
defaultLayout $ do
$(widgetFile "profileData")
$(widgetFile "dsgvDisclaimer")
mkOwnedCoursesTable :: UserId -> Handler (Bool, Widget)
-- Table listing all courses that the given user is a lecturer for
mkOwnedCoursesTable =
let dbtIdent = "courseOwnership" :: Text
dbtStyle = def
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
withType = id
dbtSQLQuery' uid = \(course `E.InnerJoin` lecturer) -> do
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
return ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
dbtProj = \x -> return $ x & _dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
dbtColonnade = mconcat
[ dbRow
, sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do
tid <- view (_dbrOutput . _1)
return $ indicatorCell -- return True if one cell is produced here
`mappend` termCell tid
, sortable (Just "school") (i18nCell MsgCourseSchool) $
schoolCell <$> view (_dbrOutput . _1 . re _Just)
<*> view (_dbrOutput . _2 )
, sortable (Just "course") (i18nCell MsgCourse) $
courseLinkCell <$> view (_dbrOutput)
]
validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)]
dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand)
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool )
]
dbtFilter = Map.fromList
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> (dbTableWidget validator DBTable{..})
mkEnrolledCoursesTable :: UserId -> Handler Widget
-- Table listing all courses that the given user is enrolled in
mkEnrolledCoursesTable =
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
withType = id
validator = def & defaultSorting [("time",SortDesc)]
in \uid -> dbTableWidget' validator
DBTable
{ dbtIdent = "courseMembership" :: Text
, dbtSQLQuery = \(course `E.InnerJoin` participant) -> do
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
return (course, participant E.^. CourseParticipantRegistration)
, dbtProj = \x -> return $ x & _dbrOutput . _2 %~ E.unValue
, dbtColonnade = mconcat
[ dbRow
, sortable (Just "term") (i18nCell MsgTerm) $
termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $
schoolCell <$> view ( _courseTerm . re _Just)
<*> view ( _courseSchool )
, sortable (Just "course") (i18nCell MsgCourse) $
courseCell <$> view (_dbrOutput . _1 . _entityVal)
, sortable (Just "time") (i18nCell MsgRegistered) $ do
regTime <- view $ _dbrOutput . _2
return $ timeCell regTime
]
, dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
, ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
]
, dbtFilter = Map.fromList
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName )
, ( "term" , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
]
, dbtStyle = def
}
mkSubmissionTable :: UserId -> Handler Widget
-- Table listing all submissions for the given user
mkSubmissionTable =
let dbtIdent = "submissions" :: Text
dbtStyle = def
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
withType = id
dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do
E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
let sht = ( sheet E.^. SheetName
)
return (crse, sht, submission, lastSubEdit uid submission)
lastSubEdit uid submission = -- latest Edit-Time of this user for submission
E.sub_select . E.from $ \subEdit -> do
E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
E.&&. subEdit E.^. SubmissionEditUser E.==. E.val uid
return . E.max_ $ subEdit E.^. SubmissionEditTime
dbtProj = \x -> return $ x
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
& _dbrOutput . _2 %~ E.unValue
& _dbrOutput . _4 %~ E.unValue
dbtColonnade = mconcat
[ dbRow
, sortable (Just "term") (i18nCell MsgTerm) $
termCell <$> view (_dbrOutput . _1 . _1)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
schoolCell <$> view ( _1. re _Just)
<*> view ( _2 )
, sortable (Just "course") (i18nCell MsgCourse) $
courseLinkCell <$> view (_dbrOutput . _1)
, sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
sheetCell <$> view _1
<*> view _2
, sortable (toNothingS "submission") (i18nCell MsgSubmission) . magnify _dbrOutput $
submissionCell <$> view _1
<*> view _2
<*> view (_3 . _entityKey)
-- , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do
-- regTime <- view $ _dbrOutput . _4
-- return $ maybe mempty timeCell regTime
, sortable (Just "edit") (i18nCell MsgLastEditByUser) $
maybe mempty timeCell <$> view (_dbrOutput . _4)
]
validator = def -- DUPLICATED CODE: Handler.Corrections
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
& restrictSorting (\name _ -> name /= "corrector")
& defaultSorting [("edit",SortDesc)]
dbtSorting' uid = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand)
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool )
, ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName )
, ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) -> lastSubEdit uid submission )
]
dbtFilter = Map.fromList
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
dbtSorting = dbtSorting' uid
in dbTableWidget' validator $ DBTable {..}
mkSubmissionGroupTable :: UserId -> Handler Widget
-- Table listing all submissions for the given user
mkSubmissionGroupTable =
let dbtIdent = "subGroups" :: Text
dbtStyle = def
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
withType = id
dbtSQLQuery' uid = \(course `E.InnerJoin` sgroup `E.InnerJoin` sguser) -> do
E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
E.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId
E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid
let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
return (crse, sgroup, lastSGEdit sgroup)
lastSGEdit sgroup = -- latest Edit-Time of this Submission Group by a user
E.sub_select . E.from $ \(user `E.InnerJoin` sgEdit) -> do
E.on $ user E.^. UserId E.==. sgEdit E.^. SubmissionGroupEditUser
E.where_ $ sgEdit E.^. SubmissionGroupEditSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
return . E.max_ $ sgEdit E.^. SubmissionGroupEditTime
dbtProj = \x -> return $ x
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
& _dbrOutput . _3 %~ E.unValue
dbtColonnade = mconcat
[ dbRow
, sortable (Just "term") (i18nCell MsgTerm) $
termCell <$> view (_dbrOutput . _1 . _1)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
schoolCell <$> view ( _1. re _Just)
<*> view ( _2 )
, sortable (Just "course") (i18nCell MsgCourse) $
courseLinkCell <$> view (_dbrOutput . _1)
, sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $
maybe mempty textCell <$> view _submissionGroupName
, sortable (Just "edit") (i18nCell MsgLastEdit) $
maybe mempty timeCell <$> view (_dbrOutput . _3)
]
validator = def -- DUPLICATED CODE: Handler.Corrections
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
& restrictSorting (\name _ -> name /= "corrector")
& defaultSorting [("edit",SortDesc)]
dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand)
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool )
, ( "submissiongroup" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _) -> sgroup E.^. SubmissionGroupName )
, ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _ ) -> lastSGEdit sgroup)
]
dbtFilter = Map.fromList
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
in dbTableWidget' validator $ DBTable {..}
-- in do dbtSQLQuery <- dbtSQLQuery'
-- dbtSorting <- dbtSorting'
-- return $ dbTableWidget' validator $ DBTable {..}

10
src/Handler/Submission.hs
View File

@ -57,9 +57,9 @@ import Colonnade hiding (bool, fromMaybe)
import qualified Yesod.Colonnade as Yesod
import qualified Text.Blaze.Html5.Attributes as HA
numberOfSubmissionEditDates :: Int64
numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
-- DEPRECATED: We always show all edits!
-- numberOfSubmissionEditDates :: Int64
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
@ -157,14 +157,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser)
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
E.limit numberOfSubmissionEditDates
-- E.limit numberOfSubmissionEditDates -- DEPRECATED we shall show all edits
return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime)
lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
lastEditUserValues <- E.select . E.from $ \(submissionEdit) -> do
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
E.&&. submissionEdit E.^. SubmissionEditUser E.==. E.val uid
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
E.limit numberOfSubmissionEditDates
E.limit 1
return $ submissionEdit E.^. SubmissionEditTime
lastEditsUser <- forM lastEditUserValues $ \(E.Value time) -> formatTime SelFormatDateTime time
return (sheet,buddies,lastEdits,lastEditsUser)

3
src/Utils.hs
View File

@ -234,6 +234,9 @@ toMaybe False = const Nothing
toNothing :: a -> Maybe b
toNothing = const Nothing
toNothingS :: String -> Maybe b
toNothingS = const Nothing
maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap
maybeAdd (Just x) (Just y) = Just (x + y)
maybeAdd Nothing y = y

13
src/Utils/Lens.hs
View File

@ -9,16 +9,25 @@ import Import.NoFoundation
import Control.Lens as Utils.Lens
import Utils.Lens.TH
import qualified Database.Esqueleto as E (Value(..))
import qualified Database.Esqueleto as E (Value(..),InnerJoin(..))
_unValue :: Lens' (E.Value a) a
_unValue f (E.Value a) = E.Value <$> f a
_InnerJoinLeft :: Lens' (E.InnerJoin l r) l -- forall f. Functor f => (a -> f a) -> s -> f s
_InnerJoinLeft f (E.InnerJoin l r) = (`E.InnerJoin` r) <$> f l
_InnerJoinRight :: Lens' (E.InnerJoin l r) r
_InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
makeLenses_ ''Entity
makeLenses_ ''Course
makeLenses_ ''SheetCorrector
makeLenses_ ''Course
makeLenses_ ''SubmissionGroup
-- makeClassy_ ''Load

9
templates/profileData.hamlet
View File

@ -12,18 +12,23 @@
<div .container>
<h2> Eigene Kurse
<div .container>
^{ownCourseTable}
^{ownedCoursesTable}
<div .container>
<h2> Kursanmeldungen
<div .container>
^{courseTable}
^{enrolledCoursesTable}
<div .container>
<h2> Übungsgruppen
<div .container>
^{tutorialTable}
<div .container>
<h2> Abgabegruppen
<div .container>
^{submissionGroupTable}
<div .container>
<h2> Abgaben
<div .container>

12
templates/submission.hamlet
View File

@ -3,22 +3,24 @@ $maybe cID <- mcid
<h2>
<a href=@{CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv
(<a href=@{CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))}>Original</a>)
$maybe fileTable <- mFileTable
<h3>_{MsgSubmissionFiles}
^{fileTable}
$if not (null lastEdits)
<h3>_{MsgLastEdits}
<ul>
$forall (name,time) <- lastEdits
<li>_{MsgEditedBy name time}
_{MsgSubmissionEditUser}: #
_{MsgLastEditByUser}: #
$if null lastEditsUser
_{MsgSubmissionNoEditUser}
_{MsgNoEditByUser}
$else
$forall time <- lastEditsUser
#{display time}
$maybe fileTable <- mFileTable
<h3>_{MsgSubmissionFiles}
^{fileTable}
$if maySubmit
<section>