Build problem determined: crashes Haddock. Added similar Class manually.

src/Handler/Course.hs

@@ -636,13 +636,12 @@ instance HasUser UserTableData where
   -- hasUser = _entityVal
   hasUser = _dbrOutput . _1 . _entityVal
 
-  -- TEST HADDOCK
--- instance HasEntity UserTableData User where
---   hasEntity = _dbrOutput . _1
+instance HasEntity UserTableData User where
+  hasEntity = _dbrOutput . _1
 
--- -- there can be only one -- FunctionalDependency violation
--- instance HasEntity UserTableData CourseParticipant where
---   hasEntity = _dbrOutput . _2
+-- there can be only one due to FunctionalDependency violation if we use MakeClassy on Entity
+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

src/Handler/Utils/Table/Cells.hs

@@ -37,11 +37,14 @@ 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
+cellHasUserLink :: (IsDBTable m a, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m a
+cellHasUserLink toLink user =
+  let userEntity :: Entity User  -- needed without the functional dependency
+      userEntity = user ^. hasEntity
+      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/Utils/Lens.hs

@@ -27,12 +27,17 @@ _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
 
 
 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 attempt, leaving out the unwanted functional dependency
+class HasEntity c record where
+  hasEntity :: Lens' c (Entity record)
 
-makeLenses_ ''Course
--- makeClassyFor_ "HasCourse" "hasCourse" ''Course
+-- makeLenses_ ''Course
+makeClassyFor_ "HasCourse" "hasCourse" ''Course
 -- class HasCourse c where
 --   hasCourse :: Lens' c Course