Merge branch 'master' into formgroups

routes

@@ -47,7 +47,6 @@
 /impressum                    ImpressumR        GET            !free
 /version                      VersionR          GET            !free
 
-
 /help                         HelpR             GET POST       !free
 
 /user                      ProfileR          GET POST        !free

src/Database/Esqueleto/Utils.hs

@@ -5,11 +5,11 @@ import Data.Foldable as F
 import Database.Esqueleto as E
 
 
-{-|
+--
-  Description : Convenience for using @Esqueleto@,
+-- Description : Convenience for using @Esqueleto@,
-                intended to be imported qualified
+--               intended to be imported qualified
-                just like Esqueleto
+--               just like Esqueleto
--}
+
 
 -- ezero = E.val (0 :: Int64)
 

src/Handler/Course.hs

@@ -34,36 +34,36 @@ colCourse = sortable (Just "course") (i18nCell MsgCourse)
             anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
               [whamlet|#{display courseName}|]
 
-colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
+-- colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
-colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
+-- colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
-    course <- view $ _dbrOutput . _1 . _entityVal
+--     course <- view $ _dbrOutput . _1 . _entityVal
-    return $ courseCell course
+--     return $ courseCell course
 
 colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
-colDescription = sortable Nothing (i18nCell MsgCourseDescription)
+colDescription = sortable Nothing mempty
           $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } ->
             case courseDescription of
               Nothing      -> mempty
-              (Just descr) -> cell $ modal "Beschreibung" (Right $ toWidget descr)
+              (Just descr) -> cell $ modal (commentWidget True) (Right $ toWidget descr)
 
 colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
 colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
           $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } ->
             anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
 
-colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+-- colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
-colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
+-- colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
-          $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
+--           $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
-            ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
+--             ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
-            ( case courseDescription of
+--             ( case courseDescription of
-                Nothing      -> mempty
+--                 Nothing      -> mempty
-                (Just descr) -> cell
+--                 (Just descr) -> cell
-                  [whamlet|
+--                   [whamlet|
-                    $newline never
+--                     $newline never
-                    <div>
+--                     <div>
-                      ^{modal "Beschreibung" (Right $ toWidget descr)}
+--                       ^{modal "Beschreibung" (Right $ toWidget descr)}
-                  |]
+--                   |]
-            )
+--             )
 
 colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
 colTerm = sortable (Just "term") (i18nCell MsgTerm)
@@ -190,7 +190,8 @@ getCourseListR :: Handler Html
 getCourseListR = do
   muid <- maybeAuthId
   let colonnade = widgetColonnade $ mconcat
-        [ colCourseDescr
+        [ colCourse -- colCourseDescr
+        , colDescription
         , colSchoolShort
         , colTerm
         , colCShort
@@ -220,7 +221,8 @@ getTermSchoolCourseListR tid ssh = do
   muid <- maybeAuthId
   let colonnade = widgetColonnade $ mconcat
         [ dbRow
-        , colCShortDescr
+        , colCShort
+        , colDescription
         , colRegFrom
         , colRegTo
         , colMembers
@@ -243,7 +245,8 @@ getTermCourseListR tid = do
   muid <- maybeAuthId
   let colonnade = widgetColonnade $ mconcat
         [ dbRow
-        , colCShortDescr
+        , colCShort
+        , colDescription
         , colSchoolShort
         , colRegFrom
         , colRegTo
@@ -632,15 +635,16 @@ userTableQuery whereClause returnStatement t@((user `E.InnerJoin` participant) `
   E.where_ $ whereClause t
   return $ returnStatement t
 
-instance HasUser UserTableData where
+instance HasEntity UserTableData CourseParticipant where
-  hasUser = _entityVal
+  hasEntity = _dbrOutput . _2
 
 instance HasEntity UserTableData User where
   hasEntity = _dbrOutput . _1
 
--- -- there can be only one -- FunctionalDependency violation
+instance HasUser UserTableData where
--- instance HasEntity UserTableData CourseParticipant where
+  -- hasUser = _entityVal
---   hasEntity = _dbrOutput . _2
+  hasUser = _dbrOutput . _1 . _entityVal
+
 
 courseIs :: CourseId -> UserTableWhere
 courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = participant E.^. CourseParticipantCourse E.==. E.val cid
@@ -650,6 +654,7 @@ courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = parti
 -- colUserParticipant' = sortable (Just "participant") (i18nCell MsgCourseMember)
 --     $ \DBRow { dbrOutput=(Entity _ user,_,_) } -> userCell (userDisplayName user) (userSurname user)
 
+
 colUserParticipant :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a)
 colUserParticipant = sortable (Just "participant") (i18nCell MsgCourseMember) cellHasUser
 

src/Handler/Utils.hs

@@ -75,6 +75,12 @@ visibleWidget :: Bool -> Widget
 visibleWidget True = mempty
 visibleWidget False = [whamlet|<i .fas .fa-eye-slash>|]
 
+isVisibleWidget :: Bool -> Widget
+-- ^ @visibleWidget True@ is an icon that denotes that something™ is visible
+isVisibleWidget True = [whamlet|<i .fas .fa-eye>|]
+isVisibleWidget False  = mempty
+
+
 commentWidget :: Bool -> Widget
 -- ^ @commentWidget True@ is an icon that denotes that something™ has a comment
 commentWidget True  = [whamlet|<i .fas .fa-comment-alt>|]

src/Handler/Utils/Table/Cells.hs

@@ -38,11 +38,17 @@ cellHasUser :: (IsDBTable m a, HasUser c) => c -> DBCell m a
 cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)
 
 cellHasUserLink :: (IsDBTable m a, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m a
+-- cellHasUserLink toLink user =
+--   let uid   = user ^. hasEntityUser . _entityKey
+--       nWdgt = nameWidget (user ^. hasEntityUser . _entityVal . _userDisplayName) (user ^. hasEntityUser .  _entityVal . _userSurname)
+--   in  anchorCellM (toLink <$> encrypt uid) nWdgt
 cellHasUserLink toLink user =
-  let uid   = user ^. _entityKey
+  let userEntity = user ^. hasEntityUser
-      nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname)
+      uid   = userEntity ^. _entityKey
+      nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^.  _entityVal . _userSurname)
   in  anchorCellM (toLink <$> encrypt uid) nWdgt
 
+
 cellHasMatrikelnummer :: (IsDBTable m a, HasUser c) => c -> DBCell m a
 cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
 

src/Jobs/Handler/QueueNotification.hs

@@ -4,7 +4,7 @@ module Jobs.Handler.QueueNotification
 
 import Import hiding ((\\))
 
-import Data.List ((\\))
+import Data.List (nub, (\\))
 
 import Jobs.Types
 
@@ -67,7 +67,7 @@ determineNotificationCandidates NotificationUserRightsUpdate{..}
         E.on $ admin E.^. UserAdminUser E.==. user E.^. UserId
         E.where_ $ admin E.^. UserAdminSchool `E.in_` E.valList newAdminSchools
         return user
-      return $ affectedUser <> affectedAdmins
+      return $ nub $ affectedUser <> affectedAdmins
 
 
 classifyNotification :: Notification -> DB NotificationTrigger

src/Utils/Lens.hs

@@ -26,34 +26,48 @@ _InnerJoinRight :: Lens' (E.InnerJoin l r) r
 _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
 
 
--- makeLenses_ ''Entity
+-----------------------------------
-makeClassyFor_ "HasEntity" "hasEntity" ''Entity
+-- Lens Definitions for our Types
--- class HasEntity c record | c -> record where
+
---   hasEntity :: Lens' c (Entity record)
 
 -- makeLenses_ ''Course
 makeClassyFor_ "HasCourse" "hasCourse" ''Course
 -- class HasCourse c where
 --   hasCourse :: Lens' c Course
 
-instance (HasCourse a) => HasCourse (Entity a) where
-  hasCourse = _entityVal . hasCourse
 
+-- makeLenses_ ''User
 makeClassyFor_ "HasUser" "hasUser" ''User
 -- > :info HasUser
--- class HasUser c where {-# MINIMAL hasUser #-}
+-- class HasUser c where
---   hasUser :: Lens' c User
+--   hasUser :: Lens' c User -- MINIMAL
 --   _userDisplayName :: Lens' c Text
 --   _userSurname :: Lens' c Text
 --   _user...
 --
 
--- TODO: Is this instance needed?
+
-instance (HasUser a) => HasUser (Entity a) where
+makeLenses_ ''Entity
-  hasUser = _entityVal . hasUser
+-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW:
--- This is what we would want instead:
+-- makeClassyFor_ "HasEntity" "hasEntity" ''Entity
+-- class HasEntity c record | c -> record where
+--   hasEntity :: Lens' c (Entity record)
+--
+-- Manual definition, explicitely leaving out the unwanted Functional Dependency, since we want Instances differing on the result-type
+class HasEntity c record where
+  hasEntity :: Lens' c (Entity record)
+
+-- Typed convenience to avoid type signatures, due to the missing FunctionalDepenency that we do not want.
+hasEntityUser :: (HasEntity a User) => Lens' a (Entity User)
+hasEntityUser = hasEntity
+
+-- This is what we would want, but is an UndecidableInstance since the type is not reduced:
 -- instance (HasEntity a User) => HasUser a where
---   hasUser = _entityVal
+--   hasUser = hasEntityUser
+--
+-- Possible, but rather useless:
+-- instance (HasUser a) => HasUser (Entity a) where
+--   hasUser = _entityVal . hasUser
 
 
 makeLenses_ ''SheetCorrector

src/Utils/Lens/TH.hs

@@ -6,7 +6,8 @@ import Control.Lens.Internal.FieldTH
 import Language.Haskell.TH
 
 -- import Control.Lens.Misc
-{-  NOTE: The code for lensRules_  and makeLenses_ was stolen from package lens-misc-0.0.2.0,
+{-
+    NOTE: The code for lensRules_  and makeLenses_ was stolen from package lens-misc-0.0.2.0,
     which was currently unavailable in our stack snapshot.
     See https://github.com/louispan/lens-misc
 -}
@@ -16,7 +17,7 @@ lensRules_ :: LensRules
 lensRules_ = lensRules
     & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))]
 
--- | Like lensRules_, but different class and function name
+-- | Like @lensRules_@, but different class and function name
 classyRulesFor_ :: ClassyNamer -> LensRules
 classyRulesFor_ clsNamer = classyRules
     & lensClass .~ clsNamer

templates/adminUser.hamlet

@@ -1,3 +1,5 @@
+<p>
+  <a href="mailto:#{userEmail}">#{userEmail}
 <form method=post action=@{AdminUserR uuid} enctype=#{formEnctype}>
   ^{formWidget}
   ^{submitButtonView}

templates/data-protection-de.hamlet

@@ -1,7 +1,7 @@
 <div .container>
   <section>
-    <h2>Stand
+$#    <h2>Stand
-    <h3>Version 0.91 vom 22.5.2018
+$#    <h3>Version 0.91 vom 22.5.2018
     <p>
       Die LMU unterliegt als Körperschaft des öffentlichen Rechts dem
       bayerischen Datenschutzgesetz, in einigen Bereichen dem Bundesdatenschutzgesetz,

test/Database.hs

@@ -218,9 +218,22 @@ fillDb = do
   repsert sdInf  $ StudyTerms  79 (Just "IfI") (Just "Institut für Informatik")
   repsert sdMath $ StudyTerms 105 (Just "MI" ) (Just "Mathematisches Institut")
   -- FFP
+  let nbrs :: [Int]
+      nbrs = [1,2,3,27,7,1]
   ffp <- insert' Course
     { courseName = "Fortgeschrittene Funktionale Programmierung"
-    , courseDescription = Nothing
+    , courseDescription = Just [shamlet|
+        <h2>It is fun!
+          <p>Come to where the functional is!
+          <section>
+            <h3>Functional programming can be done in Haskell!
+            <p>This is not a joke, this is serious!
+          <section>
+            <h3>Consider some numbers
+            <ul>
+              $forall n <- nbrs
+                <li>Number #{n}
+        |]
     , courseLinkExternal = Nothing
     , courseShorthand = "FFP"
     , courseTerm = TermKey summer2018
@@ -354,7 +367,7 @@ fillDb = do
   -- datenbanksysteme
   dbs <- insert' Course
     { courseName = "Datenbanksysteme"
-    , courseDescription = Nothing
+    , courseDescription = Just "Datenbanken banken Daten damit die Daten nicht wanken. Die Datenschützer danken!"
     , courseLinkExternal = Nothing
     , courseShorthand = "DBS"
     , courseTerm = TermKey summer2018