diff --git a/messages/de.msg b/messages/de.msg index 618a03950..714e9b046 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -63,7 +63,9 @@ EMail: E-Mail EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer. NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs #{termToText tid}-#{csh} angemeldet. -HomeHeading: Startseite +HomeHeading: Aktuelle Termine +ProfileHeading: Benutzerprofil und Einstellungen +ProfileDataHeading: Gespeicherte Benutzerdaten TermsHeading: Semesterübersicht NumCourses n@Int64: #{tshow n} Kurse diff --git a/routes b/routes index 140ccde30..9b4631aa7 100644 --- a/routes +++ b/routes @@ -30,16 +30,18 @@ /favicon.ico FaviconR GET !free /robots.txt RobotsR GET !free -/ HomeR GET !free -/profile ProfileR GET !free -/users UsersR GET -- no tags, i.e. admins only -/admin/test AdminTestR GET POST +/ HomeR GET !free +/users UsersR GET -- no tags, i.e. admins only +/admin/test AdminTestR GET POST -/terms TermShowR GET !free -/terms/current TermCurrentR GET !free -/terms/edit TermEditR GET POST -/terms/#TermId/edit TermEditExistR GET -!/terms/#TermId TermCourseListR GET !free +/profile ProfileR GET POST !free !free +/profile/data ProfileDataR GET !free !free + +/terms TermShowR GET !free +/terms/current TermCurrentR GET !free +/terms/edit TermEditR GET POST +/terms/#TermId/edit TermEditExistR GET +!/terms/#TermId TermCourseListR GET !free -- For Pattern Synonyms see Foundation /course/ CourseListR GET !free diff --git a/src/Foundation.hs b/src/Foundation.hs index 0f6021eee..b2bc859bb 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -579,9 +579,10 @@ instance YesodBreadcrumbs UniWorX where breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) - breadcrumb HomeR = return ("Uniworky", Nothing) + breadcrumb HomeR = return ("UniWorkY", Nothing) breadcrumb (AuthR _) = return ("Login", Just HomeR) breadcrumb ProfileR = return ("Profile", Just HomeR) + breadcrumb ProfileDataR = return ("Data", Just ProfileR) breadcrumb _ = return ("home", Nothing) pageActions :: Route UniWorX -> [MenuTypes] @@ -637,6 +638,14 @@ pageActions (TermCourseListR _) = , menuItemAccessCallback' = return True } ] +pageActions (ProfileR) = + [ PageActionPrime $ MenuItem + { menuItemLabel = "Gespeicherte Daten anzeigen" + , menuItemIcon = Just "book" + , menuItemRoute = ProfileDataR + , menuItemAccessCallback' = return True + } + ] pageActions (HomeR) = [ -- NavbarAside $ MenuItem @@ -662,6 +671,12 @@ i18nHeading msg = liftWidgetT $ toWidget =<< getMessageRender <*> pure msg pageHeading :: Route UniWorX -> Maybe Widget pageHeading HomeR = Just $ i18nHeading MsgHomeHeading +pageHeading (AdminTestR) + = Just $ [whamlet|Internal Code Demonstration Page|] +pageHeading ProfileR + = Just $ i18nHeading MsgProfileHeading +pageHeading ProfileDataR + = Just $ i18nHeading MsgProfileDataHeading pageHeading TermShowR = Just $ i18nHeading MsgTermsHeading pageHeading TermEditR @@ -675,8 +690,6 @@ pageHeading (CourseR tid csh CShowR) Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermShort tid csh toWidget courseName -- TODO: add headings for more single course- and single term-pages -pageHeading (AdminTestR) - = Just $ [whamlet|Internal Code Demonstration Page|] pageHeading _ = Nothing diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index d5c794037..cf84ceb8c 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -44,88 +44,90 @@ offSheetDeadlines = 15 getHomeR :: Handler Html getHomeR = do muid <- maybeAuthId - -- let uid = fromMaybe (Key 1) muid -- TODO: delete me - cTime <- liftIO getCurrentTime - let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime + case muid of + Nothing -> defaultLayout [whamlet| Bitte einloggen! |] + Just uid -> do + -- let uid = fromMaybe (Key 1) muid -- TODO: delete me + cTime <- liftIO getCurrentTime + let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime - tableData :: (Maybe (Key User)) - -> E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) - (E.SqlExpr (Entity Course ))) - (E.SqlExpr (Entity Sheet )) - -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term)) - , E.SqlExpr (E.Value Text) - , E.SqlExpr (E.Value Text) - , E.SqlExpr (E.Value UTCTime)) + tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) + (E.SqlExpr (Entity Course ))) + (E.SqlExpr (Entity Sheet )) + -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term)) + , E.SqlExpr (E.Value Text) + , E.SqlExpr (E.Value Text) + , E.SqlExpr (E.Value UTCTime)) --- tableData Nothing ( course `E.InnerJoin` sheet) = do --- E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse --- E.where_ $ sheet E.^. SheetActiveTo E.<=. E.val fTime --- E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime --- E.limit nrSheetDeadlines --- E.orderBy [ E.asc $ sheet E.^. SheetActiveTo --- , E.desc $ sheet E.^. SheetName --- , E.desc $ course E.^. CourseShorthand --- ] --- E.limit nrSheetDeadlines --- return --- ( course E.^. CourseTerm --- , course E.^. CourseShorthand --- , sheet E.^. SheetName --- , sheet E.^. SheetActiveTo --- ) + -- tableData Nothing ( course `E.InnerJoin` sheet) = do + -- E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + -- E.where_ $ sheet E.^. SheetActiveTo E.<=. E.val fTime + -- E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime + -- E.limit nrSheetDeadlines + -- E.orderBy [ E.asc $ sheet E.^. SheetActiveTo + -- , E.desc $ sheet E.^. SheetName + -- , E.desc $ course E.^. CourseShorthand + -- ] + -- E.limit nrSheetDeadlines + -- return + -- ( course E.^. CourseTerm + -- , course E.^. CourseShorthand + -- , sheet E.^. SheetName + -- , sheet E.^. SheetActiveTo + -- ) - tableData (Just uid) (participant `E.InnerJoin` course `E.InnerJoin` sheet) = do - E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse - E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse - E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid - E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime - E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime - E.orderBy [ E.asc $ sheet E.^. SheetActiveTo - , E.desc $ sheet E.^. SheetName - , E.desc $ course E.^. CourseShorthand - ] - E.limit nrSheetDeadlines - return - ( course E.^. CourseTerm - , course E.^. CourseShorthand - , sheet E.^. SheetName - , sheet E.^. SheetActiveTo - ) - - colonnade :: Colonnade Sortable (DBRow (E.Value (Key Term), E.Value Text, E.Value Text, E.Value UTCTime)) (Cell UniWorX) - colonnade = mconcat - [ -- dbRow - sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _) } -> - cell [whamlet|#{display csh}|] - , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } -> - cell [whamlet|#{display shn}|] - , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline) } -> - textCell $ display deadline - , sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(_, _, _, _) } -> - textCell $ "?" - ] - sheetTable <- dbTable def $ DBTable - { dbtSQLQuery = tableData muid - , dbtColonnade = colonnade - , dbtSorting = [ ( "term" - , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm - ) - , ( "course" - , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseShorthand - ) - -- TODO + tableData (participant `E.InnerJoin` course `E.InnerJoin` sheet) = do + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse + E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid + E.&&. sheet E.^. SheetActiveTo E.<=. E.val fTime + E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime + E.orderBy [ E.asc $ sheet E.^. SheetActiveTo + , E.desc $ sheet E.^. SheetName + , E.desc $ course E.^. CourseShorthand ] - , dbtFilter = mempty {- [ ( "term" - , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if - | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool) - | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) - ) - ] -} - , dbtAttrs = tableDefault - , dbtIdent = "upcomingdeadlines" :: Text - } + E.limit nrSheetDeadlines + return + ( course E.^. CourseTerm + , course E.^. CourseShorthand + , sheet E.^. SheetName + , sheet E.^. SheetActiveTo + ) + + colonnade :: Colonnade Sortable (DBRow (E.Value (Key Term), E.Value Text, E.Value Text, E.Value UTCTime)) (Cell UniWorX) + colonnade = mconcat + [ -- dbRow + sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _) } -> + cell [whamlet|#{display csh}|] + , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _) } -> + cell [whamlet|#{display shn}|] + , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline) } -> + textCell $ display deadline + , sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(_, _, _, _) } -> + textCell $ "?" + ] + sheetTable <- dbTable def $ DBTable + { dbtSQLQuery = tableData + , dbtColonnade = colonnade + , dbtSorting = [ ( "term" + , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseTerm + ) + , ( "course" + , SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ ) -> course E.^. CourseShorthand + ) + -- TODO + ] + , dbtFilter = mempty {- [ ( "term" + , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if + | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) + ) + ] -} + , dbtAttrs = tableDefault + , dbtIdent = "upcomingdeadlines" :: Text + } - defaultLayout $ do - setTitle "Willkommen zum Uniworky Test!" - $(widgetFile "home") + defaultLayout $ do + setTitle "Willkommen zum Uniworky Test!" + $(widgetFile "home") diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 4faefd841..e4f3ee9bb 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} @@ -10,8 +11,8 @@ import Import import Handler.Utils -import Colonnade hiding (fromMaybe, singleton) -import Yesod.Colonnade +-- import Colonnade hiding (fromMaybe, singleton) +-- import Yesod.Colonnade import qualified Database.Esqueleto as E import Database.Esqueleto ((^.)) @@ -19,18 +20,18 @@ import Database.Esqueleto ((^.)) getProfileR :: Handler Html getProfileR = do (uid, User{..}) <- requireAuthPair - mr <- getMessageRender + -- mr <- getMessageRender (admin_rights,lecturer_rights,lecture_owner,lecture_corrector,participant,studies) <- runDB $ (,,,,,) <$> (E.select $ E.from $ \(adright `E.InnerJoin` school) -> do E.where_ $ adright ^. UserAdminUser E.==. E.val uid E.on $ adright ^. UserAdminSchool E.==. school ^. SchoolId - return (school ^. SchoolName) + return (school ^. SchoolShorthand) ) <*> (E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do E.where_ $ lecright ^. UserLecturerUser E.==. E.val uid E.on $ lecright ^. UserLecturerSchool E.==. school ^. SchoolId - return (school ^. SchoolName) + return (school ^. SchoolShorthand) ) <*> (E.select $ E.from $ \(lecturer `E.InnerJoin` course) -> do @@ -61,20 +62,21 @@ getProfileR = do ,studyfeat ^. StudyFeaturesSemester) ) - let userData = - [ (MsgName , userDisplayName ) - , (MsgIdent , userIdent ) - , (MsgPlugin , userPlugin ) - , (MsgMatrikelNr , display userMatrikelnummer) - , (MsgEMail , userEmail ) - , (MsgFavoriten , display userMaxFavourites) - , (MsgTheme , display userTheme ) - ] - userDisplay = mconcat - [ headless $ toWgt . mr . fst - , headless $ toWgt . snd - ] --TODO Continue here!!! - userTable = encodeWidgetTable tableDefault userDisplay userData defaultLayout $ do setTitle . toHtml $ userIdent <> "'s User page" $(widgetFile "profile") + + +postProfileR :: Handler Html +postProfileR = do + -- TODO + getProfileR + + +getProfileDataR :: Handler Html +getProfileDataR = do + (uid, User{..}) <- requireAuthPair + -- mr <- getMessageRender + + defaultLayout $ do + $(widgetFile "profileData") diff --git a/src/Utils.hs b/src/Utils.hs index 2ee4bd534..4c3a4a0e6 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -128,6 +128,12 @@ trd3 (_,_,z) = z -- snd3 = $(projNI 3 2) +----------- +-- Lists -- +----------- + +-- notNull = not . null + ---------- -- Maps -- diff --git a/templates/home.hamlet b/templates/home.hamlet index 44d3115a5..cd79b6192 100644 --- a/templates/home.hamlet +++ b/templates/home.hamlet @@ -13,9 +13,12 @@ $maybe _ <- muid ^{sheetTable} -

Anstehende Klausuren - TODO -

Anstehende Kursanmeldungen - TODO +

+ Anstehende Klausuren + TODO + +

+ Anstehende Kursanmeldungen + TODO diff --git a/templates/profile.hamlet b/templates/profile.hamlet index e2f31cf94..6e3693eaa 100644 --- a/templates/profile.hamlet +++ b/templates/profile.hamlet @@ -1,80 +1,79 @@

- Access granted! + _{MsgProfileHeading} #{userDisplayName} -

- This page is protected and access is allowed only for authenticated users. + + + + + + + + + + + +
_{MsgName} + #{display userDisplayName} +
_{MsgMatrikelNr} + #{display userMatrikelnummer} +
_{MsgEMail} + #{display userEmail} +
_{MsgIdent} + #{display userIdent} +
_{MsgPlugin} + #{display userPlugin} + $if not $ null admin_rights +
Administrator + +
    + $forall institute <- admin_rights +
  • #{display institute} + $if not $ null lecturer_rights +
Lehrberechtigt + +
    + $forall institute <- lecturer_rights +
  • #{display institute} + $if not $ null lecture_owner +
Eigene Kurse + +
Korrektor + +
Studiengänge + + + + + +
Abschluss + Studiengang + Studienart + Semester -

- Your data is protected with us #{userIdent}! - - $if not $ null admin_rights -

- Administrator für die Institute -
    - $forall institute <- admin_rights -
  • #{display institute} - $if not $ null lecturer_rights -

    - Lehrberechtigung für die Institute -
      - $forall institute <- lecturer_rights -
    • #{display institute} + $forall (degree,field,fieldtype,semester) <- studies +

#{display degree} + #{display field} + #{display fieldtype} + #{display semester} + $if not $ null participant +
Teilnehmer + +