Term editing required third route :(

.gitignore

@@ -21,4 +21,5 @@ cabal.sandbox.config
 uniworx.cabal
 uniworx.nix
 .gup/
-.dbsettings.yml
+.dbsettings.yml
+*.kate-swp

routes

@@ -10,5 +10,7 @@
 
 
 /assist/newcourse  NewCourseR GET POST
-/assist/newterm    NewTermR   GET POST
-/assist/showterm   ShowTermR   GET 
+/assist/showterms  ShowTermsR GET 
+/assist/newterm    NewTermR   GET
+/assist/editterm   EditTermR  GET POST
+/assist/editterm/#TermIdentifier EditTermExistR  GET

src/Application.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application

src/Foundation.hs

@@ -167,9 +167,11 @@ instance Yesod UniWorX where
 
     isAuthorized ProfileR _ = isAuthenticated
     -- TODO: change to Assistants
-    isAuthorized NewCourseR _ = return Authorized
-    isAuthorized NewTermR   _ = return Authorized
-    isAuthorized ShowTermR  _ = return Authorized
+    isAuthorized NewCourseR         _ = return Authorized
+    isAuthorized NewTermR           _ = return Authorized
+    isAuthorized EditTermR          _ = return Authorized
+    isAuthorized (EditTermExistR _) _ = return Authorized
+    isAuthorized ShowTermsR         _ = 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/Assist.hs

@@ -121,8 +121,8 @@ postNewCourseR = do
 -}
 
 
-getShowTermR :: Handler Html
-getShowTermR = do
+getShowTermsR :: Handler Html
+getShowTermsR = do
   terms <- runDB $ selectList [] [Desc TermStart]
   defaultLayout $ do
     setTitle "Freigeschaltete Semester"
@@ -137,7 +137,7 @@ getShowTermR = do
         <ul>
           $forall Entity _ term <- terms
             <li>
-              <a href=@{NewTermR}>
+              <a href=@{EditTermExistR $ termName term}>
                 #{termToText $ termName term}               
               from  #{formatTime defaultTimeLocale "%d.%m.%Y" $ termStart term}
               to: #{formatTime defaultTimeLocale "%d.%m.%Y" $ termEnd term}
@@ -148,19 +148,28 @@ getShowTermR = do
 getNewTermR :: Handler Html
 getNewTermR = do
   -- TODO: Defaults für Semester hier ermitteln und übergeben
-  getNewTermDefR Nothing
+  getEditTermMaybeR Nothing
+  
+getEditTermR :: Handler Html
+getEditTermR = do
+  -- TODO: Defaults für Semester hier ermitteln und übergeben
+  getEditTermMaybeR Nothing
+  
+getEditTermExistR :: TermIdentifier -> Handler Html  
+getEditTermExistR tid = do
+  term <- runDB $ get $ TermKey tid
+  getEditTermMaybeR term
 
-
-getNewTermDefR :: Maybe Term -> Handler Html
-getNewTermDefR mbTerm= do 
+getEditTermMaybeR :: Maybe Term -> Handler Html
+getEditTermMaybeR mbTerm= do 
     aid <- requireAuthId
     (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm
     defaultLayout $ do
-        setTitle "Neues Semester anlegen"        
-        $(widgetFile "newTerm")
+        setTitle "Semester editieren/anlegen"        
+        $(widgetFile "editTerm")
         
-postNewTermR :: Handler Html
-postNewTermR = do
+postEditTermR :: Handler Html
+postEditTermR = do
     aid <- requireAuthId
     ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
     case result of
@@ -171,17 +180,17 @@ postNewTermR = do
           let msg = "Semester " `T.append` tid `T.append` " wurde angelegt!"        
           -- setMessage $ toHtml msg -- FIXME
           setMessage "Semester wurde angelegt" 
-          redirect ShowTermR
+          redirect ShowTermsR
        FormMissing -> defaultLayout $ do
             setMessage "Keine Formulardaten erhalten."
-            $(widgetFile "newTerm")
+            $(widgetFile "editTerm")
        FormFailure errorMsgs -> defaultLayout $ do
             setMessage [shamlet| <span .error>Fehler:
                             <ul>
                                 $forall errmsg <- errorMsgs
                                     <li> #{errmsg} 
                         |]
-            $(widgetFile "newTerm")
+            $(widgetFile "editTerm")
 
 newTermForm :: Maybe Term -> Form Term
 newTermForm template = 

templates/editTerm.hamlet

@@ -3,15 +3,12 @@
         <div .row>
             <div .col-lg-12>
                 <div .page-header>
-                    <h1 #forms>Neues Semester anlegen:
-
-                    <p>
-                        Bitte alles ausfüllen!
+                    <h1 #forms>Semester editieren/anlegen:
 
         <div .row>
             <div .col-lg-6>
                 <div .bs-callout bs-callout-info well>
-                    <form .form-horizontal method=post action=@{NewTermR}#forms enctype=#{formEnctype}>
+                    <form .form-horizontal method=post action=@{EditTermR}#forms enctype=#{formEnctype}>
                         ^{formWidget}
 
                         <button .btn.btn-primary type="submit">