Form cleanup
This commit is contained in:
Gregor Kleen
parent
3d920d1435
commit
69ca22fdde
@ -1,4 +1,4 @@
|
||||
CampusNote: Campus-Kennung bitte inkl. Domain-Teil (@campus.lmu.de) angeben.
|
||||
CampusIdentNote: Campus-Kennung bitte inkl. Domain-Teil (@campus.lmu.de) angeben.
|
||||
CampusIdent: Campus-Kennung
|
||||
CampusPassword: Passwort
|
||||
CampusSubmit: Abschicken
|
||||
@ -64,11 +64,19 @@ SheetHintFrom: Hinweis ab
|
||||
SheetSolution: Lösung
|
||||
SheetSolutionFrom: Lösung ab
|
||||
SheetMarking: Hinweise für Korrektoren
|
||||
SheetType: Bewertung
|
||||
|
||||
SheetName: Name
|
||||
SheetDescription: Hinweise für Teilnehmer
|
||||
SheetType: Bewertung
|
||||
SheetGroup: Gruppenabgabe
|
||||
SheetVisibleFrom: Sichtbar ab
|
||||
SheetVisibleFromTip: Ohne Datum wird das Blatt nie sichtbar, z.B. weil es noch nicht fertig ist
|
||||
SheetActiveFrom: Aktiv ab
|
||||
SheetActiveFromTip: Abgabe und Download der Aufgabenstellung ist erst ab diesem Datum möglich
|
||||
SheetActiveTo: Abgabefrist
|
||||
SheetHintFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen
|
||||
SheetSolutionFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen
|
||||
SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren
|
||||
|
||||
SheetErrVisibility: Sichtbarkeit muss vor Beginn der Abgabefrist liegen
|
||||
SheetErrDeadlineEarly: Ende der Abgabefrist muss nach deren Beginn liegen
|
||||
@ -139,7 +147,8 @@ CorrectorsDefaulted: Korrektoren-Liste wurde aus bisherigen Übungsblättern die
|
||||
|
||||
Users: Benutzer
|
||||
HomeHeading: Aktuelle Termine
|
||||
LoginHeading: Login bitte mit "@campus.lmu.de" angeben
|
||||
LoginHeading: Authentifizierung
|
||||
LoginTitle: Authentifizierung
|
||||
ProfileHeading: Benutzerprofil und Einstellungen
|
||||
ProfileDataHeading: Gespeicherte Benutzerdaten
|
||||
ImpressumHeading: Impressum
|
||||
@ -194,6 +203,7 @@ SubmissionUsers: Studenten
|
||||
RatingPoints: Punkte
|
||||
RatingFiles: Korrigierte Dateien
|
||||
PointsNotPositive: Punktzahl darf nicht negativ sein
|
||||
RatingPointsDone: Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist
|
||||
|
||||
FileTitle: Dateiname
|
||||
FileModified: Letzte Änderung
|
||||
@ -207,6 +217,20 @@ RatingFilesUpdated: Korrigierte Dateien überschrieben
|
||||
CourseMembers: Teilnehmer
|
||||
CourseMembersCount num@Int64: #{display num}
|
||||
CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max}
|
||||
CourseName: Name
|
||||
CourseDescription: Beschreibung
|
||||
CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet
|
||||
CourseHomepage: Homepage
|
||||
CourseShorthand: Kürzel
|
||||
CourseShorthandUnique: Muss innerhalb des Semesters eindeutig sein
|
||||
CourseSemester: Semester
|
||||
CourseSchool: Institut
|
||||
CourseCapacity: Kapazität
|
||||
CourseCapacityTip: Falls angegeben wird die Anzahl an Kursanmeldungen, die zugelassen werden, beschränkt
|
||||
CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
|
||||
CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich
|
||||
CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein
|
||||
CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein
|
||||
|
||||
NoTableContent: Kein Tabelleninhalt
|
||||
NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
|
||||
|
||||
@ -17,9 +17,10 @@ import Control.Lens
|
||||
|
||||
import Utils.Form
|
||||
|
||||
|
||||
data CampusLogin = CampusLogin { campusIdent, campusPassword :: Text }
|
||||
|
||||
data CampusMessage = MsgCampusNote
|
||||
data CampusMessage = MsgCampusIdentNote
|
||||
| MsgCampusIdent
|
||||
| MsgCampusPassword
|
||||
| MsgCampusSubmit
|
||||
@ -31,7 +32,7 @@ campusForm :: ( RenderMessage site FormMessage
|
||||
, Show (ButtonCssClass site)
|
||||
) => AForm (HandlerT site IO) CampusLogin
|
||||
campusForm = CampusLogin
|
||||
<$> areq textField (fslI MsgCampusIdent) Nothing
|
||||
<$> areq textField (fslpI MsgCampusIdent "user.name@campus.lmu.de" & setTooltip MsgCampusIdentNote) Nothing
|
||||
<*> areq passwordField (fslI MsgCampusPassword) Nothing
|
||||
<* submitButton
|
||||
|
||||
|
||||
@ -55,6 +55,7 @@ instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
|
||||
decCryptoIDs [ ''SubmissionId
|
||||
, ''FileId
|
||||
, ''UserId
|
||||
, ''CourseId
|
||||
]
|
||||
|
||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where
|
||||
|
||||
@ -1074,12 +1074,13 @@ instance YesodAuth UniWorX where
|
||||
redirectToReferer _ = True
|
||||
|
||||
loginHandler = do
|
||||
tp <- getRouteToParent
|
||||
lift . authLayout $ do
|
||||
master <- getYesod
|
||||
let authPlugins' = authPlugins master
|
||||
$logDebugS "Auth" $ "Enabled plugins: " <> Text.intercalate ", " (map apName authPlugins')
|
||||
forM_ authPlugins' $ flip apLogin tp
|
||||
toParent <- getRouteToParent
|
||||
lift . defaultLayout $ do
|
||||
plugins <- getsYesod authPlugins
|
||||
$logDebugS "Auth" $ "Enabled plugins: " <> Text.intercalate ", " (map apName plugins)
|
||||
|
||||
setTitleI MsgLoginTitle
|
||||
$(widgetFile "login")
|
||||
|
||||
authenticate creds@(Creds{..}) = runDB . fmap (either id id) . runExceptT $ do
|
||||
let (userPlugin, userIdent)
|
||||
|
||||
@ -389,7 +389,7 @@ postCorrectionR tid csh shn cid = do
|
||||
let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
|
||||
|
||||
((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,)
|
||||
<$> aopt pointsField (fslpI MsgRatingPoints "Punktezahl" & setTooltip "Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist") (Just $ submissionRatingPoints)
|
||||
<$> aopt pointsField (fslpI MsgRatingPoints "Punktezahl" & setTooltip MsgRatingPointsDone) (Just $ submissionRatingPoints)
|
||||
<*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment))
|
||||
<* submitButton
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
@ -184,7 +184,7 @@ courseDeleteHandler = undefined
|
||||
courseEditHandler :: Bool -> Maybe (Entity Course) -> Handler Html
|
||||
courseEditHandler isGet course = do
|
||||
aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
|
||||
((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
|
||||
((result, formWidget), formEnctype) <- runFormPost . newCourseForm =<< for course courseToForm
|
||||
case result of
|
||||
(FormSuccess res@(
|
||||
CourseForm { cfCourseId = Nothing
|
||||
@ -217,10 +217,11 @@ courseEditHandler isGet course = do
|
||||
addMessageI "danger" $ MsgCourseNewDupShort tid csh
|
||||
|
||||
(FormSuccess res@(
|
||||
CourseForm { cfCourseId = Just cid
|
||||
CourseForm { cfCourseId = Just cID
|
||||
, cfShort = csh
|
||||
, cfTerm = tid
|
||||
})) -> do -- edit existing course
|
||||
cid <- decrypt cID
|
||||
now <- liftIO getCurrentTime
|
||||
-- addMessage "debug" [shamlet| #{show res}|]
|
||||
runDB $ do
|
||||
@ -263,7 +264,7 @@ courseEditHandler isGet course = do
|
||||
|
||||
|
||||
data CourseForm = CourseForm
|
||||
{ cfCourseId :: Maybe CourseId -- Maybe CryptoUUIDCourse
|
||||
{ cfCourseId :: Maybe CryptoUUIDCourse
|
||||
, cfName :: CourseName
|
||||
, cfDesc :: Maybe Html
|
||||
, cfLink :: Maybe Text
|
||||
@ -278,24 +279,24 @@ data CourseForm = CourseForm
|
||||
, cfDeRegUntil :: Maybe UTCTime
|
||||
}
|
||||
|
||||
courseToForm :: Entity Course -> CourseForm
|
||||
courseToForm cEntity = CourseForm
|
||||
{ cfCourseId = Just $ entityKey cEntity
|
||||
, cfName = courseName course
|
||||
, cfDesc = courseDescription course
|
||||
, cfLink = courseLinkExternal course
|
||||
, cfShort = courseShorthand course
|
||||
, cfTerm = courseTerm course
|
||||
, cfSchool = courseSchool course
|
||||
, cfCapacity = courseCapacity course
|
||||
, cfSecret = courseRegisterSecret course
|
||||
, cfMatFree = courseMaterialFree course
|
||||
, cfRegFrom = courseRegisterFrom course
|
||||
, cfRegTo = courseRegisterTo course
|
||||
, cfDeRegUntil = courseDeregisterUntil course
|
||||
}
|
||||
where
|
||||
course = entityVal cEntity
|
||||
courseToForm :: MonadCrypto m => Entity Course -> m CourseForm
|
||||
courseToForm (Entity cid Course{..}) = do
|
||||
cfCourseId <- Just <$> encrypt cid
|
||||
return $ CourseForm
|
||||
{ cfCourseId
|
||||
, cfName = courseName
|
||||
, cfDesc = courseDescription
|
||||
, cfLink = courseLinkExternal
|
||||
, cfShort = courseShorthand
|
||||
, cfTerm = courseTerm
|
||||
, cfSchool = courseSchool
|
||||
, cfCapacity = courseCapacity
|
||||
, cfSecret = courseRegisterSecret
|
||||
, cfMatFree = courseMaterialFree
|
||||
, cfRegFrom = courseRegisterFrom
|
||||
, cfRegTo = courseRegisterTo
|
||||
, cfDeRegUntil = courseDeregisterUntil
|
||||
}
|
||||
|
||||
newCourseForm :: Maybe CourseForm -> Form CourseForm
|
||||
newCourseForm template = identForm FIDcourse $ \html -> do
|
||||
@ -306,29 +307,32 @@ newCourseForm template = identForm FIDcourse $ \html -> do
|
||||
-- UUID.encrypt cidKey cid
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
|
||||
-- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work?
|
||||
<$> aopt hiddenField "KursId" (cfCourseId <$> template)
|
||||
<*> areq (ciField textField) (fsb "Name") (cfName <$> template)
|
||||
<*> aopt htmlField (fsb "Beschreibung") (cfDesc <$> template)
|
||||
<*> aopt urlField (fsb "Homepage") (cfLink <$> template)
|
||||
<*> areq (ciField textField) (fsb "Kürzel"
|
||||
<$> aopt hiddenField "courseId" (cfCourseId <$> template)
|
||||
<*> areq (ciField textField) (fslI MsgCourseName) (cfName <$> template)
|
||||
<*> aopt htmlField (fslI MsgCourseDescription
|
||||
& setTooltip MsgCourseDescriptionTip) (cfDesc <$> template)
|
||||
<*> aopt urlField (fslI MsgCourseHomepage) (cfLink <$> template)
|
||||
<*> areq (ciField textField) (fslI MsgCourseShorthand
|
||||
-- & addAttr "disabled" "disabled"
|
||||
& setTooltip "Muss innerhalb des Semesters eindeutig sein")
|
||||
& setTooltip MsgCourseShorthandUnique)
|
||||
(cfShort <$> template)
|
||||
<*> areq termActiveField (fsb "Semester") (cfTerm <$> template)
|
||||
<*> areq schoolField (fsb "Institut") (cfSchool <$> template)
|
||||
<*> aopt (natField "Kapazität") (fsb "Kapazität") (cfCapacity <$> template)
|
||||
<*> areq termActiveField (fslI MsgCourseSemester) (cfTerm <$> template)
|
||||
<*> areq schoolField (fslI MsgCourseSchool) (cfSchool <$> template)
|
||||
<*> aopt (natField "Kapazität") (fslI MsgCourseCapacity
|
||||
& setTooltip MsgCourseCapacityTip
|
||||
) (cfCapacity <$> template)
|
||||
<*> aopt textField (fslpI MsgCourseSecret "beliebige Zeichenkette"
|
||||
& setTooltip "Optional: Anmeldung zum Kurs benötigt ein Passwort")
|
||||
& setTooltip MsgCourseSecretTip)
|
||||
(cfSecret <$> template)
|
||||
<*> areq checkBoxField (fslI MsgMaterialFree)(cfMatFree <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgRegisterFrom "Datum, sonst KEINE Anmeldung"
|
||||
& setTooltip "Ohne Datum ist keine Anmeldung zu diesem Kurs möglich!")
|
||||
<*> aopt utcTimeField (fslpI MsgRegisterFrom "Datum"
|
||||
& setTooltip MsgCourseRegisterFromTip)
|
||||
(cfRegFrom <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgRegisterTo "Datum, sonst unbegr. Anmeldung"
|
||||
& setTooltip "Die Anmeldung darf ohne Begrenzung sein")
|
||||
<*> aopt utcTimeField (fslpI MsgRegisterTo "Datum"
|
||||
& setTooltip MsgCourseRegisterToTip)
|
||||
(cfRegTo <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgDeRegUntil "Datum, sonst unbegr. Abmeldung"
|
||||
& setTooltip "Die Abmeldung darf ohne Begrenzung sein")
|
||||
<*> aopt utcTimeField (fslpI MsgDeRegUntil "Datum"
|
||||
& setTooltip MsgCourseDeregisterUntilTip)
|
||||
(cfDeRegUntil <$> template)
|
||||
<* submitButton
|
||||
return $ case result of
|
||||
|
||||
@ -104,29 +104,29 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
|
||||
mr <- getMsgRenderer
|
||||
ctime <- liftIO $ getCurrentTime
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
|
||||
<$> areq (ciField textField) (fsb "Name") (sfName <$> template)
|
||||
<*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfDescription <$> template)
|
||||
<*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template)
|
||||
<*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template)
|
||||
<*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
|
||||
<$> areq (ciField textField) (fslI MsgSheetName) (sfName <$> template)
|
||||
<*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template)
|
||||
<*> sheetTypeAFormReq (fslI MsgSheetType) (sfType <$> template)
|
||||
<*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template)
|
||||
<*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgSheetVisibleFrom
|
||||
& setTooltip "Ohne Datum ist das Blatt komplett unsichtbar, z.B. weil es noch nicht fertig ist.")
|
||||
& setTooltip MsgSheetVisibleFromTip)
|
||||
((sfVisibleFrom <$> template) <|> pure (Just ctime))
|
||||
<*> areq utcTimeField (fslI MsgSheetActiveFrom
|
||||
& setTooltip "Abgabe und Dateien zur Aufgabenstellung sind erst ab diesem Datum zugänglich")
|
||||
& setTooltip MsgSheetActiveFromTip)
|
||||
(sfActiveFrom <$> template)
|
||||
<*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template)
|
||||
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template)
|
||||
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren"
|
||||
& setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen")
|
||||
& setTooltip MsgSheetHintFromTip)
|
||||
(sfHintFrom <$> template)
|
||||
<*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgSheetSolutionFrom "Datum, sonst nur für Korrektoren"
|
||||
& setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen")
|
||||
& setTooltip MsgSheetSolutionFromTip)
|
||||
(sfSolutionFrom <$> template)
|
||||
<*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
|
||||
<*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarking
|
||||
& setTooltip "Hinweise zur Korrektur, sichtbar nur für Korrektoren") (sfMarkingF <$> template)
|
||||
& setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template)
|
||||
<* submitButton
|
||||
return $ case result of
|
||||
FormSuccess sheetResult
|
||||
|
||||
@ -115,11 +115,9 @@ setClass fs c = fs { fsAttrs=("class",c):(fsAttrs fs) }
|
||||
setNameClass :: FieldSettings site -> Text -> Text -> FieldSettings site -- deprecated
|
||||
setNameClass fs gName gClass = fs { fsName= Just gName, fsAttrs=("class",gClass):(fsAttrs fs) }
|
||||
|
||||
setTooltip :: String -> FieldSettings site -> FieldSettings site
|
||||
setTooltip tt fs
|
||||
| null tt = fs { fsTooltip = Nothing }
|
||||
| otherwise = fs { fsTooltip = Just $ fromString tt
|
||||
, fsAttrs=("data-tooltip",fromString tt):(fsAttrs fs) }
|
||||
setTooltip :: RenderMessage site msg => msg -> FieldSettings site -> FieldSettings site
|
||||
setTooltip msg fs = fs { fsTooltip = Just $ SomeMessage msg }
|
||||
|
||||
------------------------------------------------
|
||||
-- Unique Form Identifiers to avoid accidents --
|
||||
------------------------------------------------
|
||||
@ -190,4 +188,3 @@ combinedButtonField btns = traverse b2f btns
|
||||
|
||||
submitButton :: (Button site SubmitButton, Show (ButtonCssClass site)) => AForm (HandlerT site IO) ()
|
||||
submitButton = void $ combinedButtonField [BtnSubmit]
|
||||
|
||||
|
||||
7
templates/login.hamlet
Normal file
7
templates/login.hamlet
Normal file
@ -0,0 +1,7 @@
|
||||
$forall AuthPlugin{..} <- plugins
|
||||
<section>
|
||||
$if apName == "LDAP"
|
||||
<h2>Campus-Kennung
|
||||
$if apName == "dummy"
|
||||
<h2>Dummy
|
||||
^{apLogin toParent}
|
||||
@ -8,3 +8,7 @@ $case formLayout
|
||||
<label .form-group__label for=#{fvId view}>#{fvLabel view}
|
||||
<div .form-group__input>
|
||||
^{fvInput view}
|
||||
$maybe tooltip <- fvTooltip view
|
||||
<div .js-tooltip>
|
||||
<div .tooltip__handle>?
|
||||
<div .tooltip__content>^{tooltip}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user