From 85f132295c09f28e733443b6d463ac73a0766f72 Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 16 Mar 2018 09:05:29 +0100 Subject: [PATCH] minor changes toward sheet saving --- FragenSJ.txt | 25 ++++++++-------- messages/de.msg | 2 ++ models | 2 +- src/Handler/Sheet.hs | 60 +++++++++++++++++++++++++-------------- src/Handler/Utils/Form.hs | 21 ++++++-------- src/Model/Types.hs | 9 ++---- 6 files changed, 66 insertions(+), 53 deletions(-) diff --git a/FragenSJ.txt b/FragenSJ.txt index c9ecfa3d6..55d0bd4aa 100644 --- a/FragenSJ.txt +++ b/FragenSJ.txt @@ -1,19 +1,18 @@ ** i18n: - - - Was ist mit einfachen Text Feldern, z.B. die Beschriftung von Knöpfen wie in Handler.Course.getCourseListTermR, Zeile 66 "pageActions" für menuItemLabel? - - Was ist mit PageTitles, z.B. in Handler.Term.termEditHandler: + - i18n der Links, Page Titles und Buttons? + Was ist mit einfachen Text Feldern, z.B. die Beschriftung von Knöpfen wie in Handler.Course.getCourseListTermR, Zeile 66 "pageActions" für menuItemLabel? + Was ist mit PageTitles, z.B. in Handler.Term.termEditHandler: -- setTitle [whamlet| _{MsgTermNewTitle} |] -- TODO, does not work +** Page pageActions + - Berechtigungen prüfen? + => Eigener Constructor statt NavbarLeft/Right?! + ** FORMS + 1- Handler.Utils.Form.FormIdentifier: Still needed? + 2- Verification of Ownership during Edit? + D.h. wo wird geprüft, dass Sheet Ersteller Lecturer im Kurs ist? + 3 - Sheets: Multiple Files + - Versionen für Studenten/Korrektoren/Lecturers/Admins?! - - Handler.Utils.Form.FormIdentifier: Still needed? - - Verification of Ownership during Edit? - - Versionen für Studenten/Korrektoren/Lecturers/Admins?! - - - Sheets: Multiple Files - -** Page pageActions - - i18n der Links? - - Berechtigungen prüfen? - => Eigener Constructor statt NavbarLeft/Right?! diff --git a/messages/de.msg b/messages/de.msg index b894e9ce2..57e1f2f08 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -7,3 +7,5 @@ CourseNewOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText ti 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. +SheetNewOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Neues Übungsblatt #{sheetName} wurde im Kurs #{termToText tid}-#{courseShortHand} erfolgreich erstellt. +SheetNewDup tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{termToText tid}-#{courseShortHand} erfolgreich erstellt! diff --git a/models b/models index a2a86d9f0..4bf3e4d7f 100644 --- a/models +++ b/models @@ -98,9 +98,9 @@ Sheet type SheetType grouping SheetGroup markingText Html Maybe + visibleFrom UTCTime Maybe activeFrom UTCTime activeTo UTCTime - visibleFrom UTCTime Maybe hintFrom UTCTime Maybe solutionFrom UTCTime Maybe created UTCTime diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 9016e2a09..33ded9169 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -36,9 +36,9 @@ import Network.Mime data SheetForm = SheetForm { sfName :: Text - , sfComment :: Maybe Html + , sfDescription :: Maybe Html , sfType :: SheetType - , sfGroup :: SheetGroup + , sfGrouping :: SheetGroup , sfMarkingText :: Maybe Html , sfVisibleFrom :: Maybe UTCTime , sfActiveFrom :: UTCTime @@ -60,7 +60,7 @@ makeSheetForm cid template = identForm FIDsheet $ \html -> do <$> areq textField (fsb "Name") (sfName <$> template) <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfMarkingText <$> template) <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) - <*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGroup <$> template) + <*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template) --TODO: SICHTBARKEIT hinzunehmen <*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template) <*> aopt utcTimeField (fsb "Sichtbar ab") (sfVisibleFrom <$> template) @@ -72,6 +72,7 @@ makeSheetForm cid template = identForm FIDsheet $ \html -> do <*> aopt utcTimeField (fsb "Lösung ab") (sfSolutionFrom <$> template) <*> fileAFormOpt (fsb "Lösung") <*> aopt hiddenField "EditSheetId" (sfSheetId <$> template) + <* submitButton return $ case result of FormSuccess sheetResult | errorMsgs <- validateSheet sheetResult @@ -97,11 +98,10 @@ makeSheetForm cid template = identForm FIDsheet $ \html -> do , ( sfActiveTo >= sfActiveFrom , "Ende der Abgabefrist muss nach deren Beginn liegen." ) - -- TODO: continue here!!! + -- TODO: continue validation here!!! ] ] - fetchSheet :: TermId -> Text -> Text -> YesodDB UniWorX (Entity Sheet) fetchSheet tid csh shn = do -- TODO: More efficient with Esquleto? @@ -207,28 +207,46 @@ getSheetFileR tid csh shn typ title = do getSheetNewR :: TermId -> Text -> Handler Html getSheetNewR tid csh = do + let tident = unTermKey tid + aid <- requireAuthId + -- TODO: Verify that aid is lecturer in Course? Here or in Auth? (Entity cid course) <- runDB $ getBy404 $ CourseTermShort tid csh let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days ((res,wdgt), enc) <- runFormPost $ makeSheetForm cid template - case res of (FormSuccess SheetForm{..}) -> do + actTime <- liftIO getCurrentTime + let sheet = Sheet + { sheetCourseId = cid + , sheetName = sfName + , sheetDescription = sfDescription + , sheetType = sfType + , sheetGrouping = sfGrouping + , sheetMarkingText = sfMarkingText + , sheetVisibleFrom = sfVisibleFrom + , sheetActiveFrom = sfActiveFrom + , sheetActiveTo = sfActiveTo + , sheetHintFrom = sfHintFrom + , sheetSolutionFrom = sfSolutionFrom + , sheetCreated = actTime + , sheetChanged = actTime + , sheetCreatedBy = aid + , sheetChangedBy = aid + } + insertOkay <- runDB $ insertUnique sheet + case insertOkay of + Nothing -> addMessageI "danger" $ MsgSheetNewDup tident csh sfName + (Just sid) -> do + addMessageI "info" $ MsgSheetNewOk tident csh sfName + -- Save Files in DB: + -- Prüfe, das FileTitle innerhalb des Sheets eindeutig ist für diesen SheetFileTpye + whenIsJust sfSheetF $ \sinfo -> do + let sheetInsert file = do + fid <- insert file + void . insert $ SheetFile sid fid SheetExercise -- Uniqueness? + runDB . runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert - - let sid = undefined -- TODO after first insert - let sname = undefined -- TODO after first insert - - -- Prüfe, das FileTitle innerhalb des Sheets eindeutig ist für diesen SheetFileTpye - whenIsJust sfSheetF $ \sinfo -> do - let sheetInsert file = do - fid <- insert file - void . insert $ SheetFile sid fid SheetExercise - runDB . runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert - - - - addMessage "info" "Blatt angelegt" - redirect $ SheetShowR tid csh sname + redirect $ SheetShowR tid csh sfName (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml _ -> return () defaultLayout $ do diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 46242770b..770a7f481 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -28,7 +28,7 @@ import qualified Text.Blaze.Internal as Blaze (null) import Web.PathPieces (showToPathPiece, readFromPathPiece) ------------------------------------------------ --- Unique Form Identifiers to avoid aSccidents -- +-- Unique Form Identifiers to avoid accidents -- ------------------------------------------------ data FormIdentifier = FIDcourse | FIDsheet @@ -70,23 +70,20 @@ class (Enum a, Bounded a, Ord a, PathPiece a) => Button a where -{- Abort is not useful (press Back instead); Delete should be different: -data StandardButton = BtnDelete | BtnAbort | BtnSave +data BtnSaveCopy = BtnSave | BtnCopy deriving (Enum, Eq, Ord, Bounded, Read, Show) -instance PathPiece StandardButton where -- for displaying the button only, not really for paths +instance PathPiece BtnSaveCopy where -- for displaying the button only, not really for paths toPathPiece = showToPathPiece fromPathPiece = readFromPathPiece -instance Button StandardButton where - label BtnDelete = "Löschen" - label BtnAbort = "Abbrechen" - label BtnSave = "Speichern" +instance Button BtnSaveCopy where + label BtnSave = "Speichern" + label BtnCopy = "Kopieren" - cssClass BtnDelete = BCWarning - cssClass BtnAbort = BCDefault - cssClass BtnSave = BCPrimary --} + cssClass BtnSave = BCPrimary + cssClass BtnCopy = BCDefault + data SubmitButton = BtnSubmit deriving (Enum, Eq, Ord, Bounded, Read, Show) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 85ae9f2ee..68b30d6c9 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -62,11 +62,6 @@ data SheetGroup deriveJSON defaultOptions ''SheetGroup derivePersistFieldJSON "SheetGroup" - -data ExamStatus = Attended | NoShow | Voided - deriving (Show, Read, Eq, Ord, Enum, Bounded) -derivePersistField "ExamStatus" - data SheetFileType = SheetExercise | SheetHint | SheetSolution | SheetMarking deriving (Show, Read, Eq, Ord, Enum, Bounded) derivePersistField "SheetFileType" @@ -79,7 +74,9 @@ instance PathPiece SheetFileType where fromPathPiece t = lookup (CI.mk t) [(CI.mk $ toPathPiece ty,ty) | ty <- [minBound..maxBound]] - +data ExamStatus = Attended | NoShow | Voided + deriving (Show, Read, Eq, Ord, Enum, Bounded) +derivePersistField "ExamStatus" data Load = ByTutorial | ByProportion Double deriving (Show, Read, Eq)