From 89e6b171078135932714883a44c5a7e769a432f6 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 21 Feb 2019 16:47:42 +0100
Subject: [PATCH] Build problem determined:  crashes Haddock. Added similar
 Class manually.

---
 src/Handler/Course.hs            | 11 +++++------
 src/Handler/Utils/Table/Cells.hs | 13 ++++++++-----
 src/Utils/Lens.hs                |  9 +++++++--
 3 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index fe31596d1..76d2d6a11 100644
--- a/src/Handler/Course.hs
+++ b/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
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index e4de18458..0074ce3cc 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/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
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index 500f6329f..514679daf 100644
--- a/src/Utils/Lens.hs
+++ b/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