diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg new file mode 100644 index 000000000..492d82350 --- /dev/null +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -0,0 +1,5 @@ +TableLmsIdent: Identifikation +TableLmsFailed: Gesperrt +TableLmsSuccess: Bestanden +CsvColumnLmsResultIdent: E-Lernen Identifikator, einzigartig pro Qualifikation und Teilnehmer +CsvColumnLmsResultSuccess: Zeitstempel der erfolgreichen Teilnahme \ No newline at end of file diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg new file mode 100644 index 000000000..660368785 --- /dev/null +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -0,0 +1,5 @@ +TableLmsIdent: Identifier +TableLmsFailed: Blocked +TableLmsSuccess: Completed +CsvColumnLmsResultIdent: E-Learing identifier, unique for each qualfication and user +CsvColumnLmsResultSuccess: Timestamp of successful completion \ No newline at end of file diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index b6da6d5ba..e91267835 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/messages/uniworx/utils/table_column/de-de-formal.msg @@ -61,6 +61,4 @@ SelectColumn: Auswahl CsvExport: CSV-Export TableProportion c@Text of'@Text prop@Rational !ident-ok: #{c}/#{of'} (#{rationalToFixed2 (100 * prop)}%) TableProportionNoRatio c@Text of'@Text !ident-ok: #{c}/#{of'} -TableExamFinished: Ergebnisse sichtbar ab -TableLmsIdent: Identifikation -TableLmsFailed: Gesperrt \ No newline at end of file +TableExamFinished: Ergebnisse sichtbar ab \ No newline at end of file diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index 4596dbe20..5913fddca 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/messages/uniworx/utils/table_column/en-eu.msg @@ -61,6 +61,4 @@ SelectColumn: Selection CsvExport: CSV export TableProportion c of' prop: #{c}/#{of'} (#{rationalToFixed2 (100 * prop)}%) TableProportionNoRatio c of': #{c}/#{of'} -TableExamFinished: Results visible from -TableLmsIdent: Identifier -TableLmsFailed: Blocked \ No newline at end of file +TableExamFinished: Results visible from \ No newline at end of file diff --git a/models/lms.model b/models/lms.model index 994eac3df..4ba5e8159 100644 --- a/models/lms.model +++ b/models/lms.model @@ -24,6 +24,7 @@ LmsUserlist UniqueLmsUserlist qualification ident deriving Generic +-- QualificationId is redundant here; but known due to external upload LmsResult qualification QualificationId ident LmsIdent diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 9378f3839..d84116792 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -14,6 +14,7 @@ module Foundation.I18n , UniWorXMetricsMessage(..), UniWorXNewsMessage(..), UniWorXSchoolMessage(..), UniWorXSystemMessageMessage(..) , UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..) , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..) + , UniWorXQualificationMessage(..) , UniWorXAuthorshipStatementMessage(..) , ShortTermIdentifier(..) , MsgLanguage(..) @@ -180,6 +181,7 @@ mkMessageAddition ''UniWorX "ModelTypes" "messages/uniworx/categories/model_type mkMessageAddition ''UniWorX "Send" "messages/uniworx/categories/send" "de-de-formal" mkMessageAddition ''UniWorX "YesodMiddleware" "messages/uniworx/categories/yesod_middleware" "de-de-formal" mkMessageAddition ''UniWorX "User" "messages/uniworx/categories/user" "de-de-formal" +mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal" mkMessageAddition ''UniWorX "Button" "messages/uniworx/utils/buttons" "de-de-formal" mkMessageAddition ''UniWorX "Form" "messages/uniworx/utils/handler_form" "de-de-formal" mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal" diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 15fbecaa5..5b33023ca 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -5,8 +5,8 @@ module Handler.LMS ( getLmsR - , getLmsUserlistR - , getLmsResultR + , getLmsUserlistR + , getLmsResultR ) where @@ -21,6 +21,9 @@ import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH +import Handler.LMS.Result as Handler.LMS + + type LmsUserIdent = Text -- Unique random use-once identifier for each individual e-learning course; i.e. users may have several active LmsUserIdents at once! data LmsUserTableCsv = LmsUserTableCsv -- for csv export only @@ -145,7 +148,7 @@ mkUserlistTable qid = do E.where_ $ lmslist E.^. LmsUserlistQualification E.==. E.val qid return lmslist dbtRowKey = (E.^. LmsUserlistId) - dbtProj = dbtProjFilteredPostId + dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? dbtColonnade = dbColonnade $ mconcat [ sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> textCell lmsUserlistIdent , sortable (Just "failed") (i18nCell MsgTableLmsFailed) $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> isBadCell lmsUserlistFailed @@ -178,11 +181,6 @@ getLmsUserlistR qid = do $(widgetFile "lms-userlist") - -getLmsResultR :: QualificationId -> Handler Html -getLmsResultR _qid = do - let lmsTable = [whamlet|TODO|] -- TODO: remove me, just for debugging - siteLayoutMsg MsgMenuLmsResult $ do - setTitleI MsgMenuLmsResult - $(widgetFile "lms-result") +-- See Module Handler.LMS.Result for +-- getLmsResultR :: QualificationId -> Handler Html \ No newline at end of file diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs new file mode 100644 index 000000000..86d03405e --- /dev/null +++ b/src/Handler/LMS/Result.hs @@ -0,0 +1,156 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances +{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only +{-# OPTIONS -Wno-unused-imports #-} -- TODO: remove me, for debugging only +{-# OPTIONS -Wno-redundant-constraints #-} -- TODO: remove me, for debugging only + + +module Handler.LMS.Result + ( getLmsResultR + ) + where + +import Import + +import Handler.Utils +import Handler.Utils.Csv + +import qualified Data.Map as Map +import qualified Data.Csv as Csv +import qualified Data.Conduit.List as C +import qualified Data.CaseInsensitive as CI +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.Text.Lens as Text +import qualified Database.Esqueleto.Legacy as E +import qualified Database.Esqueleto.Utils as E +import Database.Esqueleto.Utils.TH + + + +type LmsResultTableExpr = ( E.SqlExpr (Entity Qualification) + `E.InnerJoin` E.SqlExpr (Entity LmsResult) + ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) + `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) + +queryQualification :: LmsResultTableExpr -> E.SqlExpr (Entity Qualification) +queryQualification = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1) + +queryLmsResult :: LmsResultTableExpr -> E.SqlExpr (Entity LmsResult) +queryLmsResult = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1) + +queryLmsUser :: LmsResultTableExpr -> E.SqlExpr (Maybe (Entity LmsUser)) +queryLmsUser = $(sqlLOJproj 3 2) + +queryUser :: LmsResultTableExpr -> E.SqlExpr (Maybe (Entity User)) +queryUser = $(sqlLOJproj 3 3) + +type LmsResultTableData = DBRow (Entity Qualification, Entity LmsResult, Maybe (Entity LmsUser), Maybe (Entity User)) + +instance HasEntity LmsResultTableData LmsResult where + hasEntity = _dbrOutput . _2 + +{- MaybeHasUser only! +instance HasUser LmsResultTableData where + hasUser = _dbrOutput . _4 . _entityVal +-} + +resultQualification :: Lens' LmsResultTableData (Entity Qualification) +resultQualification = _dbrOutput . _1 + +resultLmsResult :: Lens' LmsResultTableData (Entity LmsResult) +resultLmsResult = _dbrOutput . _2 + +resultLmsUser :: Traversal' LmsResultTableData (Entity LmsUser) +resultLmsUser = _dbrOutput . _3 . _Just + +resultUser :: Traversal' LmsResultTableData (Entity User) +resultUser = _dbrOutput . _4 . _Just + +-- required for import only +data LmsResultTableCsv = LmsResultTableCsv + { csvLRTident :: LmsIdent + , csvLRTsuccess :: UTCTime + } + deriving Generic +makeLenses_ ''LmsResultTableCsv + +-- csv without headers +instance Csv.ToRecord LmsResultTableCsv -- default suffices +instance Csv.FromRecord LmsResultTableCsv -- default suffices + +-- csv with headers +lmsResultTableCsvHeader :: Csv.Header +lmsResultTableCsvHeader = Csv.header [ "identification", "timestamp-success" ] + +instance ToNamedRecord LmsResultTableCsv where + toNamedRecord LmsResultTableCsv{..} = Csv.namedRecord + [ "identification" Csv..= csvLRTident + , "timestamp-success" Csv..= csvLRTsuccess + ] + +instance FromNamedRecord LmsResultTableCsv where + parseNamedRecord (lsfHeaderTranslate -> csv) + = LmsResultTableCsv + <$> csv Csv..: "identification" + <*> csv Csv..: "timestamp-success" + + +instance CsvColumnsExplained LmsResultTableCsv where + csvColumnsExplanations _ = mconcat + [ single "identification" MsgCsvColumnLmsResultIdent + , single "timestamp-success" MsgCsvColumnLmsResultSuccess + ] + where + single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget + single k v = singletonMap k [whamlet|_{v}|] + + +mkResultTable :: QualificationId -> DB (Any, Widget) +mkResultTable qid = do + let + resultDBTable = DBTable{..} + where + dbtSQLQuery = runReaderT $ do + qualification <- asks queryQualification + lmsResult <- asks queryLmsResult + lmsUser <- asks queryLmsUser + user <- asks queryUser + lift $ do + E.on $ qualification E.^. QualificationId E.==. lmsResult E.^. LmsResultQualification + E.on $ lmsUser E.?. LmsUserIdent E.==. E.just (lmsResult E.^. LmsResultIdent) + E.on $ lmsUser E.?. LmsUserUser E.==. user E.?. UserId + E.where_ $ qualification E.^. QualificationId E.==. E.val qid + return (qualification, lmsResult, lmsUser, user) + dbtRowKey = queryLmsResult >>> (E.^. LmsResultId) + dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? + dbtColonnade = dbColonnade $ mconcat + [ sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsResult . _entityVal . _lmsResultIdent -> ident) -> textCell ident + , sortable (Just "sucess") (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success) -> dateTimeCell success + ] -- TODO: add more columns for manual debugging view !!! + dbtSorting = mempty + {- Map.fromList + [ ("ident" , SortColumn $ \reslist -> reslist E.^. LmsResultIdent) + , ("success", SortColumn $ \reslist -> reslist E.^. LmsResultSuccess) + ] + -} + dbtFilter = mempty -- TODO !!! continue here !!! + dbtFilterUI = const mempty -- TODO !!! continue here !!! Manual filtering useful to deal with user complaints! + dbtStyle = def + dbtParams = def + dbtIdent :: Text + dbtIdent = "lms-userlist" + dbtCsvEncode = noCsvEncode + dbtCsvDecode = Nothing -- TODO !!! continue here !!! CSV Import is the purpose of this page! Just save to DB, create Job to deal with it later! + dbtExtraReps = [] + + resultDBTableValidator = def + & defaultSorting [SortAscBy "ident"] + dbTable resultDBTableValidator resultDBTable + +getLmsResultR :: QualificationId -> Handler Html +getLmsResultR qid = do + lmsTable <- runDB $ view _2 <$> mkResultTable qid + siteLayoutMsg MsgMenuLmsResult $ do + setTitleI MsgMenuLmsResult + $(widgetFile "lms-result") + \ No newline at end of file