minor changes toward sheet saving

FragenSJ.txt

@@ -1,19 +1,18 @@
 ** i18n:
-
+ - 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 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:
+   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?!

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!

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

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
 
-
+          redirect $ SheetShowR tid csh sfName
-      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
     (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
     _ -> return ()
   defaultLayout $ do

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 BtnSaveCopy = BtnSave | BtnCopy
-data StandardButton = BtnDelete | BtnAbort | BtnSave
   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
+instance Button BtnSaveCopy where
-  label BtnDelete = "Löschen"
+  label BtnSave = "Speichern"
-  label BtnAbort  = "Abbrechen"
+  label BtnCopy = "Kopieren"
-  label BtnSave   = "Speichern"
   
-  cssClass BtnDelete = BCWarning
+  cssClass BtnSave = BCPrimary
-  cssClass BtnAbort  = BCDefault
+  cssClass BtnCopy = BCDefault
-  cssClass BtnSave   = BCPrimary
+
--}
 
 data SubmitButton = BtnSubmit
   deriving (Enum, Eq, Ord, Bounded, Read, Show)

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)