fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Stubs expanded

Browse Source
This commit is contained in:
Steffen Jost 2019-04-27 20:33:28 +02:00
parent 0d4d4a16bf
commit 212533d88e
2 changed files with 59 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/de.msg
View File

@ -218,6 +218,10 @@ MaterialDescription: Beschreibung
MaterialVisibleFrom: Sichtbar für Teilnehmer ab 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 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 MaterialFiles: Dateien
MaterialNewHeading: Neues Material veröffentlichen
MaterialNewTitle: Neues Material
MaterialEditHeading name@Text: Material "#{name}" editieren
MaterialEditTitle name@Text: Material "#{name}" editieren
Unauthorized: Sie haben hierfür keine explizite Berechtigung. Unauthorized: Sie haben hierfür keine explizite Berechtigung.

62
src/Handler/Material.hs
View File

@ -5,6 +5,7 @@ import Import
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Conduit.List as C import qualified Data.Conduit.List as C
import qualified Data.CaseInsensitive as CI
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
@ -13,8 +14,8 @@ import Utils.Form
import Handler.Utils import Handler.Utils
data MaterialForm = MaterialForm { data MaterialForm = MaterialForm
mfName :: MaterialName { mfName :: MaterialName
, mfType :: Maybe Text , mfType :: Maybe Text
, mfDescription :: Maybe Html , mfDescription :: Maybe Html
, mfVisibleFrom :: Maybe UTCTime , mfVisibleFrom :: Maybe UTCTime
@ -57,16 +58,63 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR = error "unimplemented" -- TODO 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 :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMShowR = error "unimplemented" -- TODO getMShowR = error "unimplemented" -- TODO
getMEditR, postMEditR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html getMEditR, postMEditR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMEditR = postMEditR getMEditR = postMEditR
postMEditR = error "unimplemented" -- TODO postMEditR tid ssh csh mnm = do
(cid, Entity mid Material{..}, files) <- runDB $ do
[(E.Value cid, matEnt)] <- E.select . E.from $ -- uniqueness guaranteed
\(course `E.InnerJoin` material) -> do
E.on $ course E.^. CourseId E.==. material E.^. MaterialCourse
E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.&&. material E.^. MaterialName E.==. E.val mnm
return (course E.^. CourseId, material)
fileIds <- E.select . E.from $ \(matFile `E.InnerJoin` file) -> do
E.on $ matFile E.^. MaterialFileFile E.==. file E.^. FileId
E.where_ $ matFile E.^. MaterialFileMaterial E.==. E.val (entityKey matEnt)
return $ file E.^. FileId
return (cid, matEnt, (Left . E.unValue) <$> fileIds)
let template = Just $ MaterialForm
{ mfName = materialName
, mfType = materialType
, mfDescription = materialDescription
, mfVisibleFrom = materialVisibleFrom
, mfFiles = Just $ yieldMany files
}
editWidget <- handleMaterialEdit tid ssh csh template
let headingLong = prependCourseTitle tid ssh csh $ MsgMaterialEditHeading $ CI.original mnm
headingShort = prependCourseTitle tid ssh csh $ MsgMaterialEditTitle $ CI.original mnm
siteLayoutMsg headingLong $ do
setTitleI headingShort
editWidget
getMaterialNewR, postMaterialNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialNewR = postMaterialNewR
postMaterialNewR tid ssh csh = do
editWidget <- handleMaterialEdit tid ssh csh Nothing
let headingLong = prependCourseTitle tid ssh csh MsgMaterialNewHeading
headingShort = prependCourseTitle tid ssh csh MsgMaterialNewTitle
siteLayoutMsg headingLong $ do
setTitleI headingShort
editWidget
handleMaterialEdit :: TermId -> SchoolId -> CourseShorthand -> Maybe MaterialForm -> Handler Widget
handleMaterialEdit tid ssh csh template = do
aid <- requireAuthId
Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
((res,formWidget), formEnctype) <- runFormPost $ makeMaterialForm cid template
actionUrl <- fromMaybe (CourseR tid ssh csh MaterialNewR) <$> getCurrentRoute
return $ wrapForm formWidget def
{ formAction = Just $ SomeRoute actionUrl
, formEncoding = formEnctype
}
getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMDelR = postMDelR getMDelR = postMDelR