Course Edit compiles, but deletion/edit does not work yet. I think I need to separate Post/Get Handlers again.

routes

@@ -12,7 +12,8 @@
 /term/edit                  TermEditR         GET POST
 /term/#TermIdentifier/edit  TermEditExistR    GET
 
-/course                      CourseShowR      GET
+/course/                    CourseShowR       GET
-/course/edit                 CourseEditR      GET POST
+!/course/edit               CourseEditR       GET POST
+!/course/#TermIdentifier    CourseShowTermR   GET
 /course/#TermIdentifier/#Text/edit CourseEditExistR GET
 

src/Foundation.hs

@@ -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 TermEditR              _ = return Authorized
-    isAuthorized (TermEditExistR _) _ = return Authorized    
+    isAuthorized (TermEditExistR _)     _ = return Authorized    
-    isAuthorized CourseEditR          _ = 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

src/Handler/Course.hs

@@ -21,33 +21,37 @@ import Yesod.Colonnade
 
 
 getCourseShowR :: Handler TypedContent
-getCourseShowR = do
+getCourseShowR = redirect TermShowR  
-  terms <- runDB $ selectList [] [Desc TermStart]
+
-  selectRep $ do
+getCourseShowTermR :: TermIdentifier -> Handler Html
-    provideRep $ return $ toJSON terms
+getCourseShowTermR tidini = do
-    provideRep $ do      
+  (term,courses) <- runDB $ do
-      let colonnadeTerms = mconcat 
+      term    <- get $ TermKey tidini
-            [ headed "Kürzel" $ (\t -> let tn = termName t in do
+      courses <- selectList [CourseTermId ==. tidini] [Asc CourseShorthand]
-                adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tn) False
+      return (term, courses)
-                [whamlet| 
+  when (isNothing term) $ do
-                  $if adminLink == Authorized
+    setMessage [shamlet| Semester #{termToText tidini} nicht gefunden. |]
-                    <a href=@{TermEditExistR tn}>
+    redirect TermShowR
-                      #{termToText tn}
+  let colonnadeTerms = mconcat 
-                  $else 
+        [ headed "Kürzel" $ (\c -> 
-                      #{termToText tn}
+            let shd = courseShorthand c  
-                |] )        
+                tid = courseTermId    c
-            , headed "Beginn Vorlesungen" $ fromString.formatTimeGerWD.termLectureStart
+            in do
-            , headed "Ende Vorlesungen"   $ fromString.formatTimeGerWD.termLectureEnd
+              adminLink <- handlerToWidget $ isAuthorized (CourseEditExistR tid shd ) False
-            , headed "Aktiv"  (\t -> if termActive t then tickmark else "")
+              [whamlet| 
-    --         , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
+                $if adminLink == Authorized
-            , headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
+                  <a href=@{CourseEditExistR tid shd}>
-            , headed "Semesterende"   $ fromString.formatTimeGerWD.termEnd
+                    #{shd}
-            , headed "Feiertage im Semester" $ 
+                $else 
-            fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
+                    #{shd}
-            ]  
+              |] )        
-      defaultLayout $ do
+--         , headed "Institut" $ [shamlet| #{course} |]
-        setTitle "Freigeschaltete Semester"            
+        , headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom
-        encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
+        , 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 
 

src/Handler/Term.hs

@@ -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" $