From 2b78bce6467da50436e1ddb815f98d688d653bfb Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 10 Oct 2017 18:35:43 +0200 Subject: [PATCH] Temporary Homepage and Breadcrumbs working. --- models | 2 +- routes | 6 ++-- src/Foundation.hs | 14 ++++++-- src/Handler/Course.hs | 6 ++-- src/Handler/Home.hs | 75 +++++++++++-------------------------------- 5 files changed, 37 insertions(+), 66 deletions(-) diff --git a/models b/models index 3c3bcc8fd..1fd956be7 100644 --- a/models +++ b/models @@ -39,7 +39,7 @@ Course changed UTCTime createdBy UserId changedBy UserId - hasRegistration Bool default=TRUE -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo + hasRegistration Bool -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo registerFrom UTCTime Maybe registerTo UTCTime Maybe CourseTermShort termId shorthand diff --git a/routes b/routes index 01b56c0be..10f0aa4d8 100644 --- a/routes +++ b/routes @@ -4,10 +4,10 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET -/ HomeR GET POST - +/ HomeR GET /profile ProfileR GET + /term TermShowR GET /term/edit TermEditR GET POST /term/#TermIdentifier/edit TermEditExistR GET @@ -16,7 +16,7 @@ !/course/edit CourseEditR GET POST !/course/#TermIdentifier CourseListTermR GET /course/#TermIdentifier/#Text/edit CourseEditExistR GET -/course/#TermIdentifier/#Text/show CourseShowR GET +/course/#TermIdentifier/#Text/show CourseShowR GET -- For demonstration /course/#CryptoUUIDCourse/edit CourseEditExistIDR GET diff --git a/src/Foundation.hs b/src/Foundation.hs index 836911410..54ebfc18b 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -222,8 +222,18 @@ instance Yesod UniWorX where makeLogger = return . appLogger -- Define breadcrumbs. -instance YesodBreadcrumbs UniWorX where - breadcrumb HomeR = return ("Home", Nothing) +instance YesodBreadcrumbs UniWorX where + breadcrumb TermShowR = return ("Semester", Just HomeR) + breadcrumb TermEditR = return ("Neu", Just TermShowR) + breadcrumb (TermEditExistR _) = return ("Editieren", Just TermShowR) + + breadcrumb CourseListR = return ("Kurs", Just HomeR) + breadcrumb (CourseListTermR term) = return (termToText term, Just TermShowR) + breadcrumb (CourseShowR term course) = return (course, Just $ CourseListTermR term) + breadcrumb CourseEditR = return ("Neu", Just CourseListR) + breadcrumb (CourseEditExistR _ _) = return ("Editieren", Just CourseListR) + + breadcrumb HomeR = return ("ReWorX", Nothing) breadcrumb (AuthR _) = return ("Login", Just HomeR) breadcrumb ProfileR = return ("Profile", Just HomeR) breadcrumb _ = return ("home", Nothing) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 445a26f1d..b63e51f89 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -257,7 +257,7 @@ validateCourse :: CourseForm -> [Text] validateCourse (CourseForm{..}) = [ msg | (False, msg) <- [ - ( cfHasReg <= (cfRegFrom <= cfRegTo) + ( cfRegFrom <= cfRegTo , "Ende des Anmeldezeitraums muss nach dem Anfang liegen" ) , @@ -266,11 +266,11 @@ validateCourse (CourseForm{..}) = -- , "Beginn der Anmeldung angeben oder Anmeldungen deaktivieren" -- ) -- , - ( cfHasReg <= (isNothing cfRegTo) + ( cfHasReg == (isJust cfRegTo) , "Ende des Anmeldezeitraums angeben oder Anmeldungen deaktivieren" ) , - ( (isJust cfRegFrom || isJust cfRegTo) <= cfHasReg + ( isJust cfRegFrom <= cfHasReg , "Anmeldungen aktivieren oder Anmeldezeitraum löschen" ) ] ] diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 11dec1ca5..1ee3d187b 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -1,67 +1,28 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} + module Handler.Home where -import Import -import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3) -import Text.Julius (RawJS (..)) +import Import +import Handler.Utils + +import Data.Time +import qualified Data.Text as T +import Yesod.Form.Bootstrap3 + +import Colonnade +import Yesod.Colonnade + +import qualified Data.UUID.Cryptographic as UUID --- Define our data that will be used for creating the form. -data FileForm = FileForm - { fileInfo :: FileInfo - , fileDescription :: Text - } --- This is a handler function for the GET request method on the HomeR --- resource pattern. All of your resource patterns are defined in --- config/routes --- --- The majority of the code you will write in Yesod lives in these handler --- functions. You can spread them across multiple files if you are so --- inclined, or create a single monolithic file. getHomeR :: Handler Html -getHomeR = do - (formWidget, formEnctype) <- generateFormPost sampleForm - let submission = Nothing :: Maybe FileForm - handlerName = "getHomeR" :: Text - defaultLayout $ do - let (commentFormId, commentTextareaId, commentListId) = commentIds - aDomId <- newIdent - setTitle "Welcome To Yesod!" - $(widgetFile "homepage") - -postHomeR :: Handler Html -postHomeR = do - ((result, formWidget), formEnctype) <- runFormPost sampleForm - let handlerName = "postHomeR" :: Text - submission = case result of - FormSuccess res -> Just res - _ -> Nothing - - defaultLayout $ do - let (commentFormId, commentTextareaId, commentListId) = commentIds - aDomId <- newIdent - setTitle "Welcome To Yesod!" - $(widgetFile "homepage") - -sampleForm :: Form FileForm -sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm - <$> fileAFormReq "Choose a file" - <*> areq textField textSettings Nothing - -- Add attributes like the placeholder and CSS classes. - where textSettings = FieldSettings - { fsLabel = "What's on the file?" - , fsTooltip = Nothing - , fsId = Nothing - , fsName = Nothing - , fsAttrs = - [ ("class", "form-control") - , ("placeholder", "File description") - ] - } - -commentIds :: (Text, Text, Text) -commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList") +getHomeR = defaultLayout $ do + setTitle "Willkommen zum ReWorX Test!" + $(widgetFile "home")