Minor

src/Handler/Course.hs

@@ -633,7 +633,14 @@ userTableQuery whereClause returnStatement t@((user `E.InnerJoin` participant) `
   return $ returnStatement t
 
 instance HasUser UserTableData where
-  hasUser = _dbrOutput . _1 . _entityVal
+  hasUser = _entityVal
+
+instance HasEntity UserTableData User where
+  hasEntity = _dbrOutput . _1
+
+-- -- there can be only one -- FunctionalDependency violation
+-- instance HasEntity UserTableData CourseParticipant where
+--   hasEntity = _dbrOutput . _2
 
 courseIs :: CourseId -> UserTableWhere
 courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = participant E.^. CourseParticipantCourse E.==. E.val cid
@@ -646,6 +653,11 @@ courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = parti
 colUserParticipant :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a)
 colUserParticipant = sortable (Just "participant") (i18nCell MsgCourseMember) cellHasUser
 
+colUserParticipantLink :: IsDBTable m a => TermId -> SchoolId -> CourseShorthand -> Colonnade _ UserTableData (DBCell m a)
+colUserParticipantLink tid ssh csh = sortable (Just "participant") (i18nCell MsgCourseMember) (cellHasUserLink courseLink)
+  where
+    courseLink = CourseR tid ssh csh . CUserR
+
 colUserMatriclenr :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a)
 colUserMatriclenr = sortable (Just "matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
 

src/Handler/Users.hs

@@ -21,6 +21,11 @@ hijackUserForm cID csrf = do
   (btnResult, btnView) <- mreq (buttonField BtnHijack) "" Nothing
   return (() <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView])
 
+-- In case of refactoring, use this:
+-- instance HasEntity (DBRow (Entity User)) User where
+--    hasEntity = _dbrOutput
+-- instance HasUser   (DBRow (Entity USer)) where
+--    hasUser = _entityVal
 
 getUsersR :: Handler Html
 getUsersR = do

src/Handler/Utils/Table/Cells.hs

@@ -37,6 +37,12 @@ userCell displayName surname = cell $ nameWidget displayName surname
 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 ^. _entityKey
+      nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _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/Utils/Lens.hs

@@ -26,30 +26,35 @@ _InnerJoinRight :: Lens' (E.InnerJoin l r) r
 _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
 
 
-makeLenses_ ''Entity
+-- makeLenses_ ''Entity
+makeClassyFor_ "HasEntity" "hasEntity" ''Entity
+-- 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
 
 makeClassyFor_ "HasUser" "hasUser" ''User
 -- > :info HasUser
--- class HasUser c where
+-- class HasUser c where {-# MINIMAL hasUser #-}
---   {-# MINIMAL hasUser #-}--
 --   hasUser :: Lens' c User
---   _userAuthentication :: Lens' c AuthenticationMode
---   _userDateFormat :: Lens' c DateTimeFormat
---   _userDateTimeFormat :: Lens' c DateTimeFormat
 --   _userDisplayName :: Lens' c Text
---   _userDownloadFiles :: Lens' c Bool
---   _userEmail :: Lens' c (CI.Text)
---   _userIdent :: Lens' c (CI.Text)
---   _userMailLanguages :: Lens' c MailLanguages
---   _userMatrikelnummer :: Lens' c (Maybe Text)
---   _userMaxFavourites :: Lens' c Int
---   _userNotificationSettings :: Lens' c NotificationSettings
 --   _userSurname :: Lens' c Text
---   _userTheme :: Lens' c Theme
+--   _user...
---   _userTimeFormat :: Lens' c DateTimeFormat
+--
+
+-- TODO: Is this instance needed?
+instance (HasUser a) => HasUser (Entity a) where
+  hasUser = _entityVal . hasUser
+-- This is what we would want instead:
+-- instance (HasEntity a User) => HasUser a where
+--   hasUser = _entityVal
+
 
 makeLenses_ ''SheetCorrector