BUGFIX: Register Button for Lectures works as intended now!
This commit is contained in:
SJost
parent
7390093a39
commit
bed7fb91b7
@ -1,3 +1,12 @@
|
||||
BtnSubmit: Senden
|
||||
BtnAbort: Abbrechen
|
||||
BtnDelete: Löschen
|
||||
BtnRegister: Anmelden
|
||||
BtnDeregister: Abmelden
|
||||
|
||||
RegisterFrom: Anmeldungen von
|
||||
RegisterTo: Anmeldungen bis
|
||||
|
||||
SummerTerm year@Integer: Sommersemester #{tshow year}
|
||||
WinterTerm year@Integer: Wintersemester #{tshow year}/#{tshow $ succ year}
|
||||
PSLimitNonPositive: “pagesize” muss größer als null sein
|
||||
@ -10,6 +19,7 @@ TermPlaceholder: W/S + vierstellige Jahreszahl
|
||||
TermEditHeading: Semester editieren/anlegen
|
||||
|
||||
Course: Kurs
|
||||
CourseSecret: Zugangspasswort
|
||||
CourseNewOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich erstellt.
|
||||
CourseEditOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich geändert.
|
||||
CourseNewDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
|
||||
@ -43,6 +53,7 @@ UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung ein
|
||||
UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen.
|
||||
UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen.
|
||||
UnauthorizedParticipant: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.
|
||||
UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
|
||||
UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
|
||||
UnauthorizedSubmissionOwner: Sie sind an dieser Abgabe nicht beteiligt.
|
||||
UnauthorizedSubmissionCorrector: Sie sind nicht der Korrektor für diese Abgabe.
|
||||
@ -51,6 +62,7 @@ DeprecatedRoute: Diese Ansicht ist obsolet und könnte in Zukunft entfallen.
|
||||
UnfreeMaterials: Die Materialien für diese Veranstaltung sind nicht allgemein freigegeben.
|
||||
UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung
|
||||
|
||||
|
||||
SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt.
|
||||
SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt.
|
||||
SubmissionTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen
|
||||
|
||||
2
models
2
models
@ -60,7 +60,7 @@ Course
|
||||
term TermId
|
||||
school SchoolId
|
||||
capacity Int Maybe
|
||||
hasRegistration Bool -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
|
||||
-- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
|
||||
registerFrom UTCTime Maybe
|
||||
registerTo UTCTime Maybe
|
||||
deregisterUntil UTCTime Maybe
|
||||
|
||||
4
routes
4
routes
@ -33,6 +33,7 @@
|
||||
/ HomeR GET !free
|
||||
/users UsersR GET -- no tags, i.e. admins only
|
||||
/admin/test AdminTestR GET POST
|
||||
/admin/user/#CryptoUUIDUser AdminUserR GET
|
||||
|
||||
/profile ProfileR GET POST !free !free
|
||||
/profile/data ProfileDataR GET !free !free
|
||||
@ -47,7 +48,8 @@
|
||||
/course/ CourseListR GET !free
|
||||
!/course/new CourseNewR GET POST !lecturer
|
||||
/course/#TermId/#Text CourseR !lecturer:
|
||||
/show CShowR GET POST !free
|
||||
/show CShowR GET !free
|
||||
/register CRegisterR POST !time
|
||||
/edit CEditR GET POST
|
||||
/ex SheetListR GET !registered !materials
|
||||
!/ex/new SheetNewR GET POST
|
||||
|
||||
@ -53,6 +53,7 @@ instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
|
||||
-- Generates CryptoUUID... and CryptoFileName... Datatypes
|
||||
decCryptoIDs [ ''SubmissionId
|
||||
, ''FileId
|
||||
, ''UserId
|
||||
]
|
||||
{- TODO: Do we need/want CryptoUUIDs for Sheet numbers? -}
|
||||
|
||||
|
||||
@ -278,20 +278,28 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
return Authorized
|
||||
)
|
||||
,("time", APDB $ \case
|
||||
CSheetR tid csh shn subRoute -> maybeT (unauthorizedI MsgUnauthorizedSheetTime) $ do
|
||||
Entity cid _ <- MaybeT . getBy $ CourseTermShort tid csh
|
||||
Entity sid Sheet{..} <- MaybeT . getBy $ CourseSheet cid shn
|
||||
cTime <- liftIO getCurrentTime
|
||||
let started = sheetActiveFrom <= cTime || NTop sheetVisibleFrom <= (NTop $ Just cTime)
|
||||
case subRoute of
|
||||
SFileR SheetExercise _ -> guard started
|
||||
SFileR SheetHint _ -> guard $ maybe False (<= cTime) sheetHintFrom
|
||||
SFileR SheetSolution _ -> guard $ maybe False (<= cTime) sheetSolutionFrom
|
||||
SFileR SheetMarking _ -> mzero -- only for correctors and lecturers
|
||||
SubmissionNewR -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
|
||||
_ -> guard started
|
||||
return Authorized
|
||||
r -> do
|
||||
CSheetR tid csh shn subRoute -> maybeT (unauthorizedI MsgUnauthorizedSheetTime) $ do
|
||||
Entity cid _ <- MaybeT . getBy $ CourseTermShort tid csh
|
||||
Entity sid Sheet{..} <- MaybeT . getBy $ CourseSheet cid shn
|
||||
cTime <- liftIO getCurrentTime
|
||||
let started = sheetActiveFrom <= cTime || NTop sheetVisibleFrom <= (NTop $ Just cTime)
|
||||
case subRoute of
|
||||
SFileR SheetExercise _ -> guard started
|
||||
SFileR SheetHint _ -> guard $ maybe False (<= cTime) sheetHintFrom
|
||||
SFileR SheetSolution _ -> guard $ maybe False (<= cTime) sheetSolutionFrom
|
||||
SFileR SheetMarking _ -> mzero -- only for correctors and lecturers
|
||||
SubmissionNewR -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
|
||||
_ -> guard started
|
||||
return Authorized
|
||||
|
||||
CourseR tid csh CRegisterR -> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do
|
||||
Entity cid Course{..} <- MaybeT . getBy $ CourseTermShort tid csh
|
||||
cTime <- (NTop . Just) <$> liftIO getCurrentTime
|
||||
guard $ NTop courseRegisterFrom <= cTime
|
||||
&& NTop courseRegisterTo >= cTime
|
||||
return Authorized
|
||||
|
||||
r -> do
|
||||
$logErrorS "AccessControl" $ "'!time' used on route that doesn't support it: " <> tshow r
|
||||
unauthorizedI MsgUnauthorized
|
||||
)
|
||||
@ -420,8 +428,7 @@ instance Yesod UniWorX where
|
||||
lift $ mapM_ delete oldFavs
|
||||
|
||||
_other -> return ()
|
||||
res <- defaultYesodMiddleware handler -- handler is executed before Favourites are update
|
||||
return res
|
||||
defaultYesodMiddleware handler -- handler is executed afterwards, so Favourites are updated immediately
|
||||
|
||||
defaultLayout widget = do
|
||||
master <- getYesod
|
||||
|
||||
@ -58,3 +58,14 @@ postAdminTestR = do
|
||||
_other -> return ()
|
||||
getAdminTestR
|
||||
|
||||
|
||||
getAdminUserR :: CryptoUUIDUser -> Handler Html
|
||||
getAdminUserR uuid = do
|
||||
uid <- decrypt uuid
|
||||
User{..} <- runDB $ get404 uid
|
||||
defaultLayout $
|
||||
[whamlet|
|
||||
<h1>TODO
|
||||
<h2>Admin Page for User #{display userDisplayName}
|
||||
|]
|
||||
|
||||
|
||||
@ -16,9 +16,9 @@ import Handler.Utils
|
||||
-- import Data.Time
|
||||
import qualified Data.Text as T
|
||||
import Data.Function ((&))
|
||||
import Yesod.Form.Bootstrap3
|
||||
-- import Yesod.Form.Bootstrap3
|
||||
|
||||
import Colonnade hiding (fromMaybe)
|
||||
import Colonnade hiding (fromMaybe,bool)
|
||||
import Yesod.Colonnade
|
||||
|
||||
import qualified Data.UUID.Cryptographic as UUID
|
||||
@ -79,7 +79,7 @@ getTermCourseListR tidini = do
|
||||
getCShowR :: TermId -> Text -> Handler Html
|
||||
getCShowR tid csh = do
|
||||
mbAid <- maybeAuthId
|
||||
(courseEnt,(schoolMB,participants,mbRegistered)) <- runDB $ do
|
||||
(courseEnt,(schoolMB,participants,registered)) <- runDB $ do
|
||||
courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort tid csh
|
||||
dependent <- (,,)
|
||||
<$> get (courseSchool course) -- join
|
||||
@ -91,26 +91,33 @@ getCShowR tid csh = do
|
||||
return $ isJust regL)
|
||||
return $ (courseEnt,dependent)
|
||||
let course = entityVal courseEnt
|
||||
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerButton $ mbRegistered
|
||||
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
|
||||
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid csh CRegisterR) True
|
||||
defaultLayout $ do
|
||||
setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
|
||||
$(widgetFile "course")
|
||||
|
||||
registerButton :: Bool -> Form ()
|
||||
registerButton registered = renderAForm FormStandard $
|
||||
pure () <* bootstrapSubmit regMsg
|
||||
where
|
||||
msg = if registered then "Abmelden" else "Anmelden"
|
||||
regMsg = msg :: BootstrapSubmit Text
|
||||
|
||||
postCShowR :: TermId -> Text -> Handler Html
|
||||
postCShowR tid csh = do
|
||||
registerForm :: Bool -> Maybe Text -> Form Bool
|
||||
registerForm registered msecret extra = do
|
||||
(msecretRes', msecretView) <- case msecret of
|
||||
Nothing -> return (Nothing,Nothing)
|
||||
(Just _) -> bimap Just Just <$> (mreq textField (fslpI MsgCourseSecret "Code") Nothing)
|
||||
(btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
|
||||
let widget = $(widgetFile "widgets/registerForm")
|
||||
let msecretRes | Just res <- msecretRes' = Just <$> res
|
||||
| otherwise = FormSuccess Nothing
|
||||
return (btnRes *> ((==msecret) <$> msecretRes), widget) -- checks that correct button was pressed, and ignores result of btnRes
|
||||
|
||||
|
||||
postCRegisterR :: TermId -> Text -> Handler Html
|
||||
postCRegisterR tid csh = do
|
||||
aid <- requireAuthId
|
||||
(cid, registered) <- runDB $ do
|
||||
(Entity cid _) <- getBy404 $ CourseTermShort tid csh
|
||||
(cid, course, registered) <- runDB $ do
|
||||
(Entity cid course) <- getBy404 $ CourseTermShort tid csh
|
||||
registered <- isJust <$> (getBy $ UniqueParticipant aid cid)
|
||||
return (cid, registered)
|
||||
((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerButton registered
|
||||
return (cid, course, registered)
|
||||
((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
|
||||
case regResult of
|
||||
(FormSuccess _)
|
||||
| registered -> do
|
||||
@ -121,8 +128,7 @@ postCShowR tid csh = do
|
||||
regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
|
||||
when (isJust regOk) $ addMessage "success" "Erfolgreich angemeldet!"
|
||||
(_other) -> return () -- TODO check this!
|
||||
-- redirect or not?! I guess not, since we want GET now
|
||||
getCShowR tid csh
|
||||
redirect $ CourseR tid csh CShowR
|
||||
|
||||
getCourseNewR :: Handler Html
|
||||
getCourseNewR = do
|
||||
@ -174,11 +180,10 @@ courseEditHandler isGet course = do
|
||||
, courseTerm = cfTerm res
|
||||
, courseSchool = cfSchool res
|
||||
, courseCapacity = cfCapacity res
|
||||
, courseHasRegistration = cfHasReg res
|
||||
, courseRegisterSecret = cfSecret res
|
||||
, courseRegisterFrom = cfRegFrom res
|
||||
, courseRegisterTo = cfRegTo res
|
||||
, courseDeregisterUntil = Nothing -- TODO
|
||||
, courseRegisterSecret = Nothing -- TODO
|
||||
, courseMaterialFree = True -- TODO
|
||||
}
|
||||
case insertOkay of
|
||||
@ -230,11 +235,10 @@ courseEditHandler isGet course = do
|
||||
, courseTerm = cfTerm res
|
||||
, courseSchool = cfSchool res
|
||||
, courseCapacity = cfCapacity res
|
||||
, courseHasRegistration = cfHasReg res
|
||||
, courseRegisterSecret = cfSecret res
|
||||
, courseRegisterFrom = cfRegFrom res
|
||||
, courseRegisterTo = cfRegTo res
|
||||
, courseDeregisterUntil = Nothing -- TODO
|
||||
, courseRegisterSecret = Nothing -- TODO
|
||||
, courseMaterialFree = True -- TODO
|
||||
}
|
||||
)
|
||||
@ -263,7 +267,7 @@ data CourseForm = CourseForm
|
||||
, cfTerm :: TermId
|
||||
, cfSchool :: SchoolId
|
||||
, cfCapacity :: Maybe Int
|
||||
, cfHasReg :: Bool
|
||||
, cfSecret :: Maybe Text
|
||||
, cfRegFrom :: Maybe UTCTime
|
||||
, cfRegTo :: Maybe UTCTime
|
||||
}
|
||||
@ -282,7 +286,7 @@ courseToForm cEntity = CourseForm
|
||||
, cfTerm = courseTerm course
|
||||
, cfSchool = courseSchool course
|
||||
, cfCapacity = courseCapacity course
|
||||
, cfHasReg = courseHasRegistration course
|
||||
, cfSecret = courseRegisterSecret course
|
||||
, cfRegFrom = courseRegisterFrom course
|
||||
, cfRegTo = courseRegisterTo course
|
||||
}
|
||||
@ -309,9 +313,15 @@ newCourseForm template = identForm FIDcourse $ \html -> do
|
||||
<*> areq termActiveField (fsb "Semester") (cfTerm <$> template)
|
||||
<*> areq schoolField (fsb "Institut") (cfSchool <$> template)
|
||||
<*> aopt (natField "Kapazität") (fsb "Kapazität") (cfCapacity <$> template)
|
||||
<*> areq checkBoxField (fsb "Anmeldung") (cfHasReg <$> template)
|
||||
<*> aopt utcTimeField (fsb "Anmeldung von:") (cfRegFrom <$> template)
|
||||
<*> aopt utcTimeField (fsb "Anmeldung bis:") (cfRegTo <$> template)
|
||||
<*> aopt textField (fslpI MsgCourseSecret "beliebige Zeichenkette"
|
||||
& setTooltip "Optional: Anmeldung zum Kurs benötigt ein Passwort")
|
||||
(cfSecret <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgRegisterFrom "(ohne Datum keine Anmeldung möglich)"
|
||||
& setTooltip "Ohne Datum ist keine Anmeldung zu diesem Kurs möglich!")
|
||||
(cfRegFrom <$> template)
|
||||
<*> aopt utcTimeField (fslpI MsgRegisterTo "(ohne Datum unbegrenzte Anmeldung möglich)"
|
||||
& setTooltip "Die Anmeldung darf ohne Begrenzung sein")
|
||||
(cfRegTo <$> template)
|
||||
<* submitButton
|
||||
return $ case result of
|
||||
FormSuccess courseResult
|
||||
@ -338,20 +348,12 @@ validateCourse :: CourseForm -> [Text]
|
||||
validateCourse (CourseForm{..}) =
|
||||
[ msg | (False, msg) <-
|
||||
[
|
||||
( cfRegFrom <= cfRegTo
|
||||
( NTop cfRegFrom <= NTop cfRegTo
|
||||
, "Ende des Anmeldezeitraums muss nach dem Anfang liegen"
|
||||
)
|
||||
,
|
||||
-- No starting date is okay: effective immediately
|
||||
-- ( cfHasReg <= (isNothing cfRegFrom)
|
||||
-- , "Beginn der Anmeldung angeben oder Anmeldungen deaktivieren"
|
||||
-- )
|
||||
-- ,
|
||||
( cfHasReg == (isJust cfRegTo)
|
||||
, "Ende des Anmeldezeitraums angeben oder Anmeldungen deaktivieren"
|
||||
)
|
||||
,
|
||||
( isJust cfRegFrom <= cfHasReg
|
||||
, "Anmeldungen aktivieren oder Anmeldezeitraum löschen"
|
||||
)
|
||||
] ]
|
||||
|
||||
@ -54,7 +54,11 @@ instance CryptoRoute (CI FilePath) SubmissionId where
|
||||
Course{..} <- get404 sheetCourse
|
||||
return (courseTerm, courseShorthand, sheetName)
|
||||
return $ CSheetR tid csh shn $ SubmissionR cID
|
||||
|
||||
|
||||
instance CryptoRoute UUID UserId where
|
||||
cryptoIDRoute _ (CryptoID -> cID) = do
|
||||
(_ :: UserId) <- decrypt cID
|
||||
return $ AdminUserR cID
|
||||
|
||||
class Dispatch ciphertext (x :: [*]) where
|
||||
dispatchID :: p x -> ciphertext -> Handler (Maybe (Route UniWorX))
|
||||
@ -79,6 +83,7 @@ getCryptoUUIDDispatchR :: UUID -> Handler ()
|
||||
getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith found302)
|
||||
where
|
||||
p :: Proxy '[ SubmissionId
|
||||
, UserId
|
||||
]
|
||||
p = Proxy
|
||||
|
||||
|
||||
@ -57,10 +57,10 @@ homeAnonymous = do
|
||||
let tableData :: E.SqlExpr (Entity Course)
|
||||
-> E.SqlQuery (E.SqlExpr (Entity Course))
|
||||
tableData course = do
|
||||
E.where_ $ course E.^. CourseHasRegistration E.==. E.val True
|
||||
E.&&. course E.^. CourseRegisterFrom E.<=. E.val (Just cTime)
|
||||
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
|
||||
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
|
||||
E.where_ $ (E.not_ $ E.isNothing $ course E.^. CourseRegisterFrom)
|
||||
E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
|
||||
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
|
||||
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
|
||||
E.limit nrSheetDeadlines
|
||||
E.orderBy [ E.asc $ course E.^. CourseRegisterTo
|
||||
, E.desc $ course E.^. CourseShorthand
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
@ -34,7 +35,10 @@ getUsersR = do
|
||||
Nothing -> "???"
|
||||
(Just school) -> schoolShorthand school
|
||||
let colonnadeUsers = mconcat $
|
||||
[ headed "User" $ text2widget.userDisplayName.entityVal.fst3
|
||||
[ headed "User" $ \u -> do
|
||||
cID <- encrypt $ entityKey $ fst3 u
|
||||
let name = display $ userDisplayName $ entityVal $ fst3 u
|
||||
[whamlet|<a href=@{AdminUserR cID}>#{name}|]
|
||||
, headed "Admin for Schools" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userAdminSchool .entityVal) $ snd3 u)
|
||||
, headed "Lecturer at Schools" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userLecturerSchool.entityVal) $ trd3 u)
|
||||
]
|
||||
|
||||
@ -100,8 +100,8 @@ instance PathPiece BtnDelete where -- for displaying the button only, not rea
|
||||
fromPathPiece = readFromPathPiece
|
||||
|
||||
instance Button BtnDelete where
|
||||
label BtnDelete = "Löschen"
|
||||
label BtnAbort = "Abrechen"
|
||||
label BtnDelete = [whamlet|_{MsgBtnDelete}|]
|
||||
label BtnAbort = [whamlet|_{MsgBtnAbort}|]
|
||||
|
||||
cssClass BtnDelete = BCDanger
|
||||
cssClass BtnAbort = BCDefault
|
||||
@ -115,10 +115,26 @@ instance PathPiece SubmitButton where
|
||||
fromPathPiece = readFromPathPiece
|
||||
|
||||
instance Button SubmitButton where
|
||||
label BtnSubmit = "Submit"
|
||||
label BtnSubmit = [whamlet|_{MsgBtnSubmit}|]
|
||||
|
||||
cssClass BtnSubmit = BCPrimary
|
||||
|
||||
|
||||
data RegisterButton = BtnRegister | BtnDeregister
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show)
|
||||
|
||||
instance PathPiece RegisterButton where
|
||||
toPathPiece = showToPathPiece
|
||||
fromPathPiece = readFromPathPiece
|
||||
|
||||
instance Button RegisterButton where
|
||||
label BtnRegister = [whamlet|_{MsgBtnRegister}|]
|
||||
label BtnDeregister = [whamlet|_{MsgBtnDeregister}|]
|
||||
|
||||
cssClass BtnRegister = BCPrimary
|
||||
cssClass BtnDeregister = BCDanger
|
||||
|
||||
|
||||
-- -- Looks like a button, but is just a link (e.g. for create course, etc.)
|
||||
-- data LinkButton = LinkButton (Route UniWorX)
|
||||
-- deriving (Enum, Eq, Ord, Bounded, Read, Show)
|
||||
@ -138,7 +154,7 @@ linkButton lbl cls url = [whamlet| <a href=@{url} .btn .#{bcc2txt cls} role=butt
|
||||
simpleLink :: Widget -> Route UniWorX -> Widget
|
||||
simpleLink lbl url = [whamlet| <a href=@{url}>^{lbl} |]
|
||||
|
||||
buttonField :: Button a => a -> Field Handler a
|
||||
buttonField :: Button a => a -> Field Handler a -- already validates that the correct button press was received (result only neccessary for combinedButtonField)
|
||||
buttonField btn = Field {fieldParse, fieldView, fieldEnctype}
|
||||
where
|
||||
fieldEnctype = UrlEncoded
|
||||
|
||||
@ -32,13 +32,10 @@
|
||||
<tr>
|
||||
<th>
|
||||
<td>
|
||||
$# if allowed to register
|
||||
<div .course__registration.container>
|
||||
<button class="btn btn-primary">
|
||||
<a href="#">TODO: Kurs-Anmeldung
|
||||
|
||||
$# <form method=post action=@{CourseR tid csh CShow} enctype=#{regEnctype}>
|
||||
$# ^{regWidget}
|
||||
$if registrationOpen
|
||||
<div .course__registration.container>
|
||||
<form method=post action=@{CourseR tid csh CRegisterR} enctype=#{regEnctype}>
|
||||
^{regWidget}
|
||||
|
||||
$# <div .container>
|
||||
$# <div .tab-group>
|
||||
|
||||
8
templates/widgets/registerForm.hamlet
Normal file
8
templates/widgets/registerForm.hamlet
Normal file
@ -0,0 +1,8 @@
|
||||
$# protects against CSRF
|
||||
#{extra}
|
||||
$# Maybe display textField for passcode
|
||||
$maybe secretView <- msecretView
|
||||
^{fvInput secretView}
|
||||
$# Always display register/deregister button
|
||||
^{fvInput btnView}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user