diff --git a/ChangeLog.md b/ChangeLog.md index a114345ce..c0392847e 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,7 @@ * Version 01.08.2018 Verbesserter Campus-Login + (Ersatz einer C-Bibliothek mit undokumentierter Abhängigkeit durch selbst entwickelten Haskell-Code erlaubt nun auch Umlaute.) * Version 31.07.2018 diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 9e899f3e5..8a17dda78 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -60,6 +60,7 @@ CourseShorthand: Kürzel CourseShorthandUnique: Muss innerhalb des Semesters eindeutig sein CourseSemester: Semester CourseSchool: Institut +CourseSchoolShort: Fach CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein diff --git a/src/Foundation.hs b/src/Foundation.hs index b084badb5..45ca5f47b 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -822,6 +822,14 @@ pageActions (TermCourseListR tid) = , menuItemAccessCallback' = return True } ] +pageActions (CourseListR) = + [ PageActionPrime $ MenuItem + { menuItemLabel = "Neuen Kurs anlegen" + , menuItemIcon = Just "book" + , menuItemRoute = CourseNewR + , menuItemAccessCallback' = return True + } + ] pageActions (CourseR tid csh CShowR) = [ PageActionPrime $ MenuItem { menuItemLabel = "Kurs Editieren" diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 4ff4676a7..269c07d97 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -10,6 +10,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} module Handler.Course where @@ -33,57 +34,89 @@ import qualified Database.Esqueleto as E import qualified Data.UUID.Cryptographic as UUID -type CourseTableData = DBRow (Entity Course, Int64, Bool) +type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School) colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> - anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|] + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> + anchorCell (CourseR courseTerm courseShorthand CShowR) + [whamlet|#{display courseName}|] + +colCourseDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> mappend + ( anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|] ) + ( case courseDescription of + Nothing -> mempty + (Just descr) -> cell [whamlet| ^{modalStatic descr} |] + ) + +colDescription :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colDescription = sortable Nothing (i18nCell MsgCourseDescription) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> + case courseDescription of + Nothing -> mempty + (Just descr) -> cell $ modalStatic descr colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|] +colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> mappend + ( anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|] ) + ( case courseDescription of + Nothing -> mempty + (Just descr) -> cell + [whamlet| ^{modalStatic descr} |] + ) + colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colTerm = sortable (Just "term") (i18nCell MsgTerm) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> anchorCell (TermCourseListR courseTerm) [whamlet|#{display courseTerm}|] +colSchool :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colSchool = sortable (Just "school") (i18nCell MsgCourseSchool) + $ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } -> + cell [whamlet|#{display schoolName}|] + +colSchoolShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort) + $ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } -> + cell [whamlet|#{display schoolShorthand}|] + colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _) } -> textCell $ case courseCapacity of + $ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _, _) } -> textCell $ case courseCapacity of Nothing -> MsgCourseMembersCount currentParticipants Just max -> MsgCourseMembersCountLimited currentParticipants max colRegistered :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colRegistered = sortable (Just "registered") (i18nCell MsgRegistered) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, registered) } -> tickmarkCell registered + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, registered, _) } -> tickmarkCell registered -type CourseTableExpr = E.SqlExpr (Entity Course) +type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School) course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int64) -course2Participants course = E.sub_select . E.from $ \courseParticipant -> do +course2Participants (course `E.InnerJoin` _school) = E.sub_select . E.from $ \courseParticipant -> do E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId return (E.countRows :: E.SqlExpr (E.Value Int64)) -course2School :: CourseTableExpr -> E.SqlExpr _ -- this is a bad hack, change to proper innerjoin -course2School course = E.subList_select . E.from $ \school -> do - E.where_ $ course E.^. CourseSchool E.==. school E.^. SchoolId - return (school E.^. SchoolShorthand) - course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool) -course2Registered muid course = E.exists . E.from $ \courseParticipant -> do +course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant -> do E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid @@ -92,41 +125,50 @@ makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h ) makeCourseTable whereClause colChoices psValidator = do muid <- maybeAuthId let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _ - dbtSQLQuery course = do - let participants = course2Participants course - let registered = course2Registered muid course + dbtSQLQuery qin@(course `E.InnerJoin` school) = do + E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId + let participants = course2Participants qin + let registered = course2Registered muid qin E.where_ $ whereClause (course, participants, registered) - return (course, participants, registered) + return (course, participants, registered, school) dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData - dbtProj = traverse $ \(course, E.Value participants, E.Value registered) -> return (course, participants, registered) + dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> return (course, participants, registered, school) dbTable psValidator $ DBTable { dbtSQLQuery , dbtColonnade = colChoices , dbtProj , dbtSorting = Map.fromList -- OverloadedLists does not work with the templates here - [ ( "course", SortColumn $ \course -> course E.^. CourseName) - , ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand) - , ( "term" , SortColumn $ \course -> course E.^. CourseTerm) - , ( "register-from", SortColumn $ \course -> course E.^. CourseRegisterFrom) - , ( "register-to", SortColumn $ \course -> course E.^. CourseRegisterTo) - , ( "participants", SortColumn $ course2Participants - ) - , ( "registered", SortColumn $ course2Registered muid - ) + [ ( "course", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseName) + , ( "cshort", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseShorthand) + , ( "term" , SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseTerm) + , ( "school", SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolName) + , ( "schoolshort", SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolShorthand) + , ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom) + , ( "register-to", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo) + , ( "participants", SortColumn $ course2Participants ) + , ( "registered", SortColumn $ course2Registered muid) ] , dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here - [ ( "course", FilterColumn $ \(course :: CourseTableExpr) criterias -> if + [ ( "course", FilterColumn $ \(course `E.InnerJoin` _school:: CourseTableExpr) criterias -> if | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) | otherwise -> course E.^. CourseName `E.in_` E.valList (Set.toList criterias) ) - , ( "cshort", FilterColumn $ \(course :: CourseTableExpr) criterias -> if + , ( "cshort", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) | otherwise -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList criterias) ) - , ( "term" , FilterColumn $ \(course :: CourseTableExpr) criterias -> if + , ( "term" , FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias) ) + , ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if + | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> school E.^. SchoolName `E.in_` E.valList (Set.toList criterias) + ) + , ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if + | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> school E.^. SchoolShorthand `E.in_` E.valList (Set.toList criterias) + ) ] , dbtStyle = def , dbtIdent = "courses" :: Text @@ -136,10 +178,11 @@ getCourseListR :: Handler Html getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!! muid <- maybeAuthId let colonnade = widgetColonnade $ mconcat - [ colCourse + [ colCourseDescr , colCShort , colTerm , maybe mempty (const colRegistered) muid + , colSchool ] whereClause = const $ E.val True validator = def @@ -164,7 +207,8 @@ getTermCourseListR tid = do muid <- maybeAuthId let colonnade = widgetColonnade $ mconcat [ dbRow - , colCShort + , colCShortDescr + , colSchoolShort , colRegFrom , colRegTo , colParticipants diff --git a/src/Handler/Utils/Templates.hs b/src/Handler/Utils/Templates.hs index 8bae783b0..e29d9e3f9 100644 --- a/src/Handler/Utils/Templates.hs +++ b/src/Handler/Utils/Templates.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude, TemplateHaskell #-} +{-# LANGUAGE NoImplicitPrelude, TemplateHaskell, QuasiQuotes #-} module Handler.Utils.Templates where @@ -7,8 +7,17 @@ import Import.NoFoundation lipsum :: WidgetT site IO () lipsum = $(widgetFile "widgets/lipsum") -modal :: [Char] -> Maybe [Char] -> WidgetT site IO () -modal modalTrigger (Just modalContent) = do +modalStatic :: Html -> WidgetT site IO () +modalStatic modalContent = do + uniqueId <- newIdent + let modalTrigger = cons '#' uniqueId -- SJ: I am confused why this is needed here? + modalId :: Int32 + modalId = 13 + $(widgetFile "widgets/modalStatic") + [whamlet|
?|] -- SJ: confused why ## is needed here either? + +modal :: Text -> Maybe [Char] -> WidgetT site IO () +modal modalTrigger (Just modalContent) = do -- WARNING: ModalContent should not have length 11. SJ: This is possibly bad. See Template! let modalId :: Int32 modalId = 13 diff --git a/templates/standalone/tooltip.lucius b/templates/standalone/tooltip.lucius index fdd05afd0..b123609c6 100644 --- a/templates/standalone/tooltip.lucius +++ b/templates/standalone/tooltip.lucius @@ -2,59 +2,59 @@ position: relative; display: inline-block; - .tooltip__handle { - background-color: var(--color-dark); - border-radius: 50%; - height: 1.5rem; - width: 1.5rem; - line-height: 1.5rem; - font-size: 1.2rem; - color: white; - display: inline-block; - text-align: center; - cursor: default; - margin: 0 10px; - } - - .tooltip__content { - position: absolute; - top: -10px; - transform: translateY(-100%); - left: 3px; - width: 275px; - z-index: 10; - background-color: #fafafa; - border-radius: 4px; - padding: 13px 17px; - box-shadow: 0 0 20px 4px rgba(0, 0, 0, 0.1); - - &.to-left { - left: auto; - right: 3px; - - &::after { - left: auto; - right: 10px; - } - } - - &::after { - content: ''; - width: 16px; - height: 16px; - background-color: #fafafa; - transform: rotate(45deg); - position: absolute; - left: 10px; - bottom: -8px; - } - } - .hidden { display: none; } } +.tooltip__handle { + background-color: var(--color-dark); + border-radius: 50%; + height: 1.5rem; + width: 1.5rem; + line-height: 1.5rem; + font-size: 1.2rem; + color: white; + display: inline-block; + text-align: center; + cursor: default; + margin: 0 10px; +} + +.tooltip__content { + position: absolute; + top: -10px; + transform: translateY(-100%); + left: 3px; + width: 275px; + z-index: 10; + background-color: #fafafa; + border-radius: 4px; + padding: 13px 17px; + box-shadow: 0 0 20px 4px rgba(0, 0, 0, 0.1); + + &.to-left { + left: auto; + right: 3px; + + &::after { + left: auto; + right: 10px; + } + } + + &::after { + content: ''; + width: 16px; + height: 16px; + background-color: #fafafa; + transform: rotate(45deg); + position: absolute; + left: 10px; + bottom: -8px; + } +} + @media (max-width: 768px) { .js-tooltip { diff --git a/templates/widgets/modalStatic.hamlet b/templates/widgets/modalStatic.hamlet new file mode 100644 index 000000000..a9b8e3587 --- /dev/null +++ b/templates/widgets/modalStatic.hamlet @@ -0,0 +1,2 @@ +
+ #{modalContent}