{-# 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 ( getLmsR , getLmsUserlistR , getLmsResultR ) where import Import import Handler.Utils import qualified Data.Map as Map import qualified Data.Csv as Csv import qualified Data.Conduit.List as C 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 { csvLmsUserIdent :: LmsUserIdent , csvLmsUserPin :: Text , csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Int } data LmsCsvExportData = LmsCsvExportData type LmsUserTableExpr = E.SqlExpr (Entity LmsUser) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) type LmsUserTableData = DBRow ( Entity LmsUser , Maybe (Entity User) ) queryLmsUser :: Getter LmsUserTableExpr (E.SqlExpr (Entity LmsUser)) queryLmsUser = to $(E.sqlLOJproj 2 1) queryUser :: Getter LmsUserTableExpr (E.SqlExpr (Maybe (Entity User))) queryUser = to $(E.sqlLOJproj 2 2) resultLmsUser :: Lens' LmsUserTableData (Entity LmsUser) resultLmsUser = _dbrOutput . _1 resultUser :: Lens' LmsUserTableData (Maybe (Entity User)) resultUser = _dbrOutput . _2 csvLmsUserFilename :: MonadHandler m => m Text csvLmsUserFilename = makeLmsFilename "user" csvLmsUserlistFilename :: MonadHandler m => m Text csvLmsUserlistFilename = makeLmsFilename "userliste" csvLmsResultFilename :: MonadHandler m => m Text csvLmsResultFilename = makeLmsFilename "ergebnisse" -- | Create filenames as specified by the LMS interface agreed with Know How AG makeLmsFilename :: MonadHandler m => Text -> m Text makeLmsFilename ftag = do ymth <- getYMTH return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv" -- | Return current datetime in YYYYMMDDHH format getYMTH :: MonadHandler m => m Text getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime getLmsR :: QualificationId -> Handler Html getLmsR _qid = do -- TODO !!! filter table by qid !!! {- dbtCsvName <- csvLmsUserFilename let dbtIdent = "lmsUsers" :: Text dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtSQLQuery = runReaderT $ do lmsUser <- view queryLmsUser user <- view queryUser lift $ do E.on $ E.just (lmsUser E.^. LmsUserUser) E.==. user E.?. UserId -- TODO where? return (lmsUser, user) dbtRowKey = queryLmsUser >>> (E.^. LmsUserId) dbtProj = dbtProjSimple $ \(lmsUser, user) -> do -- return ("abcdefgh", "12345678", False, False, True) return ( lmsUser E.^. LmsUserIdent , lmsUser E.^. LmsUserPin , lmsUser E.^. LmsUserResetPin , lmsUser E.^. LmsUserResetPin -- , True) -- works, so we need a simple type here indeed , isJust $ E.unValue (user E.?. UserCompanyPersonalNumber)) dbtColonnade = mempty --TODO dbtSorting = mempty dbtFilter = mempty dbtFilterUI = mempty dbtParams = def -- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam. dbtCsvEncode = do return $ DBTCsvEncode { dbtCsvExportForm = def , dbtCsvDoEncode = \LmsCsvExportData{} -> C.mapM $ \(_lmsUserTableId, row) -> do mitarbeiter <- return 1 return $ LmsUserTableCsv (row ^. resultUser . _entityVal . _lmsUserIdent) (row ^. resultUser . _entityVal . _lmsUserPin) (row ^. resultUser . _entityVal . _lmsUserResetPin . to fromEnum) (row ^. resultUser . _entityVal . _lmsUserDelete . to fromEnum) mitarbeiter , dbtCsvName , dbtCsvNoExportData = Nothing , dbtCsvHeader = def -- return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def , dbtCsvExampleData = Nothing } -- TODO wip, for reference see e.g. Handler.Exam.Users dbtCsvDecode = Nothing -- Just DBTCsvDecode -- { dbtCsvRowKey = _1 -- , dbtCsvComputeActions = _2 -- , dbtCsvClassifyAction = _3 -- , dbtCsvCoarsenActionClass = _4 -- , dbtCsvValidateActions = _5 -- , dbtCsvExecuteActions = _6 -- <- actions based on sent data here -- , dbtCsvRenderKey = _7 -- , dbtCsvRenderActionClass = _8 -- , dbtCsvRenderException = _9 -- } psValidator = def lmsTable = dbTable psValidator DBTable{..} -} let lmsTable = [whamlet|TODO|] -- TODO: remove me, just for debugging siteLayoutMsg MsgMenuLms $ do setTitleI MsgMenuLms $(widgetFile "lms") mkUserlistTable :: QualificationId -> DB (Any, Widget) mkUserlistTable qid = do let userlistTable = DBTable{..} where dbtSQLQuery lmslist = do E.where_ $ lmslist E.^. LmsUserlistQualification E.==. E.val qid return lmslist dbtRowKey = (E.^. LmsUserlistId) 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 ] dbtSorting = Map.fromList [ ("ident" , SortColumn $ \lmslist -> lmslist E.^. LmsUserlistIdent) , ("failed", SortColumn $ \lmslist -> lmslist E.^. LmsUserlistFailed) ] 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 = [] userlistDBTableValidator = def & defaultSorting [SortAscBy "ident"] dbTable userlistDBTableValidator userlistTable getLmsUserlistR :: QualificationId -> Handler Html getLmsUserlistR qid = do lmsTable <- runDB $ view _2 <$> mkUserlistTable qid siteLayoutMsg MsgMenuLmsUserlist $ do setTitleI MsgMenuLmsUserlist $(widgetFile "lms-userlist") -- See Module Handler.LMS.Result for -- getLmsResultR :: QualificationId -> Handler Html