diff --git a/src/Application.hs b/src/Application.hs index 5f6ff7bc9..b8c636ef8 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -145,7 +145,7 @@ import Handler.Participants import Handler.StorageKey import Handler.Error import Handler.Upload - +import Handler.LMS -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs index cd1d6813e..531547ba6 100644 --- a/src/Handler/Health.hs +++ b/src/Handler/Health.hs @@ -2,6 +2,8 @@ module Handler.Health where import Import +import Handler.Utils + import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Text.Lazy.Builder as Builder @@ -104,6 +106,7 @@ getStatusR :: Handler Html getStatusR = do starttime <- getsYesod appStartTime currtime <- liftIO getCurrentTime + ft <- formatTime' "%Y%m%d %H:%M:%S" currtime -- use me throughout or delete me (delete, since this Handler is for mechanised tests only) withUrlRenderer [hamlet| $doctype 5 @@ -113,7 +116,8 @@ getStatusR = do

Current Time
- #{show currtime} + #{show currtime}
+ #{ft}

Instance Start
#{show starttime} diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 2b021029b..3116976f7 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -42,30 +42,31 @@ resultLmsUser = _dbrOutput . _1 resultUser :: Lens' LmsUserTableData (Maybe (Entity User)) resultUser = _dbrOutput . _2 -csvLmsUserFilename :: IO Text +csvLmsUserFilename :: MonadHandler m => m Text csvLmsUserFilename = makeLmsFilename "user" -csvLmsUserlistFilename :: IO Text +csvLmsUserlistFilename :: MonadHandler m => m Text csvLmsUserlistFilename = makeLmsFilename "userliste" -csvLmsResultFilename :: IO Text +csvLmsResultFilename :: MonadHandler m => m Text csvLmsResultFilename = makeLmsFilename "ergebnisse" -- | Create filenames as specified by the LMS interface agreed with Know How AG -makeLmsFilename :: Text -> IO Text +makeLmsFilename :: MonadHandler m => Text -> m Text makeLmsFilename ftag = do ymth <- get_ymth return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv" -- | Return current datetime in YYYYMMDDHH format -get_ymth :: IO Text +get_ymth :: MonadHandler m => m Text get_ymth = do - now <- getCurrentTime - return $ formatTime "%Y%m%d%h" + now <- liftIO $ getCurrentTime + formatTime' "%Y%m%d%H" now getLmsR :: Handler Html getLmsR = do + dbtCsvName <- csvLmsUserFilename let dbtIdent = "lmsUsers" :: Text dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtSQLQuery = runReaderT $ do @@ -78,13 +79,17 @@ getLmsR = do 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, isJust (user E.?. UserCompanyPersonalNumber)) + 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 - dbtCsvName = "lms.csv" + dbtParams = def -- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam. dbtCsvEncode = do return $ DBTCsvEncode @@ -99,7 +104,7 @@ getLmsR = do mitarbeiter , dbtCsvName , dbtCsvNoExportData = Nothing - , dbtCsvHeader = Nothing -- return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def + , dbtCsvHeader = def -- return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def , dbtCsvExampleData = Nothing } -- TODO wip, for reference see e.g. Handler.Exam.Users diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index d21cd8f63..ce25d9f26 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -113,6 +113,9 @@ makeClassyFor_ ''StudyDegree makeClassyFor_ ''StudyTerms makeClassyFor_ ''StudySubTerms +makeClassyFor_ ''LmsUser +makeClassyFor_ ''LmsUserlist +makeClassyFor_ ''LmsResult _entityKey :: Getter (Entity record) (Key record) -- ^ Not a `Lens'` for safety