diff --git a/FragenSJ.txt b/FragenSJ.txt index 793b2828b..dc6c342d5 100644 --- a/FragenSJ.txt +++ b/FragenSJ.txt @@ -7,10 +7,12 @@ - Utils.getKeyBy404 effiziente Variante, welche nur den Key liefert? Esq? (Sheet.hs -> fetchSheet) - - Handler.Sheet.postSheetDelR: deleteCascade für Files? + - Handler.Sheet.postSheetDelR: deleteCascade für Files? Klappt das? - Verständnis: Getrennte Handler get/post Handler in SheetEditR haben nicht funktioniert. Warum? + - Sheets.redirectBack(): Wollen wir das wirklich? Schöner? + ** i18n: - i18n der Links -> MenuItems verwenden wie bisher diff --git a/messages/de.msg b/messages/de.msg index 786f91b0c..2c4c3b219 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -10,7 +10,7 @@ CourseEditDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText ti 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 -SheetEditOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{termToText tid}-#{courseShortHand} wurde bearbeitet. +SheetEditOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{termToText tid}-#{courseShortHand} wurde gespeichert. SheetNameDup tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{termToText tid}-#{courseShortHand}. SheetDelTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} wirklich aus Kurs #{termToText tid}-#{courseShortHand} herauslöschen? SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{show submissionNo} Abgaben. diff --git a/src/Foundation.hs b/src/Foundation.hs index e1abfb272..b2f2c7eb2 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -267,8 +267,11 @@ instance YesodBreadcrumbs UniWorX where breadcrumb CourseNewR = return ("Neu", Just CourseListR) breadcrumb (CourseEditR _ _) = return ("Editieren", Just CourseListR) - breadcrumb (SheetListR tid csh) = return ("Kurs", Just $ CourseShowR tid csh) - breadcrumb (SheetShowR tid csh _shn) = return ("Übungen", Just $ SheetListR tid csh) + breadcrumb (SheetListR tid csh) = return ("Übungen",Just $ CourseShowR tid csh) + breadcrumb (SheetNewR tid csh) = return ("Neu", Just $ SheetListR tid csh) + breadcrumb (SheetShowR tid csh shn) = return (shn, Just $ SheetListR tid csh) + breadcrumb (SheetEditR tid csh shn) = return ("Edit", Just $ SheetShowR tid csh shn) + breadcrumb (SheetDelR tid csh shn) = return ("DELETE", Just $ SheetShowR tid csh shn) breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) breadcrumb (SubmissionR _) = return ("Abgabe", Just SubmissionListR) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 80da98640..5b7bdc2c4 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -65,7 +65,7 @@ makeSheetForm template = identForm FIDsheet $ \html -> do -- Erstmal nur mit ZIP arbeiten (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm <$> areq textField (fsb "Name") (sfName <$> template) - <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfMarkingText <$> template) + <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfDescription <$> template) <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) <*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template) <*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template) @@ -145,7 +145,8 @@ getSheetList courseEnt = do , headed "Korrigiert" $ toWgt . snd . trd3 , headed "Eingereicht" $ toWgt . fst . trd3 -- TODO: only show edit button for allowed course assistants - , headed "" $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ sheetName $ snd3 s + , headed "" $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ sheetName $ snd3 s + , headed "" $ \s -> linkButton "Delete" BCLink $ SheetDelR tid csh $ sheetName $ snd3 s ] let pageActions = [ NavbarLeft $ MenuItem @@ -209,131 +210,23 @@ getSheetFileR tid csh shn typ title = do [] -> notFound _other -> error "Multiple matching files found." -{- + getSheetNewR :: TermId -> Text -> Handler Html getSheetNewR tid csh = do - let tident = unTermKey tid - aid <- requireAuthId - (Entity cid course) <- runDB $ getBy404 $ CourseTermShort tid csh let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days - ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm cid template - case res of - (FormSuccess SheetForm{..}) -> do - actTime <- liftIO getCurrentTime - let newSheet = 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 - } - saveOkay <- runDB $ do - insertOkay <- insertUnique newSheet - case insertOkay of - Nothing -> insertOkay <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName) - (Just sid) -> do - -- Save Files in DB: - whenIsJust sfSheetF $ insertSheetFile sid SheetExercise - whenIsJust sfHintF $ insertSheetFile sid SheetHint - whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution - addMessageI "info" $ MsgSheetNewOk tident csh sfName - return insertOkay - when (isJust saveOkay) $ redirect $ SheetShowR tid csh sfName - (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml - _ -> return () - let formTitle = "Neues Übungsblatt anlegen" :: Text - let actionUrl = SheetNewR tid csh - -- actionUrl <- getCurrentRoute - defaultLayout $ do - setTitleI $ MsgSheetTitle tident csh "NEW" - $(widgetFile "formPage") + let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing + insertUnique $ newSheet + handleSheetEdit tid csh template action postSheetNewR :: TermId -> Text -> Handler Html postSheetNewR = getSheetNewR -getSheetEditR :: TermId -> Text -> SheetId -> Handler Html -getSheetEditR tid csh sid = do - let tident = unTermKey tid - aid <- requireAuthId - sheet@(Sheet {..}) <- runDB $ get404 sid - let template = Just $ SheetForm - { sfName = sheetName - , sfDescription = sheetDescription - , sfType = sheetType - , sfGrouping = sheetGrouping - , sfMarkingText = sheetMarkingText - , sfVisibleFrom = sheetVisibleFrom - , sfActiveFrom = sheetActiveFrom - , sfActiveTo = sheetActiveTo - , sfSheetF = Nothing -- TODO - , sfHintFrom = sheetHintFrom - , sfHintF = Nothing -- TODO - , sfSolutionFrom = sheetSolutionFrom - , sfSolutionF = Nothing -- TODO - } - ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm sheetCourseId template - case res of - (FormSuccess SheetForm{..}) -> do - actTime <- liftIO getCurrentTime - let newSheet = Sheet - { sheetCourseId = sheetCourseId -- Bad puns? - , sheetName = sfName - , sheetDescription = sfDescription - , sheetType = sfType - , sheetGrouping = sfGrouping - , sheetMarkingText = sfMarkingText - , sheetVisibleFrom = sfVisibleFrom - , sheetActiveFrom = sfActiveFrom - , sheetActiveTo = sfActiveTo - , sheetHintFrom = sfHintFrom - , sheetSolutionFrom = sfSolutionFrom - , sheetCreated = sheetCreated -- Bad puns? - , sheetChanged = actTime - , sheetCreatedBy = sheetChangedBy -- Bad puns? - , sheetChangedBy = aid - } - saveOkay <- runDB $ do - addMessage "debug" "Attempting update!" - insertOkay <- myReplaceUnique sid newSheet - case insertOkay of - (Just _) -> insertOkay <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName) - Nothing -> do - -- Save Files in DB: - whenIsJust sfSheetF $ insertSheetFile sid SheetExercise - whenIsJust sfHintF $ insertSheetFile sid SheetHint - whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution - addMessageI "info" $ MsgSheetEditOk tident csh sfName - return insertOkay - when (isJust saveOkay) $ redirect $ SheetShowR tid csh sfName - (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml - _ -> return () - let formTitle = "Übungsblatt bearbeiten" :: Text - let actionUrl = SheetEditR tid csh sid - -- actionUrl <- getCurrentRoute - defaultLayout $ do - setTitleI $ MsgSheetTitle tident csh sheetName - $(widgetFile "formPage") --} - -getSheetNewR :: TermId -> Text -> Handler Html -getSheetNewR tid csh = do - let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days - handleSheetEdit tid csh Nothing (error "No DBActione expected") -- TODO getSheetEditR :: TermId -> Text -> Text -> Handler Html getSheetEditR tid csh shn = do sheetEnt <- runDB $ fetchSheet tid csh shn - let sheet@(Sheet {..}) = entityVal sheetEnt + let sid = entityKey sheetEnt + let oldSheet@(Sheet {..}) = entityVal sheetEnt let template = Just $ SheetForm { sfName = sheetName , sfDescription = sheetDescription @@ -349,26 +242,18 @@ getSheetEditR tid csh shn = do , sfSolutionFrom = sheetSolutionFrom , sfSolutionF = Nothing -- TODO } - handleSheetEdit tid csh Nothing (error "No DBActione expected") -- TODO - -postSheetNewR :: TermId -> Text -> Handler Html -postSheetNewR tid csh = do - let action newSheet = insertUnique $ newSheet - -- More specific error message for new sheet could go here, if insertUnique returns Nothing - handleSheetEdit tid csh Nothing action - -postSheetEditR :: TermId -> Text -> Text -> Handler Html -postSheetEditR tid csh shn = do let action newSheet = do - Entity { entityKey=sid, entityVal=oldSheet } <- fetchSheet tid csh shn - replaceRes <- myReplaceUnique sid $! newSheet - { sheetCourseId = sheetCourseId oldSheet - , sheetCreated = sheetCreated oldSheet - , sheetCreatedBy = sheetChangedBy oldSheet } + replaceRes <- myReplaceUnique sid $ newSheet + { sheetCourseId = sheetCourseId + , sheetCreated = sheetCreated + , sheetCreatedBy = sheetChangedBy } case replaceRes of Nothing -> return $ Just sid (Just _err) -> return $ Nothing -- More specific error message for edit old sheet could go here - handleSheetEdit tid csh Nothing action + handleSheetEdit tid csh template action + +postSheetEditR :: TermId -> Text -> Text -> Handler Html +postSheetEditR = getSheetEditR handleSheetEdit :: TermId -> Text -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html handleSheetEdit tid csh template dbAction = do @@ -431,9 +316,9 @@ getSheetDelR tid csh shn = do runDB $ do -- (Entity cid _course) <- getBy404 $ CourseTermShort tid csh cid <- getKeyBy404 $ CourseTermShort tid csh + sid <- getKeyBy404 $ CourseSheet cid shn -- deleteBy $ CourseSheet cid shn - -- TODO: deleteCascade um ggf. SheetFiles und Dateien zu löschen! - return () + deleteCascade sid setMessageI $ MsgSheetDelOk tident csh shn redirect $ SheetListR tid csh _other -> do @@ -463,6 +348,7 @@ insertSheetFile sid ftype finfo = do redirectBack :: Handler Html -- -- redirectBack :: HandlerT UniWorX IO Html redirectBack = defaultLayout $ do - [whamlet| BACK |] --- -- [julius| window.history.back(); |] + toWidget [julius| window.history.go(-2); |] + [whamlet| BACK |] -- TODO +