Course Edit compiles, but deletion/edit does not work yet. I think I need to separate Post/Get Handlers again.
This commit is contained in:
SJost
parent
b980bab1b1
commit
26efab4506
5
routes
5
routes
@ -12,7 +12,8 @@
|
||||
/term/edit TermEditR GET POST
|
||||
/term/#TermIdentifier/edit TermEditExistR GET
|
||||
|
||||
/course CourseShowR GET
|
||||
/course/edit CourseEditR GET POST
|
||||
/course/ CourseShowR GET
|
||||
!/course/edit CourseEditR GET POST
|
||||
!/course/#TermIdentifier CourseShowTermR GET
|
||||
/course/#TermIdentifier/#Text/edit CourseEditExistR GET
|
||||
|
||||
|
||||
@ -168,14 +168,16 @@ instance Yesod UniWorX where
|
||||
isAuthorized ProfileR _ = isAuthenticated
|
||||
|
||||
-- TODO: all?
|
||||
isAuthorized TermShowR _ = return Authorized
|
||||
isAuthorized TermShowR _ = return Authorized
|
||||
isAuthorized CourseShowR _ = return Authorized
|
||||
isAuthorized (CourseShowTermR _) _ = return Authorized
|
||||
-- TODO: change to Assistants
|
||||
isAuthorized TermEditR _ = return Authorized
|
||||
isAuthorized (TermEditExistR _) _ = return Authorized
|
||||
isAuthorized CourseEditR _ = return Authorized
|
||||
isAuthorized TermEditR _ = return Authorized
|
||||
isAuthorized (TermEditExistR _) _ = return Authorized
|
||||
isAuthorized CourseEditR _ = return Authorized
|
||||
isAuthorized (CourseEditExistR _ _) _ = return Authorized
|
||||
|
||||
|
||||
|
||||
-- This function creates static content files in the static folder
|
||||
-- and names them based on a hash of their content. This allows
|
||||
|
||||
@ -21,33 +21,37 @@ import Yesod.Colonnade
|
||||
|
||||
|
||||
getCourseShowR :: Handler TypedContent
|
||||
getCourseShowR = do
|
||||
terms <- runDB $ selectList [] [Desc TermStart]
|
||||
selectRep $ do
|
||||
provideRep $ return $ toJSON terms
|
||||
provideRep $ do
|
||||
let colonnadeTerms = mconcat
|
||||
[ headed "Kürzel" $ (\t -> let tn = termName t in do
|
||||
adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tn) False
|
||||
[whamlet|
|
||||
$if adminLink == Authorized
|
||||
<a href=@{TermEditExistR tn}>
|
||||
#{termToText tn}
|
||||
$else
|
||||
#{termToText tn}
|
||||
|] )
|
||||
, headed "Beginn Vorlesungen" $ fromString.formatTimeGerWD.termLectureStart
|
||||
, headed "Ende Vorlesungen" $ fromString.formatTimeGerWD.termLectureEnd
|
||||
, headed "Aktiv" (\t -> if termActive t then tickmark else "")
|
||||
-- , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
|
||||
, headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
|
||||
, headed "Semesterende" $ fromString.formatTimeGerWD.termEnd
|
||||
, headed "Feiertage im Semester" $
|
||||
fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
|
||||
]
|
||||
defaultLayout $ do
|
||||
setTitle "Freigeschaltete Semester"
|
||||
encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
|
||||
getCourseShowR = redirect TermShowR
|
||||
|
||||
getCourseShowTermR :: TermIdentifier -> Handler Html
|
||||
getCourseShowTermR tidini = do
|
||||
(term,courses) <- runDB $ do
|
||||
term <- get $ TermKey tidini
|
||||
courses <- selectList [CourseTermId ==. tidini] [Asc CourseShorthand]
|
||||
return (term, courses)
|
||||
when (isNothing term) $ do
|
||||
setMessage [shamlet| Semester #{termToText tidini} nicht gefunden. |]
|
||||
redirect TermShowR
|
||||
let colonnadeTerms = mconcat
|
||||
[ headed "Kürzel" $ (\c ->
|
||||
let shd = courseShorthand c
|
||||
tid = courseTermId c
|
||||
in do
|
||||
adminLink <- handlerToWidget $ isAuthorized (CourseEditExistR tid shd ) False
|
||||
[whamlet|
|
||||
$if adminLink == Authorized
|
||||
<a href=@{CourseEditExistR tid shd}>
|
||||
#{shd}
|
||||
$else
|
||||
#{shd}
|
||||
|] )
|
||||
-- , headed "Institut" $ [shamlet| #{course} |]
|
||||
, headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom
|
||||
, headed "Ende Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo
|
||||
]
|
||||
defaultLayout $ do
|
||||
setTitle "Semesterkurse"
|
||||
encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal courses)
|
||||
|
||||
|
||||
getCourseEditR :: Handler Html
|
||||
@ -69,6 +73,8 @@ courseEditHandler course = do
|
||||
aid <- requireAuthId
|
||||
((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
|
||||
action <- lookupPostParam "formaction"
|
||||
liftIO $ putStrLn "================"
|
||||
liftIO $ print (result,action)
|
||||
case (result,action) of
|
||||
(FormSuccess res, fAct)
|
||||
| fAct == formActionDelete
|
||||
@ -76,7 +82,7 @@ courseEditHandler course = do
|
||||
runDB $ delete cid -- TODO Sicherheitsabfrage einbauen!
|
||||
let cti = termToText $ cfTerm res
|
||||
setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht! |]
|
||||
redirect CourseShowR
|
||||
redirect $ CourseShowTermR $ cfTerm res
|
||||
| fAct == formActionSave
|
||||
, Just cid <- cfCourseId res -> do
|
||||
actTime <- liftIO getCurrentTime
|
||||
@ -94,6 +100,7 @@ courseEditHandler course = do
|
||||
]
|
||||
let cti = termToText $ cfTerm res
|
||||
setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde geändert. |]
|
||||
redirect $ CourseShowTermR $ cfTerm res
|
||||
| fAct == formActionSave
|
||||
, Nothing <- cfCourseId res -> do
|
||||
actTime <- liftIO getCurrentTime
|
||||
@ -117,7 +124,7 @@ courseEditHandler course = do
|
||||
runDB $ insert_ $ Lecturer aid cid
|
||||
let cti = termToText $ cfTerm res
|
||||
setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde angelegt. |]
|
||||
redirect CourseShowR
|
||||
redirect $ CourseShowTermR $ cfTerm res
|
||||
Nothing -> do
|
||||
let cti = termToText $ cfTerm res
|
||||
setMessage $ [shamlet|
|
||||
@ -127,7 +134,7 @@ courseEditHandler course = do
|
||||
(FormFailure _,_) -> setMessage "Bitte Eingabe korrigieren."
|
||||
_other -> return ()
|
||||
let formTitle = "Kurs editieren/anlegen" :: Text
|
||||
let actionUrl = TermEditR
|
||||
let actionUrl = CourseEditR
|
||||
let formActions = defaultFormActions
|
||||
defaultLayout $ do
|
||||
setTitle [shamlet| #{formTitle} |]
|
||||
@ -146,7 +153,11 @@ data CourseForm = CourseForm
|
||||
, cfRegFrom :: Maybe UTCTime
|
||||
, cfRegTo :: Maybe UTCTime
|
||||
}
|
||||
|
||||
|
||||
instance Show CourseForm where
|
||||
show cf = T.unpack (cfShort cf) ++ ' ':(show $ cfCourseId cf)
|
||||
|
||||
|
||||
courseToForm :: Entity Course -> CourseForm
|
||||
courseToForm cEntity = CourseForm
|
||||
{ cfCourseId = Just $ entityKey cEntity
|
||||
@ -166,7 +177,7 @@ courseToForm cEntity = CourseForm
|
||||
newCourseForm :: Maybe CourseForm -> Form CourseForm
|
||||
newCourseForm template html = do
|
||||
(result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ CourseForm
|
||||
<$> pure Nothing -- $ join (cfCourseId <$> template)
|
||||
<$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work?
|
||||
<*> areq textField (set "Name") (cfName <$> template)
|
||||
<*> aopt htmlField (set "Beschreibung") (cfDesc <$> template)
|
||||
<*> aopt urlField (set "Homepage") (cfLink <$> template)
|
||||
@ -176,6 +187,9 @@ newCourseForm template html = do
|
||||
<*> aopt (natField "Kapazität") (set "Kapazität") (cfCapacity <$> template)
|
||||
<*> aopt utcTimeField (set "Anmeldung von:") (cfRegFrom <$> template)
|
||||
<*> aopt utcTimeField (set "Anmeldung bis:") (cfRegTo <$> template)
|
||||
-- <* bootstrapSubmit (bsSubmit (show cid))
|
||||
liftIO $ putStrLn "++++++++++"
|
||||
liftIO $ print cid
|
||||
return $ case result of
|
||||
FormSuccess courseResult
|
||||
| errorMsgs <- validateCourse courseResult
|
||||
@ -192,6 +206,9 @@ newCourseForm template html = do
|
||||
)
|
||||
_ -> (result, widget)
|
||||
where
|
||||
cid :: Maybe CourseId
|
||||
cid = join $ cfCourseId <$> template
|
||||
|
||||
set :: Text -> FieldSettings site
|
||||
set = bfs
|
||||
|
||||
|
||||
@ -38,6 +38,12 @@ getTermShowR = do
|
||||
, headed "Ende Vorlesungen" $ fromString.formatTimeGerWD.termLectureEnd
|
||||
, headed "Aktiv" (\t -> if termActive t then tickmark else "")
|
||||
-- , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
|
||||
, headed "Kursliste" $ (\t -> let tn = termName t in do
|
||||
numCourses <- handlerToWidget $ runDB $ count [CourseTermId ==. tn ]
|
||||
[whamlet|
|
||||
<a href=@{CourseShowTermR tn}>
|
||||
#{show numCourses} Kurse
|
||||
|] )
|
||||
, headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
|
||||
, headed "Semesterende" $ fromString.formatTimeGerWD.termEnd
|
||||
, headed "Feiertage im Semester" $
|
||||
|
||||
Loading…
Reference in New Issue
Block a user