diff --git a/messages/de.msg b/messages/de.msg index c007a0a72..561b1a5da 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,12 +9,13 @@ 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 @@ -51,6 +52,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 @@ -59,6 +61,10 @@ SubmissionArchive: Zip-Archiv der Abgabedatei(en) 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. NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs #{termToText tid}-#{csh} angemeldet. @@ -86,3 +92,5 @@ SheetSolution: Lösung SheetMarking: Korrekturhinweise MultiFileUploadInfo: (Mehrere Dateien mit Shift oder Strg auswählen) + +NrColumn: Nr \ No newline at end of file diff --git a/routes b/routes index 9b4631aa7..3cfd1e43d 100644 --- a/routes +++ b/routes @@ -49,6 +49,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: @@ -60,6 +61,7 @@ !/sub/own SubmissionOwnR GET !free !/sub/#CryptoFileNameSubmission SubmissionR GET POST !owner !corrector +/corrections CorrectionsR GET !free -- TODO below !/#{ZIPArchiveName SubmissionId} SubmissionDownloadArchiveR GET !deprecated diff --git a/src/Application.hs b/src/Application.hs index a671b5296..3f7d3139a 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -48,6 +48,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 2b9b52699..28ae4faa4 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 @@ -693,6 +701,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/Corrections.hs b/src/Handler/Corrections.hs new file mode 100644 index 000000000..ecee27274 --- /dev/null +++ b/src/Handler/Corrections.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} +{-# 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 + + + +type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) => + (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission)) + -> expr (E.Value Bool) + +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 _ CorrectionTableData _ +colTerm = widgetColonnade $ 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 _ CorrectionTableData _ +colCourse = widgetColonnade $ sortable (Just "course") (i18nCell MsgCourse) + $ \DBRow{ dbrOutput=(_, _, course) } -> cell $ + let tid = E.unValue $ course ^. _3 + csh = E.unValue $ course ^. _2 + in [whamlet|#{display csh}|] + +colSheet :: Colonnade _ CorrectionTableData _ +colSheet = widgetColonnade $ sortable (Just "sheet") (i18nCell MsgSheet) + $ \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 _ CorrectionTableData _ +colCorrector = widgetColonnade $ sortable (Just "corrector") (i18nCell MsgCorrector) + $ \DBRow{ dbrOutput=(submission, _, _) } -> + textCell $ display $ submissionRatingBy $ entityVal submission + +colSubmissionLink :: Colonnade _ CorrectionTableData _ +colSubmissionLink = widgetColonnade $ 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 whereClause colChoices = do + 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_ $ 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) + dbTable def $ DBTable + { dbtSQLQuery = tableData + , dbtColonnade = colChoices + , 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 + } + + +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") + + diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 229aeda10..d847acbd3 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 bb1f621fd..478bd58ff 100644 --- a/src/Handler/Utils/Table.hs +++ b/src/Handler/Utils/Table.hs @@ -35,9 +35,6 @@ 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 () @@ -94,3 +91,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 fff153338..4203f4029 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 @@ -18,14 +19,14 @@ module Handler.Utils.Table.Pagination ( SortColumn(..), SortDirection(..) , FilterColumn(..), IsFilterColumn - , DBRow(..), DBOutput + , DBRow(..), dbRow, DBOutput , DBTable(..), IsDBTable(..) , PaginationSettings(..) , PSValidator(..) , Sortable(..), sortable , dbTable , widgetColonnade, formColonnade - , textCell, stringCell, anchorCell + , textCell, stringCell, i18nCell, anchorCell , formCell, DBFormResult, getDBFormResult ) where @@ -55,6 +56,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 Text.Hamlet (hamletFile) @@ -112,6 +114,9 @@ data DBRow r = DBRow , dbrOutput :: r } +dbRow :: (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a) +dbRow = Colonnade.singleton (headednessPure $ textCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex + class DBOutput r r' where dbProj :: r -> r' @@ -331,8 +336,9 @@ formColonnade :: (Headedness h, Monoid a) -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a)) formColonnade = id -textCell, stringCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a +textCell, stringCell, i18nCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a stringCell = textCell +i18nCell = textCell textCell msg = cell [whamlet|_{msg}|] anchorCell :: IsDBTable m a 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 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} diff --git a/templates/table/colonnade.hamlet b/templates/table/colonnade.hamlet index dc27d91ce..147cdebc7 100644 --- a/templates/table/colonnade.hamlet +++ b/templates/table/colonnade.hamlet @@ -4,7 +4,8 @@ $newline never $forall widget <- wHeaders' - ^{widget} $# cell/header.hamlet + $# cell/header.hamlet + ^{widget} $nothing $if null wRows @@ -15,4 +16,5 @@ $newline never $forall row <- wRows $forall widget <- row - ^{widget} $# cell/body.hamlet + $# cell/body.hamlet + ^{widget}