diff --git a/models b/models
index c03087e76..d08da58a6 100644
--- a/models
+++ b/models
@@ -27,12 +27,11 @@ DegreeCourse json
degreeId DegreeId
courseId CourseId
UniqueDegreeCourse degreeId courseId
-Course json
+Course
name Text
shorthand Text
- description Textarea
- linkexternal Text
- owner UserId
+ description Html Maybe
+ linkexternal Text Maybe
schoolId SchoolId
termId TermId -- TermId ist jetzt Text als Typ
capacity Int Maybe
@@ -60,7 +59,7 @@ Sheet
hintId FileId Maybe
solutionId FileId Maybe
markingId FileId Maybe
- markingText Text
+ markingText Text Maybe
activeFrom UTCTime
activeTo UTCTime
hintFrom UTCTime Maybe
@@ -129,7 +128,7 @@ Booking
Room
name Text
capacity Int Maybe
- building Text
+ building Text Maybe
-- BookingRoom
-- subject RoomForId
-- roomId RoomId
diff --git a/routes b/routes
index 1c63b0e37..a9f0a8b76 100644
--- a/routes
+++ b/routes
@@ -8,9 +8,8 @@
/profile ProfileR GET
-/showterms ShowTermsR GET
+/term ShowTermsR GET
+/term/edit EditTermR GET POST
+/term/#TermIdentifier/edit EditTermExistR GET
-/assist/newcourse NewCourseR GET POST
-/assist/newterm NewTermR GET
-/assist/editterm EditTermR GET POST
-/assist/editterm/#TermIdentifier EditTermExistR GET
+/assist/newcourse NewCourseR GET POST
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 259e36048..2ee4eaa30 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -167,8 +167,7 @@ instance Yesod UniWorX where
isAuthorized ProfileR _ = isAuthenticated
-- TODO: change to Assistants
- isAuthorized NewCourseR _ = return Authorized
- isAuthorized NewTermR _ = return Authorized
+ isAuthorized NewCourseR _ = return Authorized
isAuthorized EditTermR _ = return Authorized
isAuthorized (EditTermExistR _) _ = return Authorized
isAuthorized ShowTermsR _ = return Authorized
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index 7e1127144..be73ea0d1 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -23,11 +23,17 @@ getShowTermsR = do
terms <- runDB $ selectList [] [Desc TermStart]
selectRep $ do
provideRep $ return $ toJSON terms
- provideRep $ do
+ provideRep $ do
let colonnadeTerms = mconcat
- -- TODO Edit-Links only $if isAdmin, otherwise breadcrumb navigation
- [ headed "Kürzel" $ (\t -> let tn = termName t in
- [whamlet| #{termToText tn}|] )
+ [ headed "Kürzel" $ (\t -> let tn = termName t in do
+ adminLink <- handlerToWidget $ isAuthorized (EditTermExistR tn) False
+ [whamlet|
+ $if adminLink == Authorized
+
+ #{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 "")
@@ -42,36 +48,23 @@ getShowTermsR = do
encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
-getNewTermR :: Handler Html
-getNewTermR = do
- -- TODO: Defaults für Semester hier ermitteln und übergeben
- getEditTermMaybeR Nothing
-
-
getEditTermR :: Handler Html
getEditTermR = do
-- TODO: Defaults für Semester hier ermitteln und übergeben
- getEditTermMaybeR Nothing
+ termEditHandler Nothing
+postEditTermR :: Handler Html
+postEditTermR = termEditHandler Nothing
getEditTermExistR :: TermIdentifier -> Handler Html
getEditTermExistR tid = do
term <- runDB $ get $ TermKey tid
- getEditTermMaybeR term
+ termEditHandler term
-
-getEditTermMaybeR :: Maybe Term -> Handler Html
-getEditTermMaybeR mbTerm= do
- aid <- requireAuthId
- -- TODO: verify Admin
- (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm
- wdgtTermForm formWidget formEnctype
-
-postEditTermR :: Handler Html
-postEditTermR = do
- aid <- requireAuthId
- -- TODO: verify Admin
- ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
+
+termEditHandler :: Maybe Term -> Handler Html
+termEditHandler term = do
+ ((result, formWidget), formEnctype) <- runFormPost $ newTermForm term
action <- lookupPostParam "formaction"
case (result,action) of
(FormSuccess res, fAct)
@@ -79,7 +72,7 @@ postEditTermR = do
runDB $ delete (TermKey $ termName res)
let tid = termToText $ termName res
let msg = "Semester " `T.append` tid `T.append` " erfolgreich gelöscht."
- setMessage [shamlet| #{msg} |]
+ setMessage $ [shamlet| #{msg} |]
redirect ShowTermsR
| fAct == formActionSave -> do
-- term <- runDB $ get $ TermKey termName
@@ -88,15 +81,17 @@ postEditTermR = do
let msg = "Semester " `T.append` tid `T.append` " erfolgreich editiert."
setMessage [shamlet| #{msg} |]
redirect ShowTermsR
- | otherwise -> redirect ShowTermsR
- (FormMissing,_) -> do
- setMessage "Keine Formulardaten erhalten."
- wdgtTermForm formWidget formEnctype
-
- (FormFailure _,_) -> do
- setMessage "Bitte Eingabe korrigieren."
- wdgtTermForm formWidget formEnctype
+ | otherwise -> redirect ShowTermsR
+ (FormMissing,_) -> return ()
+ (FormFailure _,_) -> setMessage "Bitte Eingabe korrigieren."
+ let formTitle = "Semester editieren/anlegen" :: Text
+ let actionUrl = EditTermR
+ let formActions = defaultFormActions
+ defaultLayout $ do
+ setTitle [shamlet| #{formTitle} |]
+ $(widgetFile "generic_form")
+{-
wdgtTermForm :: (ToWidget UniWorX a) => a -> Enctype -> Handler Html
wdgtTermForm formWidget formEnctype = do
let formTitle = "Semester editieren/anlegen" :: Text
@@ -105,7 +100,8 @@ wdgtTermForm formWidget formEnctype = do
defaultLayout $ do
setTitle [shamlet| #{formTitle} |]
$(widgetFile "generic_form")
-
+-}
+
newTermForm :: Maybe Term -> Form Term
newTermForm template html = do
(result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ Term
diff --git a/src/Handler/Utils/Table.hs b/src/Handler/Utils/Table.hs
index f64af26a3..3ed97eb88 100644
--- a/src/Handler/Utils/Table.hs
+++ b/src/Handler/Utils/Table.hs
@@ -5,7 +5,7 @@ module Handler.Utils.Table where
-- General Utilities for Tables
import Import hiding ((<>))
-import Data.Monoid ((<>))
+-- import Data.Monoid ((<>))
import Data.Profunctor
import Text.Blaze as B
@@ -31,7 +31,7 @@ encodeHeadedWidgetTableNumbered :: Attribute -> Colonnade Headed a (WidgetT site
encodeHeadedWidgetTableNumbered attrs colo tdata =
encodeHeadedWidgetTable attrs (mconcat [numberCol, lmap snd colo]) (zip [1..] tdata)
where
- numberCol = headed "Nr" (fromString.show.fst)
-
+ numberCol :: Colonnade Headed (Int,a) (WidgetT site IO ())
+ numberCol = headed "Nr" (fromString.show.fst)
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index f3751c05a..e887a515e 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -58,7 +58,7 @@ seasonFromChar c
data TermIdentifier = TermIdentifier
{ year :: Integer -- ^ Using 'Integer' to model years is consistent with 'Data.Time.Calendar'
, season :: Season
- } deriving (Show, Read, Eq, Generic, Typeable)
+ } deriving (Show, Read, Eq, Ord, Generic, Typeable)
--TODO: Enforce the number of digits within year, with parsing filling in the current leading digits? Goal: short urls
termToText :: TermIdentifier -> Text
@@ -71,11 +71,6 @@ termFromText t
, Right season <- seasonFromChar s
= Right TermIdentifier{..}
| otherwise = Left $ "Invalid TermIdentifier: “" <> t <> "”"
-
-instance Ord TermIdentifier where
- ti1 <= ti2 =
- year ti1 <= year ti2 ||
- (year ti1 == year ti2 || season ti1 <= season ti2)
instance PersistField TermIdentifier where
toPersistValue = PersistText . termToText