Initial Stubs
This commit is contained in:
Steffen Jost
parent
530eb09ebb
commit
d5e1c92794
@ -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})
|
||||
|
||||
11
models/materials
Normal file
11
models/materials
Normal file
@ -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
|
||||
9
routes
9
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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
73
src/Handler/Material.hs
Normal file
73
src/Handler/Material.hs
Normal file
@ -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
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -168,6 +168,7 @@ data FormIdentifier
|
||||
= FIDcourse
|
||||
| FIDcourseRegister
|
||||
| FIDsheet
|
||||
| FIDmaterial
|
||||
| FIDsubmission
|
||||
| FIDsettings
|
||||
| FIDcorrectors
|
||||
|
||||
Reference in New Issue
Block a user