From d696c7375ee398f6d5642f8d91ef013a7a791b2b Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 21 Sep 2018 08:31:18 +0200 Subject: [PATCH] Code cleaning and bug fixes towards #187 --- messages/uniworx/de.msg | 42 +++++++++++++------------ src/Handler/Course.hs | 69 ++++++++++++++++++++++++++++------------- src/Utils.hs | 13 ++++++-- src/Utils/DB.hs | 5 ++- 4 files changed, 84 insertions(+), 45 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 2d639b739..dd2b2d0f4 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -41,10 +41,10 @@ CourseRegisterOk: Sie wurden angemeldet CourseDeregisterOk: Sie wurden abgemeldet CourseSecretWrong: Falsches Kennwort CourseSecret: Zugangspasswort -CourseNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde erfolgreich erstellt. -CourseEditOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde erfolgreich geändert. -CourseNewDupShort tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. -CourseEditDupShort tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. +CourseNewOk tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} wurde erfolgreich erstellt. +CourseEditOk tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} wurde erfolgreich geändert. +CourseNewDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester. +CourseEditDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester. FFSheetName: Name TermCourseListHeading tid@TermId: Kursübersicht #{display tid} TermSchoolCourseListHeading tid@TermId school@SchoolName: Kursübersicht #{display tid} für #{display school} @@ -52,7 +52,7 @@ CourseListTitle: Alle Kurse TermCourseListTitle tid@TermId: Kurse #{display tid} TermSchoolCourseListTitle tid@TermId school@SchoolName: Kurse #{display tid} für #{display school} CourseNewHeading: Neuen Kurs anlegen -CourseEditHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} editieren +CourseEditHeading tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} editieren CourseEditTitle: Kurs editieren/anlegen CourseMembers: Teilnehmer CourseMembersCount num@Int64: #{display num} @@ -71,19 +71,23 @@ CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein +NoSuchTerm tid@TermId: Semester #{display tid} gibt es nicht. +NoSuchSchool ssh@SchoolId: Institut #{display ssh} gibt es nicht. +NoSuchCourseShorthand csh@CourseShorthand: Kein Kurs mit Kürzel #{display csh} bekannt. +NoSuchCourse: Keinen passenden Kurs gefunden. Sheet: Blatt -SheetList tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Übersicht Übungsblätter -SheetNewHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Neues Übungsblatt anlegen -SheetNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{sheetName} wurde als neues Übungsblatt im Kurs #{display tid}-#{display ssh}-#{courseShortHand} erfolgreich erstellt. -SheetTitle tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} -SheetTitleNew tid@TermId ssh@SchoolId courseShortHand@CourseShorthand : #{display tid}-#{display ssh}-#{courseShortHand}: Neues Übungsblatt -SheetEditHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} editieren -SheetEditOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde gespeichert. -SheetNameDup tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{courseShortHand}. -SheetDelHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} herauslöschen? +SheetList tid@TermId ssh@SchoolId csh@CourseShorthand: #{display tid}-#{display ssh}-#{csh} Übersicht Übungsblätter +SheetNewHeading tid@TermId ssh@SchoolId csh@CourseShorthand: #{display tid}-#{display ssh}-#{csh} Neues Übungsblatt anlegen +SheetNewOk tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{sheetName} wurde als neues Übungsblatt im Kurs #{display tid}-#{display ssh}-#{csh} erfolgreich erstellt. +SheetTitle tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh} #{sheetName} +SheetTitleNew tid@TermId ssh@SchoolId csh@CourseShorthand : #{display tid}-#{display ssh}-#{csh}: Neues Übungsblatt +SheetEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh} #{sheetName} editieren +SheetEditOk tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} aus Kurs #{display tid}-#{display ssh}-#{csh} wurde gespeichert. +SheetNameDup tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{csh}. +SheetDelHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{csh} herauslöschen? SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{display submissionNo} Abgaben. -SheetDelOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand}: #{sheetName} gelöscht. +SheetDelOk tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh}: #{sheetName} gelöscht. SheetUploadMode: Abgabe von Dateien SheetExercise: Aufgabenstellung @@ -117,12 +121,12 @@ Deadline: Abgabe Done: Eingereicht Submission: Abgabenummer -SubmissionsCourse tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Alle Abgaben Kurs #{display tid}-#{display ssh}-#{courseShortHand} +SubmissionsCourse tid@TermId ssh@SchoolId csh@CourseShorthand: Alle Abgaben Kurs #{display tid}-#{display ssh}-#{csh} SubmissionsSheet sheetName@SheetName: Abgaben für #{sheetName} SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt. SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt. -SubmissionEditHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen -CorrectionHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}: Korrektur +SubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Abgabe editieren/anlegen +CorrectionHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Korrektur SubmissionMember g@Int: Mitabgebende(r) ##{display g} SubmissionArchive: Zip-Archiv der Abgabedatei(en) SubmissionFile: Datei zur Abgabe @@ -164,7 +168,7 @@ TooManyParticipants: Es wurden zu viele Mitabgebende angegeben AddCorrector: Zusätzlicher Korrektor CorrectorExists email@UserEmail: #{email} ist bereits als Korrektor eingetragen -SheetCorrectorsTitle tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Korrektoren für #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} +SheetCorrectorsTitle tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Korrektoren für #{display tid}-#{display ssh}-#{csh} #{sheetName} CountTutProp: Tutorien zählen gegen Proportion Corrector: Korrektor Correctors: Korrektoren diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 758ff76d9..492995e80 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -20,6 +20,7 @@ import Import import Control.Lens import Utils.Lens import Utils.TH +-- import Utils.DB import Handler.Utils import Handler.Utils.Table.Cells @@ -28,6 +29,7 @@ import qualified Data.Text as T import Data.Function ((&)) -- import Yesod.Form.Bootstrap3 +import Data.Maybe import qualified Data.Set as Set import qualified Data.Map as Map @@ -317,28 +319,51 @@ getCourseNewR = do params <- runInputGetResult $ (,,) <$> ireq ciTextField "csh" <*> iopt textField "tid" - <*> iopt ciTextField "sid" - template <- case params of - FormMissing -> return Nothing - FormFailure [] -> return Nothing - FormFailure msgs -> forM_ msgs ((addMessage "error") . toHtml) >> return Nothing - FormSuccess (csh,mbTid,mbSid) -> do - oldCourses <- runDB $ do - E.select $ E.from $ \(course `E.InnerJoin` lecturer) -> do - E.on $ course E.^. CourseSchool E.==. lecturer E.^. UserLecturerSchool - E.where_ $ course E.^. CourseShorthand E.==. E.val csh - E.&&. lecturer E.^. UserLecturerUser E.==. E.val uid -- only search courses for lecturer's school (admin does not help here) - whenIsJust (SchoolKey <$> mbSid) $ - \sid -> E.where_ $ course E.^. CourseSchool E.==. E.val sid - whenIsJust (mbTid >>= tidFromText) $ - \tid -> E.where_ $ course E.^. CourseTerm E.==. E.val tid - let courseCreated c = E.sub_select . E.from $ \edit -> do - E.where_ $ edit E.^. CourseEditCourse E.==. c E.^. CourseId - return $ E.min_ $ edit E.^. CourseEditTime -- oldest edit must be creation - E.orderBy [E.desc $ courseCreated course] -- most recent courses - E.limit 1 - return course - return $ listToMaybe oldCourses + <*> iopt ciTextField "ssh" + let noTemplateAction = courseEditHandler True Nothing + case params of + FormMissing -> noTemplateAction + FormFailure msgs -> forM_ msgs ((addMessage "error") . toHtml) + >> noTemplateAction + FormSuccess (csh,mbTid,mbSsh) -> do + tid <- ifJustM Nothing mbTid $ \tid -> + case termFromText tid of + Left err -> addMessage "error" (toHtml err) >> return Nothing + Right t -> return $ Just $ TermKey t + getCourseNewTemplateR tid (SchoolKey <$> mbSsh) csh + +getCourseNewTemplateR :: Maybe TermId -> Maybe SchoolId -> CourseShorthand -> Handler Html +getCourseNewTemplateR mbTid mbSsh csh = do + uid <- requireAuthId + oldCourses <- runDB $ do + E.select $ E.from $ \(course) -> do + E.where_ $ course E.^. CourseShorthand E.==. E.val csh + whenIsJust mbSsh $ \ssh -> E.where_ $ course E.^. CourseSchool E.==. E.val ssh + whenIsJust mbTid $ \tid -> E.where_ $ course E.^. CourseTerm E.==. E.val tid + let lecturersSchool = + E.exists $ E.from $ \lecturer -> do + E.where_ $ lecturer E.^. UserLecturerUser E.==. E.val uid + E.&&. lecturer E.^. UserLecturerSchool E.==. course E.^. CourseSchool + let courseCreated c = + E.sub_select . E.from $ \edit -> do -- oldest edit must be creation + E.where_ $ edit E.^. CourseEditCourse E.==. c E.^. CourseId + return $ E.min_ $ edit E.^. CourseEditTime + E.orderBy [ E.desc $ E.case_ [(lecturersSchool, E.val (1 :: Int64))] (E.val 0) -- prefer schools of lecturer + , E.desc $ courseCreated course] -- most recent created course + E.limit 1 + return course + template <- case listToMaybe oldCourses of + t@(Just _) -> return t -- TODO: modify template, eg. current TID + Nothing -> do + (tidOk,sshOk,cshOk) <- runDB $ (,,) + <$> ifJustM True mbTid existsKey + <*> ifJustM True mbSsh existsKey + <*> ((not . null) <$> selectKeysList [CourseShorthand ==. csh] [LimitTo 1]) + unless tidOk $ addMessageI "warning" $ MsgNoSuchTerm $ fromJust mbTid -- safe, since tidOk==True otherwise + unless sshOk $ addMessageI "warning" $ MsgNoSuchSchool $ fromJust mbSsh -- safe, since tidOk==True otherwise + unless cshOk $ addMessageI "warning" $ MsgNoSuchCourseShorthand csh + when (tidOk && sshOk && cshOk) $ addMessageI "warning" MsgNoSuchCourse + return Nothing courseEditHandler True template postCourseNewR :: Handler Html diff --git a/src/Utils.hs b/src/Utils.hs index 68e449618..f28bc9062 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -300,6 +300,13 @@ whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenIsJust (Just x) f = f x whenIsJust Nothing _ = return () +ifJustM :: Monad m => b -> Maybe a -> (a -> m b) -> m b +ifJustM dft Nothing _ = return dft +ifJustM _ (Just x) act = act x + +maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b +maybeM dft act mb = mb >>= maybe dft act + maybeT :: Monad m => m a -> MaybeT m a -> m a maybeT x m = runMaybeT m >>= maybe x return @@ -323,9 +330,9 @@ instance Ord a => Ord (NTop (Maybe a)) where ------------ --- Maybe -- ------------ +------------ +-- Either -- +------------ maybeLeft :: Either a b -> Maybe a maybeLeft (Left a) = Just a diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs index ce23adae7..380bb8b2a 100644 --- a/src/Utils/DB.hs +++ b/src/Utils/DB.hs @@ -37,8 +37,11 @@ getKeyBy404 = (fmap entityKey) . getBy404 -- TODO optimize this, so that DB does existsBy :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m) => Unique record -> ReaderT backend m Bool -existsBy = fmap isJust . getBy +existsBy = fmap isJust . getBy -- TODO optimize, so that DB does not deliver entire record +existsKey :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistStoreRead backend, MonadIO m) + => Key record -> ReaderT backend m Bool +existsKey = fmap isJust . get -- TODO optimize, so that DB does not deliver entire record myReplaceUnique -- Identical to Database.Persist.Class, except for the better type signature (original requires Eq record which is not needed anyway) :: (MonadIO m