From 8af8526e618508dcb8550cebd57bb70c467b16b0 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 12 Apr 2022 17:12:15 +0200
Subject: [PATCH] chore(lms): attempts to use standard columns working now
 after refactoring

---
 src/Handler/LMS.hs                 | 29 ++++++++++++++++++-----------
 src/Handler/Utils/Table/Columns.hs |  3 +++
 2 files changed, 21 insertions(+), 11 deletions(-)

diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index d2fda6747..d70078b70 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -33,6 +33,9 @@ import Handler.LMS.Users    as Handler.LMS
 import Handler.LMS.Userlist as Handler.LMS
 import Handler.LMS.Result   as Handler.LMS
 
+-- avoids repetition of local definitions
+single :: (k,a) -> Map k a
+single = uncurry Map.singleton
 
 getLmsSchoolR :: SchoolId -> Handler Html
 getLmsSchoolR ssh = redirect (LmsAllR, [("qualification-overview-school", toPathPiece ssh)])
@@ -182,30 +185,34 @@ mkLmsTable qid = do
         dbtRowKey = queryUser >>> (E.^. UserId)
         dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
         dbtColonnade = dbColonnade $ mconcat
-          [ sortable (Just "user")        (i18nCell MsgTableLmsUser)    $ cellHasUserLink AdminUserR
+          [ colUserNameLinkHdr MsgTableLmsUser AdminUserR
+          , colUserEmail          
+          , sortable (Just "user")        (i18nCell MsgTableLmsUser)    $ cellHasUserLink AdminUserR
           , sortable (Just "email")       (i18nCell MsgTableEmail)        cellHasEMail
           --, sortable (Just csvLmsIdent)   (i18nCell MsgTableLmsIdent)   $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> ident)     -> textCell ident
           --, sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success)                -> dayCell success
           ] -- TODO: add more columns for manual debugging view !!!
-        dbtSorting = Map.fromList
-          [ ("user"       , SortColumn $ queryUser          >>> (E.^. UserDisplayName)) 
-          , ("email"      , SortColumn $ queryUser          >>> (E.^. UserEmail)) 
-          -- 
+        dbtSorting = mconcat
+          [ single $ sortUserNameLink queryUser
+          , single $ sortUserEmail    queryUser 
+          , singletonMap "user"  ( SortColumn $ queryUser          >>> (E.^. UserDisplayName) )
+          , single     ("email"  , SortColumn $ queryUser          >>> (E.^. UserEmail) )
+          -- TODO: Use ready sorts and ready colonnades for user see Course.Users 
           --    , (csvLmsIdent  , SortColumn $ queryLmsUser     >>> (E.^. LmsResultIdent))
           -- , (csvLmsSuccess, SortColumn $ queryLmsResult     >>> (E.^. LmsResultSuccess))
           -- , (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess))
-          ]
-          -- where single = uncurry Map.singleton
+          ]          
         dbtFilter = mconcat
-          [ single $ fltrUserNameEmail   queryUser
+          [ single $ fltrUserNameLink   queryUser
+          , single $ fltrUserNameEmail  queryUser
           --("user"       , FilterColumn . E.mkContainsFilterWith Just     $ views (to queryUser)           (E.^. UserDisplayName))
           --  , ("email"      , FilterColumn . E.mkContainsFilterWith Just     $ views (to queryUser)           (E.^. UserEmail))
           --  , (csvLmsIdent  , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsResult)      (E.^. LmsResultIdent))
           --  , (csvLmsSuccess, FilterColumn . E.mkExactFilter                 $ views (to queryLmsResult)      (E.^. LmsResultSuccess))
-          ]
-          where single = uncurry Map.singleton
+          ]          
         dbtFilterUI mPrev = mconcat 
-          [ fltrUserNameEmailUI mPrev
+          [ fltrUserNameLinkUI mPrev
+          , fltrUserNameEmailUI mPrev
           -- prismAForm (singletonFilter "user"        . maybePrism _PathPiece)                    mPrev $ aopt (hoistField lift textField)     (fslI MsgTableLmsUser)
           --, prismAForm (singletonFilter "email"       . maybePrism _PathPiece)                    mPrev $ aopt (hoistField lift textField)     (fslI MsgTableEmail)
           -- , prismAForm (singletonFilter csvLmsIdent   . maybePrism _PathPiece)                    mPrev $ aopt (hoistField lift textField)     (fslI MsgTableLmsIdent)
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index e13284064..780bc1d7e 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -476,6 +476,9 @@ colUserName = sortable (Just "user-name") (i18nCell MsgTableCourseMembers) cellH
 colUserNameLink :: (IsDBTable m c, HasEntity a User) => (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c)
 colUserNameLink userLink = sortable (Just "user-name") (i18nCell MsgTableCourseMembers) (cellHasUserLink userLink)
 
+colUserNameLinkHdr :: (IsDBTable m c, HasEntity a User, RenderMessage UniWorX msg) => msg -> (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c)
+colUserNameLinkHdr colHeader userLink = sortable (Just "user-name") (i18nCell colHeader) (cellHasUserLink userLink)
+
 -- | Intended to work with @nameWidget@, showing highlighter Surname within Displayname
 sortUserName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r')
 sortUserName queryUser = ("user-name", SortColumns $ queryUser >>> \user ->