minor changes toward sheet saving
This commit is contained in:
SJost
parent
40cf5ec858
commit
85f132295c
25
FragenSJ.txt
25
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?!
|
||||
|
||||
@ -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!
|
||||
|
||||
2
models
2
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user