sheet display extended, not yet complete

This commit is contained in:
SJost 2018-01-06 18:39:34 +01:00
parent 3575e69123
commit 6070c9231b
4 changed files with 30 additions and 23 deletions

3
models
View File

@ -94,8 +94,9 @@ CourseParticipant
Sheet Sheet
courseId CourseId courseId CourseId
name Text name Text
description Html Maybe
type SheetType type SheetType
markingText Text Maybe markingText Html Maybe
activeFrom UTCTime activeFrom UTCTime
activeTo UTCTime activeTo UTCTime
hintFrom UTCTime Maybe hintFrom UTCTime Maybe

View File

@ -32,8 +32,9 @@ import qualified Data.UUID.Cryptographic as UUID
data SheetForm = SheetForm data SheetForm = SheetForm
{ sfCourseId :: Maybe CourseId { sfCourseId :: Maybe CourseId
, sfName :: Text , sfName :: Text
, sfComment :: Maybe Html
, sfType :: SheetType , sfType :: SheetType
, sfMarkingText :: Maybe Text , sfMarkingText :: Maybe Html
, sfActiveFrom :: UTCTime , sfActiveFrom :: UTCTime
, sfActiveTo :: UTCTime , sfActiveTo :: UTCTime
, sfSheetF :: Maybe FileInfo , sfSheetF :: Maybe FileInfo
@ -47,10 +48,11 @@ data SheetForm = SheetForm
makeSheetForm :: Maybe CourseId -> Maybe SheetForm -> Form SheetForm makeSheetForm :: Maybe CourseId -> Maybe SheetForm -> Form SheetForm
makeSheetForm cid template = identForm FIDsheet $ \html -> do makeSheetForm cid template = identForm FIDsheet $ \html -> do
(result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ SheetForm (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ SheetForm
<$> areq hiddenField "KursId" (Just cid) <$> areq hiddenField "KursId" (Just cid)
<*> areq textField (fsb "Name") (sfName <$> template) <*> areq textField (fsb "Name") (sfName <$> template)
<*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfMarkingText <$> template)
<*> aopt textField (fsb "Hinweise zur Bewertung") (sfMarkingText <$> template) <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template)
<*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
<*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template) <*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template)
<*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template) <*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template)
<*> fileAFormOpt (fsb "Aufgaben") <*> fileAFormOpt (fsb "Aufgaben")
@ -107,7 +109,7 @@ getSheetList courseEnt = do
rated <- count $ (SubmissionRatingTime !=. Nothing):sheetsub rated <- count $ (SubmissionRatingTime !=. Nothing):sheetsub
return (sid, sheet, (submissions, rated)) return (sid, sheet, (submissions, rated))
let colSheets = mconcat let colSheets = mconcat
[ headed "Blatt" $ toWgt . sheetName . snd3 [ headed "Blatt" $ toWgt . sheetName . snd3
, headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3 , headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3
, headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3 , headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3
, headed "Bewertung" $ toWgt . show . sheetType . snd3 , headed "Bewertung" $ toWgt . show . sheetType . snd3
@ -143,9 +145,8 @@ getSheetShow entSheet = do
let sheet = entityVal entSheet let sheet = entityVal entSheet
defaultLayout $ do defaultLayout $ do
setTitle $ toHtml $ T.append "Übung " $ sheetName sheet setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
-- $(widgetFile "sheetAdmin")
[whamlet| Under Construction !!! |] -- TODO [whamlet| Under Construction !!! |] -- TODO
$(widgetFile "sheetAdmin")
getSheetNewR :: TermIdentifier -> Text -> Handler Html getSheetNewR :: TermIdentifier -> Text -> Handler Html
getSheetNewR tid csh = do getSheetNewR tid csh = do

View File

@ -24,6 +24,11 @@
#{participants} #{participants}
$maybe capacity <- courseCapacity course $maybe capacity <- courseCapacity course
\ von #{capacity} \ von #{capacity}
<br>
$maybe regFrom <- courseRegisterFrom course
Anmeldezeitraum: #{formatTimeGerWD regFrom}
$maybe regTo <- courseRegisterTo course
\ bis #{formatTimeGerWD regTo}
<form method=post action=@{CourseShowR tid csh} enctype=#{regEnctype}> <form method=post action=@{CourseShowR tid csh} enctype=#{regEnctype}>
^{regWidget} ^{regWidget}

View File

@ -9,22 +9,22 @@
<div .col-lg-12> <div .col-lg-12>
<div .page-header> <div .page-header>
$maybe descr <- courseDescription course $maybe descr <- sheetDescription sheet
<h2 #description>Beschreibung <h2 #description>Hinweise
<p> #{descr} <p> #{descr}
$maybe link <- courseLinkExternal course <h3>Bewertung
<h4 #linl>Homepage <p> #{show $ sheetType sheet}
<a href=#{link}>#{link} $maybe marking <- sheetMarkingText sheet
<p> #{marking}
<br>
Freigeschaltet ab:
\ #{formatTimeGerWD $ sheetActiveFrom sheet}
\ Abgabe bis:
\ #{formatTimeGerWD $ sheetActiveTo sheet}
<div .row> <div .row>
<div .col-lg-12> <div .col-lg-12>
<h4>Teilnehmer <h2>Abgaben
#{participants}
$maybe capacity <- courseCapacity course
\ von #{capacity}
<form method=post action=@{CourseShowR tid csh} enctype=#{regEnctype}>
^{regWidget}
<hr> <hr>