Temporary Homepage and Breadcrumbs working.

This commit is contained in:
SJost 2017-10-10 18:35:43 +02:00
parent e85b130a0d
commit 2b78bce646
5 changed files with 37 additions and 66 deletions

2
models
View File

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

6
routes
View File

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

View File

@ -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)

View File

@ -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"
)
] ]

View File

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