makeClassy_ changed to makeLenses_ in order to avoid nuerours warnings due to the entirely unused HasSomething class definitions.

src/Handler/Course.hs

@@ -192,7 +192,7 @@ getCourseListR :: Handler Html
 getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
   muid <- maybeAuthId
   let colonnade = widgetColonnade $ mconcat
-        [ colCourseDescr _1
+        [ colCourseDescr $ _dbrOutput . _1 . _entityVal
         , colCShort
         , colTerm
         , maybe mempty (const colRegistered) muid

src/Handler/Profile.hs

@@ -167,29 +167,6 @@ postProfileR = do
 
 
 
--- instance HasCourse (DBRow (Entity Course, a)) where
---   course = _dbrOutput . _1 . _entityVal
-
-instance HasCourse a => HasCourse (Entity a) where
-  course = _entityVal . course
-
-instance HasCourse a => HasCourse (a,b) where
-  course = _1 . course
-
--- instance {-# OVERLAPPABLE #-}  HasCourse b => HasCourse (a,b) where
---   course = _2 . course
-
-instance HasCourse a => HasCourse (a,b,c,d) where
-  course = _1 . course
-
-instance HasCourse a => HasCourse (DBRow a) where
-  course = _dbrOutput . course
-
---
-
--- type CourseTableData = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)
--- NOTE: use withType instead as a flexible inlines Type signature
-
 getProfileDataR  :: Handler Html
 getProfileDataR = do
   (uid, User{..}) <- requireAuthPair
@@ -212,7 +189,8 @@ getProfileDataR = do
                  , course E.^. CourseShorthand
                  )
       , dbtColonnade = mconcat
-          [ colsCourseLink' $ _dbrOutput
+          [ dbRow
+          , colsCourseLink' $ _dbrOutput
 --           [ colsCourseLink $ (over each _unValue) . _dbrOutput -- different types in Tuple prevents "over each"
           ]
       , dbtProj = return
@@ -256,7 +234,8 @@ getProfileDataR = do
           { dbtIdent     = "courseMembership" :: Text
           , dbtSQLQuery  = courseData
           , dbtColonnade = mconcat
-              [ colsCourseCompleteG
+              [ dbRow
+              , colCourseDescr $ _dbrOutput . _1 . _entityVal -- TODO
               , sortable (Just "time") (i18nCell MsgRegistered) $ do
                   regTime <- view $ _dbrOutput . _2 . _unValue
                   return $ timeCell regTime
@@ -307,7 +286,8 @@ getProfileDataR = do
                      )
           return (crse, sht, submission, lastSubEdit submission)
       , dbtColonnade = mconcat
-          [ colsCourseLink' $ _dbrOutput . _1
+          [ dbRow
+          , colsCourseLink' $ _dbrOutput . _1
           , sortable (Just "sheet") (i18nCell MsgSheet) $ do
               shn  <- view $ _dbrOutput . _2 . _unValue
               crse <- view $ _dbrOutput . _1
@@ -321,6 +301,8 @@ getProfileDataR = do
               shn  <- view $ _dbrOutput . _2 . _unValue
               sid  <- view $ _dbrOutput . _3 . _entityKey
               crse <- view $ _dbrOutput . _1
+
+
               let tid = crse ^. _1 . _unValue
                   ssh = crse ^. _2 . _unValue
                   csh = crse ^. _4 . _unValue

src/Handler/Utils/Table/Convenience.hs

@@ -18,7 +18,7 @@ import qualified Database.Esqueleto as E (Value(..))
 -- newtype CourseLink = CourseLink (TermId, SchoolId, CourseId, CourseShorthand) -- cannot be in Types due to CourseId
 type CourseLink = (TermId, SchoolId, CourseId, CourseShorthand) -- cannot be in Types due to CourseId
 -- TODO: can we get rid of this type through lenses?
-type CourseLink' = (E.Value TermId, E.Value SchoolId, E.Value CourseId, E.Value  CourseShorthand) -- cannot be in Types due to CourseId
+type CourseLink' = (E.Value TermId, E.Value SchoolId, E.Value CourseId, E.Value CourseShorthand) -- cannot be in Types due to CourseId
 
 
 
@@ -89,19 +89,19 @@ submissionCell (crse, E.Value shn, submission) =
 
 
 -- Generic Columns
+-- -colCourseDescr :: (HasEntity c Course, HasDBRow s r, IsDBTable m a) =>
+-- -  ((c -> Const Course c) -> r -> Const Course r) -> Colonnade Sortable s (DBCell m a)
+-- -colCourseDescr courseLens = sortable (Just "course") (i18nCell MsgCourse) $ do
+-- -    crs <- view $ _dbrOutput . courseLens . _entityVal
+-- -    return $ courseCell crs
+-- -
 
-colCourseDescr :: (HasEntity c Course, HasDBRow s r, IsDBTable m a) =>
+colCourseDescr :: IsDBTable m a => Getting Course s Course -> Colonnade Sortable s (DBCell m a)
-  ((c -> Const Course c) -> r -> Const Course r) -> Colonnade Sortable s (DBCell m a)
+colCourseDescr getter =
-colCourseDescr courseLens = sortable (Just "course") (i18nCell MsgCourse) $ do
-    crs <- view $ _dbrOutput . courseLens . _entityVal
-    return $ courseCell crs
-
-colCourseDescr_ :: IsDBTable m a => Getting Course s Course -> Colonnade Sortable s (DBCell m a)
-colCourseDescr_ getter =
   sortable (Just "course") (i18nCell MsgCourse) $ do
     crs <- view getter
     return $ courseCell crs
-
+{-
 colCourseDescrG :: (HasCourse s, IsDBTable m a) => Colonnade Sortable s (DBCell m a)
 colCourseDescrG =
   sortable (Just "course") (i18nCell MsgCourse) $ do
@@ -120,6 +120,7 @@ colsCourseCompleteG = mconcat
       crs <- view course
       return $ courseCell crs
   ]
+-}
 
 colsCourseLink :: (IsDBTable m a) => Getting CourseLink s CourseLink -> Colonnade Sortable s (DBCell m a)
 colsCourseLink getter = mconcat

src/Handler/Utils/Table/Pagination.hs

@@ -498,6 +498,7 @@ tickmarkCell False = mempty
 anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
 anchorCell = anchorCellM . return
 
+{-# DEPRECATED anchorCell' "For compatibility with Colonnade; better use anchorCell instead." #-}
 anchorCell' :: IsDBTable m a
            => (r -> Route UniWorX)
            -> (r -> Widget)

src/Utils/Lens.hs

@@ -7,16 +7,18 @@ module Utils.Lens ( module Utils.Lens ) where
 
 import Import.NoFoundation
 import Control.Lens as Utils.Lens
+import Utils.Lens.TH
+
 import qualified Database.Esqueleto as E (Value(..))
 
 _unValue :: Lens' (E.Value a) a
 _unValue f (E.Value a) = E.Value <$> f a
 
-makeClassy_ ''Entity
+makeLenses_ ''Entity
 
-makeClassy_ ''SheetCorrector
+makeLenses_ ''SheetCorrector
 
-makeClassy_ ''Course
+makeLenses_ ''Course
 
 -- makeClassy_ ''Load
 

src/Utils/Lens/TH.hs

@@ -0,0 +1,47 @@
+module Utils.Lens.TH where
+
+import Control.Lens
+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,
+    which was currently unavailable in our stack snapshot.
+    See https://github.com/louispan/lens-misc
+-}
+
+-- | A 'LensRules' used by 'makeLenses_'.
+lensRules_ :: LensRules
+lensRules_ = lensRules
+    & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))]
+
+-- | Build lenses (and traversals) with a sensible default configuration.
+-- Works the same as 'makeLenses' except that
+-- the resulting lens is also prefixed with an underscore.
+--
+-- /e.g./
+--
+-- @
+-- data FooBar
+--   = Foo { x, y :: 'Int' }
+--   | Bar { x :: 'Int' }
+-- 'makeLenses' ''FooBar
+-- @
+--
+-- will create
+--
+-- @
+-- _x :: 'Lens'' FooBar 'Int'
+-- _x f (Foo a b) = (\\a\' -> Foo a\' b) \<$\> f a
+-- _x f (Bar a)   = Bar \<$\> f a
+-- _y :: 'Traversal'' FooBar 'Int'
+-- _y f (Foo a b) = (\\b\' -> Foo a  b\') \<$\> f b
+-- _y _ c\@(Bar _) = pure c
+-- @
+--
+-- @
+-- 'makeLenses_' = 'makeLensesWith' 'lensRules_'
+-- @
+
+makeLenses_ :: Name -> DecsQ
+makeLenses_ = makeFieldOptics lensRules_