From e90f2fc49e2b9df8897a9dc44fe158f272e97a20 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 21 Jun 2018 14:00:22 +0200 Subject: [PATCH 1/6] Corrections Route added that shows assigned corrections --- messages/de.msg | 10 ++++++++-- routes | 1 + src/Application.hs | 1 + src/Foundation.hs | 2 ++ src/Handler/Term.hs | 2 +- src/Handler/Utils/Table.hs | 5 +++++ src/Handler/Utils/Table/Pagination.hs | 8 +++++++- 7 files changed, 25 insertions(+), 4 deletions(-) diff --git a/messages/de.msg b/messages/de.msg index d244e7fdc..d8e1aa7a0 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -1,4 +1,4 @@ - SummerTerm year@Integer: Sommersemester #{tshow year} +SummerTerm year@Integer: Sommersemester #{tshow year} WinterTerm year@Integer: Wintersemester #{tshow year}/#{tshow $ succ year} PSLimitNonPositive: “pagesize” muss größer als null sein Page n@Int64: #{tshow n} @@ -9,16 +9,19 @@ Term: Semester TermPlaceholder: W/S + vierstellige Jahreszahl TermEditHeading: Semester editieren/anlegen +LectureStart: Beginn Vorlesungen + +Course: Kurs CourseNewOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich erstellt. CourseEditOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich geändert. CourseNewDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. CourseEditDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. -FFSheetName: Name TermCourseListHeading tid@TermIdentifier: Kursübersicht #{termToText tid} TermCourseListTitle tid@TermIdentifier: Kurse #{termToText tid} CourseEditHeading: Kurs editieren/anlegen CourseEditTitle: Kurs editieren/anlegen +Sheet: Blatt SheetNewOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Neues Übungsblatt #{sheetName} wurde im Kurs #{termToText tid}-#{courseShortHand} erfolgreich erstellt. SheetTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName} SheetTitleNew tid@TermIdentifier courseShortHand@Text : #{termToText tid}-#{courseShortHand}: Neues Übungsblatt @@ -46,6 +49,7 @@ DeprecatedRoute: Diese Ansicht ist obsolet und könnte in Zukunft entfallen. UnfreeMaterials: Die Materialien für diese Veranstaltung sind nicht allgemein freigegeben. UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung +Submission: Abgabenummer SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt. SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt. SubmissionTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen @@ -54,6 +58,8 @@ SubmissionArchive: Zip-Archiv der Abgabedatei(en) SubmissionFile: Datei zur Abgabe SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem Übungsblatt. +CorrectionsTitle: Zugewiesene Korrekturen + EMail: E-Mail EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer. NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs #{termToText tid}-#{csh} angemeldet. diff --git a/routes b/routes index 37e2ebecb..1b9668fbc 100644 --- a/routes +++ b/routes @@ -57,6 +57,7 @@ !/sub/own SubmissionOwnR GET !free !/sub/#CryptoUUIDSubmission SubmissionR GET POST !owner !corrector +/corrections CorrectionsR GET !free !/#UUID CryptoUUIDDispatchR GET !free -- just redirect diff --git a/src/Application.hs b/src/Application.hs index 33a3fd07b..f44313256 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -47,6 +47,7 @@ import Handler.Term import Handler.Course import Handler.Sheet import Handler.Submission +import Handler.Corrections import Handler.CryptoIDDispatch diff --git a/src/Foundation.hs b/src/Foundation.hs index b175e2f9c..c770f110f 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -656,6 +656,8 @@ pageHeading (CourseR tid csh CShowR) = Just $ do Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermShort tid csh toWidget courseName +pageHeading CorrectionsR + = Just $ i18nHeading MsgCorrectionsTitle -- TODO: add headings for more single course- and single term-pages pageHeading _ = Nothing diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 59c103e28..5f3c681e7 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -52,7 +52,7 @@ getTermShowR = do $else #{termToText termName} |] - , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) -> + , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) -> stringCell $ formatTimeGerWD termLectureStart , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) -> stringCell $ formatTimeGerWD termLectureEnd diff --git a/src/Handler/Utils/Table.hs b/src/Handler/Utils/Table.hs index b85ab899b..5f863e58f 100644 --- a/src/Handler/Utils/Table.hs +++ b/src/Handler/Utils/Table.hs @@ -35,6 +35,9 @@ numberColonnade = headed "Nr" (fromString.show) pairColonnade :: (Functor h) => Colonnade h a c -> Colonnade h b c -> Colonnade h (a,b) c pairColonnade a b = mconcat [ lmap fst a, lmap snd b] +i18nCell :: RenderMessage site a => a -> Cell site +i18nCell msg = cell [whamlet|_{msg}|] + -- Table Modification encodeHeadedWidgetTableNumbered :: Attribute -> Colonnade Headed a (WidgetT site IO ()) -> [a] -> WidgetT site IO () @@ -91,3 +94,5 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do return ( catMaybes <$> collectResult selectionResults , encodeCellTable attrs (pairColonnade selColonnade colonnade) (zip [0..] tdata) ) + + diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 03b46992f..aafad7369 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude , ExistentialQuantification , RecordWildCards + , NamedFieldPuns , OverloadedStrings , TemplateHaskell , QuasiQuotes @@ -15,7 +16,7 @@ module Handler.Utils.Table.Pagination ( SortColumn(..), SortDirection(..) , FilterColumn(..), IsFilterColumn - , DBRow(..), DBOutput + , DBRow(..), dbRow, DBOutput , DBTable(..) , PaginationSettings(..) , PSValidator(..) @@ -49,6 +50,7 @@ import qualified Data.Map as Map import Data.Profunctor (lmap) import Colonnade hiding (bool, fromMaybe, singleton) +import qualified Colonnade (singleton) import Colonnade.Encode import Yesod.Colonnade @@ -103,6 +105,10 @@ data DBRow r = DBRow , dbrOutput :: r } +dbRow :: (Headedness h) => Colonnade h (DBRow r) (Cell site) +dbRow = Colonnade.singleton (headednessPure "nr") $ \DBRow{ dbrIndex } -> + textCell $ tshow dbrIndex + class DBOutput r r' where dbProj :: r -> r' From 2ea2968e43ef68f27f1bea3c6a99215aed7ffd77 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 21 Jun 2018 14:02:03 +0200 Subject: [PATCH 2/6] Missing files for Corrections Page added --- src/Handler/Corrections.hs | 106 +++++++++++++++++++++++++++++++++++ templates/corrections.hamlet | 2 + 2 files changed, 108 insertions(+) create mode 100644 src/Handler/Corrections.hs create mode 100644 templates/corrections.hamlet diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs new file mode 100644 index 000000000..55f0ad589 --- /dev/null +++ b/src/Handler/Corrections.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeOperators #-} + +module Handler.Corrections where + +import Import +import System.FilePath (takeFileName) + +import Handler.Utils +-- import Handler.Utils.Zip + +import qualified Data.Set as Set +import qualified Data.Map as Map + +-- import Data.Time +import qualified Data.Text as T +-- import Data.Function ((&)) +-- +import Colonnade hiding (fromMaybe, singleton) +import Yesod.Colonnade +-- +-- import qualified Data.UUID.Cryptographic as UUID +-- import qualified Data.Conduit.List as C + +import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Internal.Sql as E + +import Control.Lens +-- import Control.Monad.Writer (MonadWriter(..), execWriterT) + +-- import Network.Mime + + +getCorrectionsR :: Handler Html +getCorrectionsR = do + uid <- requireAuthId + let tableData :: _ -> E.SqlQuery _ + tableData (course `E.InnerJoin` sheet `E.InnerJoin` submission) = do + E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.where_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) + let crse = ( course E.^. CourseName :: E.SqlExpr (E.Value Text) + , course E.^. CourseShorthand + , course E.^. CourseTerm + , course E.^. CourseSchool :: E.SqlExpr (E.Value SchoolId) + ) + return (submission, sheet, crse) + colonnade :: Colonnade Sortable (DBRow + (Entity Submission, Entity Sheet, + (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School))) + + ) (Cell UniWorX) + colonnade = mconcat + [ dbRow + , sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(_, _, course) } -> + -- cell [whamlet| _{untermKey $ course ^. _3}|] -- lange, internationale Semester + textCell $ termToText $ unTermKey $ E.unValue $ $(projNI 4 3) course -- kurze Semsterkürzel + , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(_, _, course) } -> + textCell $ E.unValue $ course ^. _2 + , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(_, sheet, _) } -> + textCell $ sheetName $ entityVal sheet + , sortable Nothing (i18nCell MsgSubmission) $ \DBRow{ dbrOutput=(submission, sheet, course) } -> + cell $ do + let tid = E.unValue $ $(projNI 4 3) course + csh = E.unValue $ $(projNI 4 2) course + shn = sheetName $ entityVal sheet + cid <- encrypt (entityKey submission :: SubmissionId) + [whamlet|@{CSheetR tid csh shn (SubmissionR cid)}|] + ] + -- TODO continue here + table <- dbTable def $ DBTable + { dbtSQLQuery = tableData + , dbtColonnade = colonnade + , dbtSorting = [ ( "term" + , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseTerm + ) + , ( "course" + , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseShorthand + ) + -- TODO + ] + , dbtFilter = mempty {- [ ( "term" + , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if + | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) + ) + ] -} + , dbtAttrs = tableDefault + , dbtIdent = "corrections" :: Text + } + defaultLayout $ do + setTitleI MsgCorrectionsTitle + $(widgetFile "corrections") + + diff --git a/templates/corrections.hamlet b/templates/corrections.hamlet new file mode 100644 index 000000000..2d2943787 --- /dev/null +++ b/templates/corrections.hamlet @@ -0,0 +1,2 @@ +
+ ^{table} From f232e4d1490273b76333d78da6259f311addead9 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 21 Jun 2018 14:07:21 +0200 Subject: [PATCH 3/6] Corrections: Link for UUIDs --- src/Handler/Corrections.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 55f0ad589..e3f2ef05a 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -76,7 +76,7 @@ getCorrectionsR = do csh = E.unValue $ $(projNI 4 2) course shn = sheetName $ entityVal sheet cid <- encrypt (entityKey submission :: SubmissionId) - [whamlet|@{CSheetR tid csh shn (SubmissionR cid)}|] + [whamlet|#{display cid}|] ] -- TODO continue here table <- dbTable def $ DBTable From c6784a0b13b70e1cfe7868f9ffd8ca26fd36ad55 Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 22 Jun 2018 18:31:47 +0200 Subject: [PATCH 4/6] Minor. Puny attempts to resuse corrections table in several ways. --- src/Foundation.hs | 10 ++++++++- src/Handler/Corrections.hs | 31 ++++++++++++++++++--------- src/Handler/Utils/Table/Pagination.hs | 2 +- src/Utils/Common.hs | 2 +- 4 files changed, 32 insertions(+), 13 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index 0879610e6..345787fc5 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -40,6 +40,8 @@ import Data.ByteArray (convert) import Crypto.Hash (Digest, SHAKE256) import Crypto.Hash.Conduit (sinkHash) +import qualified Data.CryptoID (CryptoID) -- for DisplayAble instance only + import qualified Data.ByteString.Base64.URL as Base64 (encode) import Data.ByteString (ByteString) @@ -73,13 +75,19 @@ import Handler.Utils.DateTime import Control.Lens import Utils.Lens --- -- TODO: Move me to appropriate Place + +-- -- TODO: Move the following to the appropriate place, if DisplayAble is kept instance DisplayAble TermId where display = termToText . unTermKey instance DisplayAble UTCTime where display = pack . formatTimeGerDT2 -- default Time Format to be used: 00.00.00 00:00 +instance (PathPiece b) => DisplayAble (Data.CryptoID.CryptoID a b) where + display = toPathPiece -- requires import of Data.CryptoID here +-- -- MOVE ABOVE + + -- infixl 9 :$: -- pattern a :$: b = a b diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index e3f2ef05a..f902b90f2 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -15,16 +15,16 @@ module Handler.Corrections where import Import -import System.FilePath (takeFileName) +-- import System.FilePath (takeFileName) import Handler.Utils -- import Handler.Utils.Zip -import qualified Data.Set as Set -import qualified Data.Map as Map +-- import qualified Data.Set as Set +-- import qualified Data.Map as Map -- import Data.Time -import qualified Data.Text as T +-- import qualified Data.Text as T -- import Data.Function ((&)) -- import Colonnade hiding (fromMaybe, singleton) @@ -34,7 +34,7 @@ import Yesod.Colonnade -- import qualified Data.Conduit.List as C import qualified Database.Esqueleto as E -import qualified Database.Esqueleto.Internal.Sql as E +-- import qualified Database.Esqueleto.Internal.Sql as E import Control.Lens -- import Control.Monad.Writer (MonadWriter(..), execWriterT) @@ -42,14 +42,25 @@ import Control.Lens -- import Network.Mime +ratedBy :: E.Esqueleto query expr backend => + expr (Entity Submission) -> Key User -> expr (E.Value Bool) +ratedBy submission uid = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) + +courseIs :: E.Esqueleto query expr backend => + expr (Entity Course) -> Key Course -> expr (E.Value Bool) +courseIs course cid = course E.^. CourseId E.==. E.val cid + getCorrectionsR :: Handler Html getCorrectionsR = do uid <- requireAuthId - let tableData :: _ -> E.SqlQuery _ + let tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity Course)) + (E.SqlExpr (Entity Sheet ))) + (E.SqlExpr (Entity Submission)) + -> E.SqlQuery _ tableData (course `E.InnerJoin` sheet `E.InnerJoin` submission) = do E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse - E.where_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) + E.where_ $ submission `ratedBy` uid let crse = ( course E.^. CourseName :: E.SqlExpr (E.Value Text) , course E.^. CourseShorthand , course E.^. CourseTerm @@ -65,15 +76,15 @@ getCorrectionsR = do [ dbRow , sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(_, _, course) } -> -- cell [whamlet| _{untermKey $ course ^. _3}|] -- lange, internationale Semester - textCell $ termToText $ unTermKey $ E.unValue $ $(projNI 4 3) course -- kurze Semsterkürzel + textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(_, _, course) } -> textCell $ E.unValue $ course ^. _2 , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(_, sheet, _) } -> textCell $ sheetName $ entityVal sheet , sortable Nothing (i18nCell MsgSubmission) $ \DBRow{ dbrOutput=(submission, sheet, course) } -> cell $ do - let tid = E.unValue $ $(projNI 4 3) course - csh = E.unValue $ $(projNI 4 2) course + let tid = E.unValue $ course ^. _3 + csh = E.unValue $ course ^. _2 shn = sheetName $ entityVal sheet cid <- encrypt (entityKey submission :: SubmissionId) [whamlet|#{display cid}|] diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index aafad7369..99aa4a8e6 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -106,7 +106,7 @@ data DBRow r = DBRow } dbRow :: (Headedness h) => Colonnade h (DBRow r) (Cell site) -dbRow = Colonnade.singleton (headednessPure "nr") $ \DBRow{ dbrIndex } -> +dbRow = Colonnade.singleton (headednessPure "Nr") $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex class DBOutput r r' where diff --git a/src/Utils/Common.hs b/src/Utils/Common.hs index 3b0d537b8..8583ccf86 100644 --- a/src/Utils/Common.hs +++ b/src/Utils/Common.hs @@ -16,7 +16,7 @@ import Language.Haskell.TH -- Tuples -- ------------ - +-- Alternatively uses lenses: "^. _3" projects the 3rd component of an n-tuple for any n >=3, requires import Control.Lens projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2) --ghci -fth -- $(projN n m) :: (t1,..,tn) -> tm (for m<=n) projNI n i = lamE [pat] rhs From b2a97d926d5fc4a0038b9077c53a9cea65ce53f6 Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 22 Jun 2018 22:59:59 +0200 Subject: [PATCH 5/6] correctionsTable generalized for various purposes, but needs bigger query --- messages/de.msg | 2 + routes | 3 +- src/Handler/Corrections.hs | 112 +++++++++++++++++++++++++------------ 3 files changed, 81 insertions(+), 36 deletions(-) diff --git a/messages/de.msg b/messages/de.msg index 9ec04885d..c8f50be26 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -59,6 +59,8 @@ SubmissionFile: Datei zur Abgabe SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem bÜbungsblatt. CorrectionsTitle: Zugewiesene Korrekturen +CourseCorrectionsTitle: Korrekturen für diesen Kurs +Corrector: Korrektor EMail: E-Mail EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer. diff --git a/routes b/routes index fe3059a9d..e52904522 100644 --- a/routes +++ b/routes @@ -46,6 +46,7 @@ /course/#TermId/#Text CourseR !lecturer: /show CShowR GET POST !free /edit CEditR GET POST + /corrections CourseCorrectionsR GET /ex SheetListR GET !registered !materials !/ex/new SheetNewR GET POST /ex/#Text SheetR: @@ -69,4 +70,4 @@ -- TODO above !/#UUID CryptoUUIDDispatchR GET !free -- just redirect -!/*{CI FilePath} CryptoFileNameDispatchR GET !free \ No newline at end of file +!/*{CI FilePath} CryptoFileNameDispatchR GET !free diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index f902b90f2..458954156 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -8,6 +8,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} @@ -42,17 +43,52 @@ import Control.Lens -- import Network.Mime -ratedBy :: E.Esqueleto query expr backend => - expr (Entity Submission) -> Key User -> expr (E.Value Bool) -ratedBy submission uid = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) -courseIs :: E.Esqueleto query expr backend => - expr (Entity Course) -> Key Course -> expr (E.Value Bool) -courseIs course cid = course E.^. CourseId E.==. E.val cid +type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) => + (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission)) + -> expr (E.Value Bool) -getCorrectionsR :: Handler Html -getCorrectionsR = do - uid <- requireAuthId +ratedBy :: Key User -> CorrectionsWhere +ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) + +courseIs :: Key Course -> CorrectionsWhere +courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid + + +type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School))) + +colTerm :: Colonnade Sortable CorrectionTableData (Cell UniWorX) +colTerm = sortable (Just "term") (i18nCell MsgTerm) + $ \DBRow{ dbrOutput=(_, _, course) } -> + -- cell [whamlet| _{untermKey $ course ^. _3}|] -- lange, internationale Semester + textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel + +colCourse :: Colonnade Sortable CorrectionTableData (Cell UniWorX) +colCourse = sortable (Just "course") (i18nCell MsgCourse) + $ \DBRow{ dbrOutput=(_, _, course) } -> + textCell $ E.unValue $ course ^. _2 + +colSheet :: Colonnade Sortable CorrectionTableData (Cell UniWorX) +colSheet = sortable (Just "sheet") (i18nCell MsgSheet) + $ \DBRow{ dbrOutput=(_, sheet, _) } -> + textCell $ sheetName $ entityVal sheet + +colCorrector :: Colonnade Sortable CorrectionTableData (Cell UniWorX) +colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) + $ \DBRow{ dbrOutput=(submission, _, _) } -> + textCell $ display $ submissionRatingBy $ entityVal submission + +colSubmissionLink :: Colonnade Sortable CorrectionTableData (Cell UniWorX) +colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) + $ \DBRow{ dbrOutput=(submission, sheet, course) } -> cell $ do + let tid = E.unValue $ course ^. _3 + csh = E.unValue $ course ^. _2 + shn = sheetName $ entityVal sheet + cid <- encrypt (entityKey submission :: SubmissionId) + [whamlet|#{display cid}|] + +makeCorrectionsTable :: _ -> Colonnade Sortable CorrectionTableData (Cell UniWorX) -> _ +makeCorrectionsTable whereClause colChoices = do let tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity Sheet ))) (E.SqlExpr (Entity Submission)) @@ -60,39 +96,16 @@ getCorrectionsR = do tableData (course `E.InnerJoin` sheet `E.InnerJoin` submission) = do E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse - E.where_ $ submission `ratedBy` uid + E.where_ $ whereClause (course,sheet,submission) let crse = ( course E.^. CourseName :: E.SqlExpr (E.Value Text) , course E.^. CourseShorthand , course E.^. CourseTerm , course E.^. CourseSchool :: E.SqlExpr (E.Value SchoolId) ) return (submission, sheet, crse) - colonnade :: Colonnade Sortable (DBRow - (Entity Submission, Entity Sheet, - (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School))) - - ) (Cell UniWorX) - colonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(_, _, course) } -> - -- cell [whamlet| _{untermKey $ course ^. _3}|] -- lange, internationale Semester - textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel - , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(_, _, course) } -> - textCell $ E.unValue $ course ^. _2 - , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(_, sheet, _) } -> - textCell $ sheetName $ entityVal sheet - , sortable Nothing (i18nCell MsgSubmission) $ \DBRow{ dbrOutput=(submission, sheet, course) } -> - cell $ do - let tid = E.unValue $ course ^. _3 - csh = E.unValue $ course ^. _2 - shn = sheetName $ entityVal sheet - cid <- encrypt (entityKey submission :: SubmissionId) - [whamlet|#{display cid}|] - ] - -- TODO continue here - table <- dbTable def $ DBTable + dbTable def $ DBTable { dbtSQLQuery = tableData - , dbtColonnade = colonnade + , dbtColonnade = colChoices , dbtSorting = [ ( "term" , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseTerm ) @@ -110,6 +123,35 @@ getCorrectionsR = do , dbtAttrs = tableDefault , dbtIdent = "corrections" :: Text } + + +getCorrectionsR :: Handler Html +getCorrectionsR = do + uid <- requireAuthId + let whereClause = ratedBy uid + displayColumns = mconcat + [ dbRow + , colTerm + , colCourse + , colSheet + , colSubmissionLink + ] -- Continue here + table <- makeCorrectionsTable whereClause displayColumns + defaultLayout $ do + setTitleI MsgCourseCorrectionsTitle + $(widgetFile "corrections") + +getCourseCorrectionsR :: TermId -> Text -> Handler Html +getCourseCorrectionsR tid csh = do + cid <- runDB $ getBy404 $ CourseTermShort tid csh + let whereClause = courseIs $ entityKey cid + displayColumns = mconcat + [ dbRow + , colSheet + , colCorrector + , colSubmissionLink + ] -- Continue here + table <- makeCorrectionsTable whereClause displayColumns defaultLayout $ do setTitleI MsgCorrectionsTitle $(widgetFile "corrections") From 4d3ad78b53ed76fc7f216f8e29a1dfb1e92f473f Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 22 Jun 2018 23:08:09 +0200 Subject: [PATCH 6/6] correctionsTable features links everywhere now --- src/Handler/Corrections.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 458954156..7aa891e36 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -65,13 +65,19 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm) colCourse :: Colonnade Sortable CorrectionTableData (Cell UniWorX) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(_, _, course) } -> - textCell $ E.unValue $ course ^. _2 + $ \DBRow{ dbrOutput=(_, _, course) } -> cell $ + let tid = E.unValue $ course ^. _3 + csh = E.unValue $ course ^. _2 + in [whamlet|#{display csh}|] colSheet :: Colonnade Sortable CorrectionTableData (Cell UniWorX) colSheet = sortable (Just "sheet") (i18nCell MsgSheet) - $ \DBRow{ dbrOutput=(_, sheet, _) } -> - textCell $ sheetName $ entityVal sheet + $ \DBRow{ dbrOutput=(_, sheet, course) } -> cell $ + let tid = E.unValue $ course ^. _3 + csh = E.unValue $ course ^. _2 + shn = sheetName $ entityVal sheet + in [whamlet|#{display shn}|] + -- textCell $ sheetName $ entityVal sheet colCorrector :: Colonnade Sortable CorrectionTableData (Cell UniWorX) colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector)