chore(lms): lms userlist handler should be working now

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -5,5 +5,8 @@ TableLmsReceived: Erhalten
 CsvColumnLmsIdent: E-Lernen Identifikator, einzigartig pro Qualifikation und Teilnehmer
 CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme
 CsvColumnLmsFailed: User was blocked by LMS, usually due to too many attempts
+LmsUserlistInsert: Neuer LMS User 
+LmsUserlistUpdate: Aktualisierung von LMS User
 LmsResultInsert: Neues LMS Ergebnis 
-LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
+LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
+LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel

messages/uniworx/categories/qualification/en-eu.msg

@@ -5,5 +5,8 @@ TableLmsReceived: Received
 CsvColumnLmsIdent: E-Learing identifier, unique for each qualfication and user
 CsvColumnLmsSuccess: Timestamp of successful completion
 CsvColumnLmsFailed: Blockier durch LMS, üblicherweise wegen zu vieler Fehlversuche
+LmsUserlistInsert: New LMS User 
+LmsUserlistUpdate: Update of LMS User
 LmsResultInsert: New LMS result
-LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
+LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
+LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key

models/lms.model

@@ -107,6 +107,7 @@ LmsUserlist
   ident             LmsIdent
   failed            Bool
   timestamp         UTCTime default=now()
+  UniqueLmsUserlist qualification ident
   deriving Generic
 
 -- LmsResult stores LMS upload for later processing only 

src/Handler/LMS/Result.hs

@@ -112,7 +112,7 @@ deriveJSON defaultOptions
   } ''LmsResultCsvAction
 
 data LmsResultCsvException 
-  = LmsResultCsvExceptionDuplicatedKey 
+  = LmsResultCsvExceptionDuplicatedKey -- TODO: this is not used anywhere?!
   deriving (Show, Generic, Typeable)
 
 instance Exception LmsResultCsvException
@@ -185,9 +185,9 @@ mkResultTable sid qsh qid = do
                         { lmsResultInsertIdent      = csvLRTident   dbCsvNew
                         , lmsResultInsertSuccess    = csvLRTsuccess dbCsvNew                        
                         }                              
-              DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsResult was found, but the key no longer exists."
+              DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsResult was found, but the key no longer exists." -- TODO: how can this ever happen? Check Pagination-Code
               DBCsvDiffMissing{}  -> return () -- no deletion
-              DBCsvDiffExisting{} -> return () -- no merge                      
+              DBCsvDiffExisting{} -> return () -- no merge                      TODO!!! ADD MERGE DUE TO Uniqueness!
           , dbtCsvClassifyAction      = \LmsResultInsertData{} -> LmsResultInsert
           , dbtCsvCoarsenActionClass  = \LmsResultInsert -> DBCsvActionNew   -- there is only one action: insert into table
           , dbtCsvValidateActions     = return ()  -- no validation, since this is an automatic upload, i.e. no user to review error
@@ -207,7 +207,7 @@ mkResultTable sid qsh qid = do
                 -- queueDBJob?? -- todo
                 -- audit 
             return $ LmsResultR sid qsh 
-          , dbtCsvRenderKey           = \_ LmsResultInsertData{..} -> do 
+          , dbtCsvRenderKey           = \_ LmsResultInsertData{..} -> do -- TODO: i18n
               [whamlet|
                 $newline never
                 Ident #{getLmsIdent lmsResultInsertIdent} #

src/Handler/LMS/Userlist.hs

@@ -56,8 +56,30 @@ instance CsvColumnsExplained LmsUserlistTableCsv where
       single k v = singletonMap k [whamlet|_{v}|]
 
 
+data LmsUserlistCsvActionClass = LmsUserlistInsert | LmsUserlistUpdate 
+  deriving (Eq, Ord, Read, Show, Generic, Typeable, Enum, Bounded)
+embedRenderMessage ''UniWorX ''LmsUserlistCsvActionClass id
+
+data LmsUserlistCsvAction = LmsUserlistInsertData { lmsUserlistInsertIdent :: LmsIdent, lmsUserlistInsertFailed :: Bool }
+                          | LmsUserlistUpdateData { lmsUserlistInsertIdent :: LmsIdent, lmsUserlistInsertFailed :: Bool }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece'' 2 1   -- LmsUserlistInsertData -> insert
+  , fieldLabelModifier = camelToPathPiece' 2          -- lmsUserlistInsertIdent -> insert-ident | lmsUserlistInsertFailed -> insert-failed
+  , sumEncoding = TaggedObject "action" "data"
+  } ''LmsUserlistCsvAction
+
+
+data LmsUserlistCsvException 
+  = LmsUserlistCsvExceptionDuplicatedKey -- TODO: this is not used anywhere?!
+  deriving (Show, Generic, Typeable)
+
+instance Exception LmsUserlistCsvException
+embedRenderMessage ''UniWorX ''LmsUserlistCsvException id 
+
 mkUserlistTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget)
-mkUserlistTable _sid qsh qid = do
+mkUserlistTable sid qsh qid = do
   dbtCsvName <- csvFilenameLmsUserlist qsh
   let dbtCsvSheetName = dbtCsvName
   let
@@ -100,7 +122,65 @@ mkUserlistTable _sid qsh qid = do
             doEncode' = LmsUserlistTableCsv
               <$> view (_dbrOutput . _entityVal . _lmsUserlistIdent)
               <*> view (_dbrOutput . _entityVal . _lmsUserlistFailed)
-        dbtCsvDecode = Nothing      -- TODO !!! continue here !!! CSV Import is the purpose of this page! Just save to DB, create Job to deal with it later!
+        dbtCsvDecode = Just DBTCsvDecode {..}
+          where
+            dbtCsvRowKey = \LmsUserlistTableCsv{csvLULident} -> 
+              fmap E.Value . MaybeT . getKeyBy $ UniqueLmsUserlist qid csvLULident
+            dbtCsvComputeActions = \case -- shows a diff first
+              DBCsvDiffNew{dbCsvNew} -> do 
+                yield $ LmsUserlistInsertData 
+                          { lmsUserlistInsertIdent  = csvLULident   dbCsvNew
+                          , lmsUserlistInsertFailed = csvLULfailed  dbCsvNew
+                          }
+              DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do 
+                yield $ LmsUserlistUpdateData 
+                          { lmsUserlistInsertIdent  = csvLULident 
+                          , lmsUserlistInsertFailed = csvLULfailed
+                          }
+              DBCsvDiffMissing{} -> return () -- no deletion 
+            dbtCsvClassifyAction = \case 
+               LmsUserlistInsertData{} -> LmsUserlistInsert
+               LmsUserlistUpdateData{} -> LmsUserlistUpdate 
+            dbtCsvCoarsenActionClass = \case 
+               LmsUserlistInsert -> DBCsvActionNew 
+               LmsUserlistUpdate -> DBCsvActionExisting
+            dbtCsvValidateActions = return ()  -- no validation, since this is an automatic upload, i.e. no user to review error              
+            dbtCsvExecuteActions = do
+              C.mapM_ $ \actionData -> do
+                now <- liftIO getCurrentTime
+                void $ upsert LmsUserlist
+                  {
+                    lmsUserlistQualification  = qid 
+                  , lmsUserlistIdent          = lmsUserlistInsertIdent   actionData
+                  , lmsUserlistFailed         = lmsUserlistInsertFailed  actionData
+                  , lmsUserlistTimestamp      = now 
+                  }
+                  [
+                    LmsUserlistFailed         =. lmsUserlistInsertFailed  actionData -- TODO: should we allow a reset from failed: True to False?
+                  , LmsUserlistTimestamp      =. now
+                  ]      
+              return $ LmsUserlistR sid qsh
+            dbtCsvRenderKey = const $ \case 
+              LmsUserlistInsertData{..} -> do -- TODO: i18n
+                [whamlet|
+                  $newline never
+                  Insert: Course for Ident #{getLmsIdent lmsUserlistInsertIdent} #
+                  $if lmsUserlistInsertFailed
+                    is closed due to failure.
+                  $else
+                    is open.
+                |]
+              LmsUserlistUpdateData{..} -> do -- TODO: i18n
+                [whamlet|
+                  $newline never
+                  Update: Course for Ident #{getLmsIdent lmsUserlistInsertIdent} #
+                  $if lmsUserlistInsertFailed
+                    is now closed due to failure.
+                  $else
+                    is still open.
+                |]
+            dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
+            dbtCsvRenderException = ap getMessageRender . pure :: LmsUserlistCsvException -> DB Text
         dbtExtraReps = []
 
     userlistDBTableValidator = def

templates/lms-result.hamlet

@@ -1 +1,2 @@
+LMS Result
 ^{lmsTable}

templates/lms-userlist.hamlet

@@ -1 +1,2 @@
+LMS Userlist
 ^{lmsTable}

templates/lms.hamlet

@@ -1 +1,5 @@
+LMS Overview
+
+!!!THIS PAGE IS NOT YET FUNCTIONAL!!!
+
 ^{lmsTable}