Temporary Homepage and Breadcrumbs working.
This commit is contained in:
parent
e85b130a0d
commit
2b78bce646
2
models
2
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
|
||||
|
||||
6
routes
6
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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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"
|
||||
)
|
||||
] ]
|
||||
|
||||
@ -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")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user