Stub for Studyfeature overview created

messages/uniworx/de.msg

@@ -353,6 +353,7 @@ LecturersFor: Dozenten
 ForSchools n@Int: für #{pluralDE n "Institut" "Institute"}
 UserListTitle: Komprehensive Benutzerliste
 AccessRightsSaved: Berechtigungsänderungen wurden gespeichert.
+AdminFeaturesHeading: Studiengänge
 
 Date: Datum
 DateTimeFormat: Datums- und Uhrzeitformat
@@ -412,6 +413,13 @@ FieldPrimary: Hauptfach
 FieldSecondary: Nebenfach
 NoPrimaryStudyField: (kein Hauptfach registriert)
 
+DegreeKey: Schlüssel Abschluss
+DegreeName: Abschluss
+DegreeShort: Abschlusskürzel
+StudyTermsKey: Schlüssel Studiengang
+StudyTermsName: Studiengang
+StudyTermsShort: Studiengangkürzel
+
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
 

routes

@@ -39,6 +39,7 @@
 /users/#CryptoUUIDUser        AdminUserR        GET POST      !development
 /users/#CryptoUUIDUser/hijack AdminHijackUserR  POST          !adminANDno-escalation
 /admin/test                   AdminTestR        GET POST
+/admin/features               AdminFeaturesR    GET --POST    
 /admin/errMsg                 AdminErrMsgR      GET POST
 
 /info                         InfoR             GET            !free

src/Handler/Admin.hs

@@ -8,11 +8,17 @@ import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
 
 import Control.Monad.Trans.Except
 
+import Utils.Lens
+
 -- import Data.Time
 -- import qualified Data.Text as T
 -- import Data.Function ((&))
 -- import Yesod.Form.Bootstrap3
 
+-- import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Handler.Utils.Table.Cells
+import qualified Database.Esqueleto as E
 import Database.Persist.Sql (fromSqlKey)
 
 -- import Colonnade hiding (fromMaybe)
@@ -154,3 +160,63 @@ postAdminErrMsgR = do
       <form action=@{AdminErrMsgR} method=post enctype=#{ctEncoding}>
         ^{ctView}
     |]
+
+
+
+getAdminFeaturesR :: Handler Html
+getAdminFeaturesR = do
+    degreeTable <- runDB mkDegreeTable
+    studytermsTable <- runDB mkStudytermsTable
+
+    siteLayoutMsg MsgAdminFeaturesHeading $ do
+      setTitleI MsgAdminFeaturesHeading
+      [whamlet|
+        ^{degreeTable}
+        ^{studytermsTable}
+      |]
+  where
+    mkDegreeTable =
+      let dbtIdent      = "admin-studydegrees" :: Text
+          dbtStyle      = def
+          dbtSQLQuery   :: (E.SqlExpr (Entity StudyDegree)) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree))
+          dbtSQLQuery   = return
+          dbtRowKey     = (E.^. StudyDegreeKey)
+          dbtProj       = return
+          dbtColonnade  = mconcat
+            [ sortable (Just "degree-key")   (i18nCell MsgDegreeKey)   (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
+            , sortable (Just "degree-name")  (i18nCell MsgDegreeName)  (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeName))
+            , sortable (Just "degree-short") (i18nCell MsgDegreeShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeShorthand))
+            ]
+          dbtSorting    = Map.fromList
+            [ ("degree-key"  , SortColumn (E.^. StudyDegreeKey))
+            , ("degree-name" , SortColumn (E.^. StudyDegreeName))
+            , ("degree-short", SortColumn (E.^. StudyDegreeShorthand))
+            ]
+          dbtFilter     = mempty
+          dbtFilterUI   = mempty
+          dbtParams     = def
+          psValidator   = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"]
+      in dbTableWidget' psValidator DBTable{..}
+
+    mkStudytermsTable =
+      let dbtIdent      = "admin-studyterms" :: Text
+          dbtStyle      = def
+          dbtSQLQuery   :: (E.SqlExpr (Entity StudyTerms)) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
+          dbtSQLQuery   = return
+          dbtRowKey     = (E.^. StudyTermsKey)
+          dbtProj       = return
+          dbtColonnade  = mconcat
+            [ sortable (Just "studyterms-key")   (i18nCell MsgStudyTermsKey)   (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
+            , sortable (Just "studyterms-name")  (i18nCell MsgStudyTermsName)  (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsName))
+            , sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsShorthand))
+            ]
+          dbtSorting    = Map.fromList
+            [ ("studyterms-key"  , SortColumn (E.^. StudyTermsKey))
+            , ("studyterms-name" , SortColumn (E.^. StudyTermsName))
+            , ("studyterms-short", SortColumn (E.^. StudyTermsShorthand))
+            ]
+          dbtFilter     = mempty
+          dbtFilterUI   = mempty
+          dbtParams     = def
+          psValidator   = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
+      in dbTableWidget' psValidator DBTable{..}

src/Handler/Course.hs

@@ -757,7 +757,7 @@ makeCourseUserTable cid colChoices psValidator =
   let dbtIdent     = "courseUsers" :: Text
       dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
       dbtSQLQuery  = userTableQuery cid
-      dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserId
+      dbtRowKey    = queryUser >>> (E.^. UserId)
       dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
       dbtColonnade = colChoices
       dbtSorting   = Map.fromList

src/Utils/Lens.hs

@@ -82,6 +82,13 @@ makePrisms ''AuthResult
 
 makeLenses_ ''StudyFeatures
 
+makeLenses_ ''StudyDegree
+
+makeLenses_ ''StudyTerms
+
+makeLenses_ ''StudyTermCandidate
+
+
 -- makeClassy_ ''Load