Initial Stubs

messages/uniworx/de.msg

@@ -166,7 +166,7 @@ SheetName: Name
 SheetDescription: Hinweise für Teilnehmer
 SheetGroup: Gruppenabgabe
 SheetVisibleFrom: Sichtbar für Teilnehmer ab
-SheetVisibleFromTip: Ohne Datum nie sichtbar und keine Abgabe möglich; nur für unfertige Blätter leer lassen, deren Fristen/Bewertung sich noch ändern kann
+SheetVisibleFromTip: Ohne Datum nie sichtbar und keine Abgabe möglich; nur für unfertige Blätter leer lassen, deren Bewertung/Fristen sich noch ändern können
 SheetActiveFrom: Beginn Abgabezeitraum
 SheetActiveFromTip: Download der Aufgabenstellung erst ab diesem Datum möglich
 SheetActiveTo: Ende Abgabezeitraum
@@ -208,6 +208,17 @@ CourseCorrectionsTitle: Korrekturen für diesen Kurs
 CorrectorsHead sheetName@SheetName: Korrektoren für #{sheetName}
 CorrectorAssignTitle: Korrektor zuweisen
 
+MaterialName: Name
+MaterialType: Art
+MaterialTypePlaceholder: Folien, Code, Beispiel, ...
+MaterialTypeSlides: Folien
+MaterialTypeCode: Code
+MaterialTypeExample: Beispiel
+MaterialDescription: Beschreibung
+MaterialVisibleFrom: Sichtbar für Teilnehmer ab
+MaterialVisibleFromTip: Ohne Datum nie sichtbar für Teilnehmer; leer lassen ist nur sinnvoll für unfertige Materialien oder zur ausschließlichen Verteilung an Korrektoren
+MaterialFiles: Dateien
+
 
 Unauthorized: Sie haben hierfür keine explizite Berechtigung.
 UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})

models/materials

@@ -0,0 +1,11 @@
+Material -- course material for disemination to course participants
+  course          CourseId
+  name            (CI Text)
+  type            Text Maybe
+  description     Html Maybe
+  visibleFrom     UTCTime Maybe    -- Invisible to enrolled participants before
+  lastEdit        UTCTime
+  UniqueMaterial course name
+MaterialFile -- a file that is part of a material distribution
+  material MaterialId
+  file     FileId

routes

@@ -13,7 +13,7 @@
 --    !free           -- free for all
 --    !lecturer       -- lecturer    for this course (or for any school, if route is not connected to a course)
 --    !corrector      -- corrector   for this sheet  (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course)
---    !registered     -- participant for this course (no effect outside of courses)
+--    !registered     -- current user is participant for this course (no effect outside of courses)
 --    !participant    -- connected with a given course (not necessarily registered), i.e. has a submission, is a corrector, etc. (no effect outside of courses)
 --    !owner          -- part of the group of owners of this submission
 --    !self           -- route refers to the currently logged in user themselves
@@ -106,7 +106,12 @@
     /pseudonym                  SPseudonymR   GET POST        !registeredANDcorrector-submissions
     /corrector-invite/#UserEmail SCorrInviteR     GET POST
     !/#SheetFileType/*FilePath  SFileR        GET             !timeANDregistered !timeANDmaterials !corrector
-
+  /mat                          MaterialListR GET             !materials !registered !corrector
+  /mat/new                      MaterialNewR  GET POST
+  /mat/#MaterialName MaterialR:
+    /show                       MShowR        GET             !timeANDregistered !timeANDmaterials !corrector
+    /edit                       MEditR        GET POST
+    /delete                     MDelR         GET POST
 
 /subs  CorrectionsR GET POST !corrector !lecturer
 /subs/upload CorrectionsUploadR GET POST !corrector !lecturer

src/Application.hs

@@ -87,6 +87,7 @@ import Handler.Course
 import Handler.Sheet
 import Handler.Submission
 import Handler.Corrections
+import Handler.Material
 import Handler.CryptoIDDispatch
 import Handler.SystemMessage
 

src/Handler/Material.hs

@@ -0,0 +1,73 @@
+module Handler.Material where
+
+import Import
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Conduit.List as C
+
+import qualified Database.Esqueleto as E
+
+import Utils.Lens
+import Utils.Form
+import Handler.Utils.Form
+
+
+data MaterialForm = MaterialForm  {
+        mfName         :: MaterialName
+      , mfType         :: Maybe Text
+      , mfDescription  :: Maybe Html
+      , mfVisibleFrom  :: Maybe UTCTime
+      , mfFiles        :: Maybe (Source Handler (Either FileId File))
+      }
+
+makeMaterialForm :: CourseId -> Maybe MaterialForm -> Form MaterialForm
+makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
+  MsgRenderer mr <- getMsgRenderer
+  let setIds :: Either FileId File -> Set FileId
+      setIds = either Set.singleton $ const Set.empty
+      oldFileIds
+        | Just source <- template >>= mfFiles
+                    = runConduit $ source .| C.foldMap setIds
+        | otherwise = return Set.empty
+      typeOptions :: WidgetT UniWorX IO (Set Text)
+      typeOptions = do
+        let defaults = Set.fromList $ map mr [MsgMaterialTypeSlides,MsgMaterialTypeCode,MsgMaterialTypeExample]
+        previouslyUsed <- liftHandlerT . runDB $
+          E.select $ E.from $ \material ->
+            E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do
+              E.where_ $ (material E.^. MaterialCourse E.==. E.val cid)
+                  E.&&.  (E.not_ $ E.isNothing $ material E.^. MaterialType)
+              return $ material E.^. MaterialType
+        return $ defaults <> (Set.fromList $ mapMaybe E.unValue previouslyUsed)
+
+  ctime <- liftIO $ getCurrentTime
+  flip (renderAForm FormStandard) html $ MaterialForm
+      <$> areq ciField        (fslI MsgMaterialName)         (mfName        <$> template)
+      <*> aopt (textField & addDatalist typeOptions)
+                              (fslpI MsgMaterialType $ mr MsgMaterialTypePlaceholder)
+                                                             (mfType        <$> template)
+      <*> aopt htmlField      (fslpI MsgMaterialDescription "Html")
+                                                             (mfDescription <$> template)
+      <*> aopt utcTimeField   (fslI MsgMaterialVisibleFrom
+            & setTooltip MsgMaterialVisibleFromTip)          ((mfVisibleFrom  <$> template) <|> pure (Just ctime))
+      <*> aopt (multiFileField oldFileIds)
+                              (fslI MsgMaterialFiles)        (mfFiles <$> template)
+
+getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getMaterialListR = error "unimplemented" -- TODO
+
+getMaterialNewR, postMaterialNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getMaterialNewR = postMaterialNewR
+postMaterialNewR = error "unimplemented" -- TODO
+
+getMShowR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
+getMShowR = error "unimplemented" -- TODO
+
+getMEditR, postMEditR :: TermId -> SchoolId -> CourseShorthand ->  MaterialName -> Handler Html
+getMEditR = postMEditR
+postMEditR = error "unimplemented" -- TODO
+
+getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand ->  MaterialName -> Handler Html
+getMDelR = postMDelR
+postMDelR = error "unimplemented" -- TODO

src/Handler/Sheet.hs

@@ -99,7 +99,8 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
     ctime <- liftIO $ getCurrentTime
     (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
       <$> areq ciField        (fslI MsgSheetName)         (sfName        <$> template)
-      <*> aopt htmlField      (fslI MsgSheetDescription)  (sfDescription <$> template)
+      <*> aopt htmlField      (fslpI MsgSheetDescription "Html")
+                                                          (sfDescription <$> template)
       <*> sheetTypeAFormReq   (fslI MsgSheetType
             & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded]))
                                                           (sfType        <$> template)

src/Model/Types.hs

@@ -880,6 +880,7 @@ type SchoolShorthand = CI Text
 type CourseName      = CI Text
 type CourseShorthand = CI Text
 type SheetName       = CI Text
+type MaterialName    = CI Text
 type UserEmail       = CI Email
 
 type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString

src/Utils/Form.hs

@@ -168,6 +168,7 @@ data FormIdentifier
   = FIDcourse
   | FIDcourseRegister
   | FIDsheet
+  | FIDmaterial
   | FIDsubmission
   | FIDsettings
   | FIDcorrectors