diff --git a/routes b/routes index afb0adb90..de7b39e66 100644 --- a/routes +++ b/routes @@ -13,7 +13,7 @@ /term/#TermIdentifier/edit TermEditExistR GET /course/ CourseListR GET -!/course/edit CourseEditR GET POST +!/course/new CourseEditR GET POST !/course/#TermIdentifier CourseListTermR GET /course/#TermIdentifier/#Text/edit CourseEditExistR GET /course/#TermIdentifier/#Text/show CourseShowR GET POST diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 68c7b72c1..14375a6c8 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -53,7 +53,8 @@ getCourseListTermR tidini = do |] ) ] defaultLayout $ do - setTitle "Semesterkurse" + setTitle "Semesterkurse" + linkButton "Neuen Kurs anlegen" BCPrimary CourseEditR encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal courses) getCourseShowR :: TermIdentifier -> Text -> Handler Html @@ -232,12 +233,12 @@ courseToForm cEntity = CourseForm course = entityVal cEntity newCourseForm :: Maybe CourseForm -> Form CourseForm -newCourseForm template html = do +newCourseForm template = identifyForm "newCourseForm" $ \html -> do -- mopt hiddenField --- cidKey <- getsYesod appCryptoIDKey --- courseId <- runMaybeT $ do --- cid <- cfCourseId template --- UUID.encrypt cidKey cid + -- cidKey <- getsYesod appCryptoIDKey + -- courseId <- runMaybeT $ do + -- cid <- cfCourseId template + -- UUID.encrypt cidKey cid (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ CourseForm -- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work? <$> aopt hiddenField "KursId" (cfCourseId <$> template) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index ec1cdf069..3af786f4b 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -25,7 +25,6 @@ import Yesod.Form.Bootstrap3 import Web.PathPieces (showToPathPiece, readFromPathPiece) - ---------------------------- -- Buttons (new version ) -- ---------------------------- @@ -43,9 +42,11 @@ class (Enum a, Bounded a, Ord a, PathPiece a) => Button a where cssClass :: a -> ButtonCssClass cssClass _ = BCDefault + +--Some standard Buttons useful throughout data StandardButton = BtnDelete | BtnAbort | BtnSave deriving (Enum, Eq, Ord, Bounded, Read, Show) - + instance PathPiece StandardButton where -- for displaying the button only, not really for paths toPathPiece = showToPathPiece fromPathPiece = readFromPathPiece @@ -59,7 +60,23 @@ instance Button StandardButton where cssClass BtnAbort = BCDefault cssClass BtnSave = BCPrimary - +-- -- 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) +-- +-- instance PathPiece LinkButton where +-- LinkButton route = ??? + +linkButton :: Widget -> ButtonCssClass -> Route UniWorX -> Widget +linkButton lbl cls url = do + [whamlet| +