chore(lms): remove example data to allow sorting again; ignore identical imports for lms tables

src/Handler/LMS/Result.hs

@@ -78,13 +78,12 @@ embedRenderMessage ''UniWorX ''LmsResultCsvException id
 
 mkResultTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget)
 mkResultTable sid qsh qid = do  
-  now_day <- utctDay <$> liftIO getCurrentTime
+  _now_day <- utctDay <$> liftIO getCurrentTime
   dbtCsvName <- csvFilenameLmsResult qsh
   let dbtCsvSheetName = dbtCsvName
   let
     resultDBTable = DBTable{..}
       where
-
         dbtSQLQuery lmsresult = do
           E.where_ $ lmsresult E.^. LmsResultQualification E.==. E.val qid
           return lmsresult
@@ -119,10 +118,12 @@ mkResultTable sid qsh qid = do
           , dbtCsvSheetName
           , dbtCsvNoExportData = Just id
           , dbtCsvHeader       = const $ return lmsResultTableCsvHeader
-          , dbtCsvExampleData  = Just 
+          , dbtCsvExampleData  = Nothing 
+          {-, dbtCsvExampleData  = Just 
             [ LmsResultTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = LmsDay $ addDays (-dos) now_day } 
             | (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..]          
             ]
+          -}
           }
           where 
             doEncode' = LmsResultTableCsv
@@ -138,11 +139,13 @@ mkResultTable sid qsh qid = do
                         , lmsResultInsertSuccess = csvLRTsuccess dbCsvNew & lms2day
                         }                              
               DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsResult was found, but the key no longer exists." -- TODO: how can this ever happen? Check Pagination-Code
-              DBCsvDiffExisting{dbCsvNew = LmsResultTableCsv{..}} -> do
+              DBCsvDiffExisting{dbCsvNew = LmsResultTableCsv{..}, dbCsvOld} -> do 
-                yield $ LmsResultUpdateData
+                let successDay = lms2day csvLRTsuccess
-                        { lmsResultInsertIdent   = csvLRTident
+                when (successDay /= dbCsvOld ^. _dbrOutput . _entityVal . _lmsResultSuccess) $   
-                        , lmsResultInsertSuccess = csvLRTsuccess & lms2day
+                  yield $ LmsResultUpdateData
-                        }
+                          { lmsResultInsertIdent   = csvLRTident
+                          , lmsResultInsertSuccess = successDay
+                          }                
               DBCsvDiffMissing{}  -> return () -- no deletion
           , dbtCsvClassifyAction      = \case 
               LmsResultInsertData{} -> LmsResultInsert

src/Handler/LMS/Userlist.hs

@@ -130,11 +130,13 @@ mkUserlistTable sid qsh qid = do
                           { lmsUserlistInsertIdent  =            csvLULident   dbCsvNew
                           , lmsUserlistInsertFailed = lms2bool $ csvLULfailed  dbCsvNew
                           }
-              DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do 
+              DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}, dbCsvOld} -> do 
-                yield $ LmsUserlistUpdateData 
+                let failedBool = lms2bool csvLULfailed
-                          { lmsUserlistInsertIdent  = csvLULident 
+                when (failedBool /= dbCsvOld ^. _dbrOutput . _entityVal . _lmsUserlistFailed) $
-                          , lmsUserlistInsertFailed = csvLULfailed & lms2bool 
+                  yield $ LmsUserlistUpdateData 
-                          }
+                            { lmsUserlistInsertIdent  = csvLULident 
+                            , lmsUserlistInsertFailed = csvLULfailed & lms2bool 
+                            }
               DBCsvDiffMissing{} -> return () -- no deletion 
             dbtCsvClassifyAction = \case 
                LmsUserlistInsertData{} -> LmsUserlistInsert

src/Handler/LMS/Users.hs

@@ -84,11 +84,13 @@ mkUserTable _sid qsh qid = do
           , sortable (Just csvLmsPin)       (i18nCell MsgTableLmsPin)      $ \(view $ _dbrOutput . _entityVal . _lmsUserPin                  -> pin  ) -> textCell pin 
           , sortable (Just csvLmsResetPin)  (i18nCell MsgTableLmsResetPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin             -> reset) -> ifIconCell reset IconReset
           , sortable (Just csvLmsDelete)    (i18nCell MsgTableLmsDelete)   $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete             -> del  ) -> ifIconCell del   IconRemoveUser
-          , sortable (Just csvLmsStaff)     (i18nCell MsgTableLmsStaff)    $ const mempty
+          , sortable Nothing                (i18nCell MsgTableLmsStaff)    $ const mempty
           ]
         dbtSorting = Map.fromList
-          [ (csvLmsIdent    , SortColumn $ \lmslist -> lmslist E.^. LmsUserIdent)
+          [ (csvLmsIdent    , SortColumn (E.^. LmsUserIdent))
-          , (csvLmsResetPin , SortColumn $ \lmslist -> lmslist E.^. LmsUserResetPin)
+          , (csvLmsPin      , SortColumn (E.^. LmsUserPin))
+          , (csvLmsResetPin , SortColumn (E.^. LmsUserResetPin))
+          , (csvLmsDelete   , SortColumn lmsUserToDeleteExpr)
           ]
         dbtFilter = Map.fromList
           [ (csvLmsIdent    , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsUserIdent ))

src/Handler/Utils/LMS.hs

@@ -13,12 +13,14 @@ module Handler.Utils.LMS
   , csvFilenameLmsUserlist
   , csvFilenameLmsResult  
   , lmsUserToDelete, _lmsUserToDelete
+  , lmsUserToDeleteExpr
   ) where
 
 -- general utils for LMS Interface Handlers
 
 import Import 
 import Handler.Utils
+import qualified Database.Esqueleto.Legacy as E
 
 -- generic Column names 
 csvLmsIdent   :: IsString a => a
@@ -27,7 +29,7 @@ csvLmsIdent = fromString "user" -- "Benutzerkennung"
 csvLmsTimestamp   :: IsString a => a
 csvLmsTimestamp = fromString "timestamp" -- "Zeitstempel"
 
--- for User Table
+-- for Users Table
 csvLmsPin :: IsString a => a
 csvLmsPin      = fromString "pin" -- "PIN"
 
@@ -72,8 +74,12 @@ getYMTH :: MonadHandler m => m Text
 getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime
 
 -- | Deceide whether LMS platform should delete an identifier
+lmsUserToDeleteExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
+lmsUserToDeleteExpr lmslist = E.isNothing (lmslist E.^. LmsUserEnded) E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserSuccess)
+
 lmsUserToDelete :: LmsUser -> Bool 
 lmsUserToDelete LmsUser{lmsUserEnded, lmsUserSuccess} = isNothing lmsUserEnded && isJust lmsUserSuccess
 
 _lmsUserToDelete :: Getter LmsUser Bool 
-_lmsUserToDelete = to lmsUserToDelete
+_lmsUserToDelete = to lmsUserToDelete
+