diff --git a/routes b/routes index 994822a7b..1a9f35659 100644 --- a/routes +++ b/routes @@ -47,7 +47,6 @@ /impressum ImpressumR GET !free /version VersionR GET !free - /help HelpR GET POST !free /user ProfileR GET POST !free diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 9e78f9fd0..41464cc00 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -5,11 +5,11 @@ import Data.Foldable as F import Database.Esqueleto as E -{-| - Description : Convenience for using @Esqueleto@, - intended to be imported qualified - just like Esqueleto --} +-- +-- Description : Convenience for using @Esqueleto@, +-- intended to be imported qualified +-- just like Esqueleto + -- ezero = E.val (0 :: Int64) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index e7cf7276b..eb0936540 100644 --- a/src/Handler/Course.hs +++ b/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 = sortable (Just "course") (i18nCell MsgCourse) $ do - course <- view $ _dbrOutput . _1 . _entityVal - return $ courseCell course +-- colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) +-- colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do +-- course <- view $ _dbrOutput . _1 . _entityVal +-- 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 = sortable (Just "cshort") (i18nCell MsgCourseShort) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend - ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] ) - ( case courseDescription of - Nothing -> mempty - (Just descr) -> cell - [whamlet| - $newline never -
- ^{modal "Beschreibung" (Right $ toWidget descr)} - |] - ) +-- colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +-- colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort) +-- $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend +-- ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] ) +-- ( case courseDescription of +-- Nothing -> mempty +-- (Just descr) -> cell +-- [whamlet| +-- $newline never +--
+-- ^{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 - hasUser = _entityVal +instance HasEntity UserTableData CourseParticipant where + hasEntity = _dbrOutput . _2 instance HasEntity UserTableData User where hasEntity = _dbrOutput . _1 --- -- there can be only one -- FunctionalDependency violation --- instance HasEntity UserTableData CourseParticipant where --- hasEntity = _dbrOutput . _2 +instance HasUser UserTableData where + -- hasUser = _entityVal + 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 diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index f899f2991..e45890f58 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -75,6 +75,12 @@ visibleWidget :: Bool -> Widget visibleWidget True = mempty visibleWidget False = [whamlet||] +isVisibleWidget :: Bool -> Widget +-- ^ @visibleWidget True@ is an icon that denotes that something™ is visible +isVisibleWidget True = [whamlet||] +isVisibleWidget False = mempty + + commentWidget :: Bool -> Widget -- ^ @commentWidget True@ is an icon that denotes that something™ has a comment commentWidget True = [whamlet||] diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 453c04d9e..802ae21a2 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/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 - nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname) + let userEntity = user ^. hasEntityUser + 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 diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 5dfdc20fa..3d226f72a 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/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 diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 3fea6ff14..b8ac05e63 100644 --- a/src/Utils/Lens.hs +++ b/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 --- class HasEntity c record | c -> record where --- hasEntity :: Lens' c (Entity record) +----------------------------------- +-- Lens Definitions for our Types + -- 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 #-} --- hasUser :: Lens' c User +-- class HasUser c where +-- 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 - hasUser = _entityVal . hasUser --- This is what we would want instead: + +makeLenses_ ''Entity +-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW: +-- 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 diff --git a/src/Utils/Lens/TH.hs b/src/Utils/Lens/TH.hs index dffbf10c0..b8d8857a7 100644 --- a/src/Utils/Lens/TH.hs +++ b/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 diff --git a/templates/adminUser.hamlet b/templates/adminUser.hamlet index 30d7961f5..5909795a5 100644 --- a/templates/adminUser.hamlet +++ b/templates/adminUser.hamlet @@ -1,3 +1,5 @@ +

+ #{userEmail}

^{formWidget} ^{submitButtonView} diff --git a/templates/data-protection-de.hamlet b/templates/data-protection-de.hamlet index 04e775a99..73fae7c7b 100644 --- a/templates/data-protection-de.hamlet +++ b/templates/data-protection-de.hamlet @@ -1,7 +1,7 @@
-

Stand -

Version 0.91 vom 22.5.2018 +$#

Stand +$#

Version 0.91 vom 22.5.2018

Die LMU unterliegt als Körperschaft des öffentlichen Rechts dem bayerischen Datenschutzgesetz, in einigen Bereichen dem Bundesdatenschutzgesetz, diff --git a/test/Database.hs b/test/Database.hs index 2fc8a7dc5..69ef0a541 100755 --- a/test/Database.hs +++ b/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| +

It is fun! +

Come to where the functional is! +

+

Functional programming can be done in Haskell! +

This is not a joke, this is serious! +

+

Consider some numbers +
    + $forall n <- nbrs +
  • 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