TEST: removing makeCLassyFor maybe build works then?

src/Handler/Course.hs

@@ -632,11 +632,12 @@ userTableQuery whereClause returnStatement t@((user `E.InnerJoin` participant) `
   E.where_ $ whereClause t
   return $ returnStatement t
 
-instance HasUser UserTableData where
+-- TEST HADDOCK
-  hasUser = _entityVal
+-- instance HasUser UserTableData where
-
+--   hasUser = _entityVal
-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
@@ -650,16 +651,17 @@ 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)
+-- TEST HADDOCK
-colUserParticipant = sortable (Just "participant") (i18nCell MsgCourseMember) cellHasUser
+-- 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 :: IsDBTable m a => TermId -> SchoolId -> CourseShorthand -> Colonnade _ UserTableData (DBCell m a)
-colUserParticipantLink tid ssh csh = sortable (Just "participant") (i18nCell MsgCourseMember) (cellHasUserLink courseLink)
+-- colUserParticipantLink tid ssh csh = sortable (Just "participant") (i18nCell MsgCourseMember) (cellHasUserLink courseLink)
-  where
+--   where
-    courseLink = CourseR tid ssh csh . CUserR
+--     courseLink = CourseR tid ssh csh . CUserR
 
-colUserMatriclenr :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a)
+-- colUserMatriclenr :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a)
-colUserMatriclenr = sortable (Just "matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
+-- colUserMatriclenr = sortable (Just "matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
 
 colUserComment :: IsDBTable m a => TermId -> SchoolId -> CourseShorthand -> Colonnade _ UserTableData (DBCell m a)
 colUserComment tid ssh csh =

src/Handler/Utils/Table/Cells.hs

@@ -34,17 +34,18 @@ timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget
 userCell :: IsDBTable m a => Text -> Text -> DBCell m a
 userCell displayName surname = cell $ nameWidget displayName surname
 
-cellHasUser :: (IsDBTable m a, HasUser c) => c -> DBCell m a
+-- TEST HADDOCK
-cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)
+-- 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 :: (IsDBTable m a, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m a
-cellHasUserLink toLink user =
+-- cellHasUserLink toLink user =
-  let uid   = user ^. _entityKey
+--   let uid   = user ^. _entityKey
-      nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname)
+--       nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname)
-  in  anchorCellM (toLink <$> encrypt uid) nWdgt
+--   in  anchorCellM (toLink <$> encrypt uid) nWdgt
 
-cellHasMatrikelnummer :: (IsDBTable m a, HasUser c) => c -> DBCell m a
+-- cellHasMatrikelnummer :: (IsDBTable m a, HasUser c) => c -> DBCell m a
-cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
+-- cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
 
 -- Just for documentation purposes; inline this code instead:
 maybeTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a

src/Utils/Lens.hs

@@ -25,32 +25,33 @@ _InnerJoinLeft  f (E.InnerJoin l r) = (`E.InnerJoin` r) <$> f l
 _InnerJoinRight :: Lens' (E.InnerJoin l r) r
 _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
 
-
+-- TEST HADDOCK
--- makeLenses_ ''Entity
+makeLenses_ ''Entity
-makeClassyFor_ "HasEntity" "hasEntity" ''Entity
+-- makeClassyFor_ "HasEntity" "hasEntity" ''Entity
 -- class HasEntity c record | c -> record where
 --   hasEntity :: Lens' c (Entity record)
 
--- makeLenses_ ''Course
+makeLenses_ ''Course
-makeClassyFor_ "HasCourse" "hasCourse" ''Course
+-- makeClassyFor_ "HasCourse" "hasCourse" ''Course
 -- class HasCourse c where
 --   hasCourse :: Lens' c Course
 
-instance (HasCourse a) => HasCourse (Entity a) where
+-- instance (HasCourse a) => HasCourse (Entity a) where
-  hasCourse = _entityVal . hasCourse
+  -- hasCourse = _entityVal . hasCourse
 
-makeClassyFor_ "HasUser" "hasUser" ''User
+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
+-- instance (HasUser a) => HasUser (Entity a) where
-  hasUser = _entityVal . hasUser
+  -- hasUser = _entityVal . hasUser
 -- This is what we would want instead:
 -- instance (HasEntity a User) => HasUser a where
 --   hasUser = _entityVal

src/Utils/Lens/TH.hs

@@ -17,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
@@ -60,5 +60,5 @@ makeClassyFor_ :: String -> String -> Name -> DecsQ
 makeClassyFor_ clsName funName = makeFieldOptics (classyRulesFor_ clNamer)
     where
         clNamer :: ClassyNamer
-        -- clNamer _ = Just (clsName, funName) {- for newer versions >= 4.17 =}
+        -- clNamer _ = Just (clsName, funName) -- for newer versions >= 4.17
         clNamer _ = Just (mkName clsName, mkName funName)