fradrive/src/Handler/LMS.hs

{-# 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