Temporary Homepage and Breadcrumbs working.

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 

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

src/Foundation.hs

@@ -222,8 +222,18 @@ instance Yesod UniWorX where
     makeLogger = return . appLogger
 
 -- Define breadcrumbs.
-instance YesodBreadcrumbs UniWorX where
+instance YesodBreadcrumbs UniWorX where  
-  breadcrumb HomeR = return ("Home", Nothing)
+  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)

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

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 Import 
-import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
+import Handler.Utils
-import Text.Julius (RawJS (..))
+
+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
+getHomeR = defaultLayout $ do
-    (formWidget, formEnctype) <- generateFormPost sampleForm
+  setTitle "Willkommen zum ReWorX Test!"
-    let submission = Nothing :: Maybe FileForm
+  $(widgetFile "home")
-        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")