Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

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
 

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

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"

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{..}, _, _) } ->
+          $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
-            anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|]
+            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| <span style="float:right"> ^{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|<span style="float:right"> ^{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
+      dbtSQLQuery qin@(course `E.InnerJoin` school) = do
-        let participants = course2Participants course
+        E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
-        let registered   = course2Registered muid course
+        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)
+        [ ( "course",        SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseName)
-        , ( "cshort",        SortColumn $ \course -> course E.^. CourseShorthand)
+        , ( "cshort",        SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseShorthand)
-        , ( "term"  ,        SortColumn $ \course -> course E.^. CourseTerm)
+        , ( "term"  ,        SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseTerm)
-        , ( "register-from", SortColumn $ \course -> course E.^. CourseRegisterFrom)
+        , ( "school",        SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolName)
-        , ( "register-to",   SortColumn $ \course -> course E.^. CourseRegisterTo)
+        , ( "schoolshort",   SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolShorthand)
-        , ( "participants",  SortColumn $ course2Participants
+        , ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom)
-          )
+        , ( "register-to",   SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo)
-        , ( "registered",    SortColumn $ course2Registered muid
+        , ( "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

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 ()
+modalStatic :: Html -> WidgetT site IO ()
-modal modalTrigger (Just modalContent) = do
+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|<div .tooltip__handle ##{uniqueId}>?|] -- 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

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 {

templates/widgets/modalStatic.hamlet

@@ -0,0 +1,2 @@
+<div .modal.js-modal #modal-#{modalId} data-trigger=#{modalTrigger} data-closeable=true>
+  #{modalContent}