From 49d9ab9dba70423431e6e68892825c8e29309739 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 6 Mar 2020 13:53:13 +0100 Subject: [PATCH] feat(csv): export example data & improve zoned-time parsing --- messages/uniworx/de-de-formal.msg | 13 ++++++ messages/uniworx/en-eu.msg | 13 ++++++ src/Data/Time/Clock/Instances.hs | 18 +++----- src/Data/Time/LocalTime/Instances.hs | 12 ----- src/Foundation.hs | 22 +++++++++ src/Handler/Course/Users.hs | 1 + src/Handler/Exam/Users.hs | 1 + src/Handler/ExamOffice/Exam.hs | 1 + src/Handler/Utils/DateTime.hs | 32 ++++++++++++++ src/Handler/Utils/ExternalExam/Users.hs | 59 ++++++++++++++++++++++--- src/Handler/Utils/Table/Pagination.hs | 21 ++++++++- src/Model/Types/Exam.hs | 7 +++ src/Utils/Parameters.hs | 2 +- templates/table/csv-example.hamlet | 5 +++ templates/table/csv-transcode.hamlet | 3 ++ templates/widgets/csvRendered.hamlet | 28 ++++++------ 16 files changed, 192 insertions(+), 46 deletions(-) create mode 100644 templates/table/csv-example.hamlet diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 3c6070379..802f1bc62 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1764,6 +1764,8 @@ CsvImportUnnecessary: Durch den CSV-Import würden keine Änderungen vorgenommen CsvImportSuccessful n@Int: CSV-Import erfolgreich, es #{pluralDE n "wurde eine Aktion" (mappend (mappend "wurden " (toMessage n)) " Aktionen")} durchgeführt CsvImportAborted: CSV-Import abgebrochen CsvImportExplanationLabel: Hinweise zum CSV-Import +CsvExampleData: Beispiel-Datei +CsvExportExample: Beispiel-CSV exportieren Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%) ProportionNoRatio c@Text of@Text: #{c}/#{of} @@ -1848,6 +1850,7 @@ ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identi ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden ExamUserCsvExceptionMismatchedGradingMode expectedGradingMode@ExamGradingMode actualGradingMode@ExamGradingMode: Es wurde versucht eine Prüfungsleistung einzutragen, die zwar vom System interpretiert werden konnte, aber nicht dem für diese Prüfung erwarteten Modus entspricht. Der erwartete Bewertungsmodus kann unter "Prüfung bearbeiten" angepasst werden ("Bestanden/Nicht Bestanden", "Numerische Noten" oder "Gemischt"). +ExamUserCsvExceptionNoOccurrenceTime: Es wurde versucht eine Prüfungsleistung ohne einen zugehörigen Zeitpunkt einzutragen. Sie können entweder einen Zeitpunkt pro Student in der entsprechenden Spalte hinterlegen, oder einen voreingestellten Zeitpunkt unter "Bearbeiten" angeben. ExternalExamUserCsvRegister: Prüfungsleistung hinterlegen ExternalExamUserCsvSetTime: Zeitpunkt anpassen @@ -2378,3 +2381,13 @@ AllocationPrioritiesFile: CSV-Datei AllocationPrioritiesSunk num@Int64: Zentrale Prioritäten für #{num} Bewerber erfolgreich hinterlegt AllocationPrioritiesMissing num@Int64: Für #{num} Bewerber ist keine zentrale Priorität hinterlegt, da in der hochgeladenen CSV-Datei die #{pluralDE num "entsprechende Matrikelnummer" "entsprechenden Matrikelnummern"} nicht gefunden #{pluralDE num "wurde" "wurden"} AllocationMissingPrioritiesIgnored: Bewerber, für die keine zentrale Priorität angegeben wird, werden bei der Vergabe ignoriert! + +ExampleUser1FirstName: Max ZweiterName +ExampleUser1Surname: Mustermann +ExampleUser1DisplayName: Max Mustermann +ExampleUser2FirstName: Martha +ExampleUser2Surname: Musterstudent +ExampleUser2DisplayName: Musterstudent Martha +ExampleUser3FirstName: Maria +ExampleUser3Surname: Beispiel +ExampleUser3DisplayName: Beispiel \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 8b4634e8f..984c4ea25 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1763,6 +1763,8 @@ CsvImportUnnecessary: Importing the given CSV file does not correspond to perfor CsvImportSuccessful n: Successfully imported CSV file. #{n} #{pluralEN n "edit" "edits"} have been performed. CsvImportAborted: CSV import aborted CsvImportExplanationLabel: Informating regarding CSV import +CsvExampleData: Example data +CsvExportExample: Export example CSV Proportion c of prop: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%) ProportionNoRatio c of: #{c}/#{of} @@ -1847,6 +1849,7 @@ ExamUserCsvExceptionNoMatchingUser: Course participant could not be identified u ExamUserCsvExceptionNoMatchingStudyFeatures: The specified field did not match with any of the participant's fields of study ExamUserCsvExceptionNoMatchingOccurrence: Occurrence/room could not be identified uniquely ExamUserCsvExceptionMismatchedGradingMode expectedGradingMode actualGradingMode: The imported data contained an exam achievement which does not match the grading mode for this exam. The expected grading mode can be changed at "Edit exam" ("Passed/Failed", "Numeric grades", or "Mixed"). +ExamUserCsvExceptionNoOccurrenceTime: The imported data contained an exam achievement without an associated time. You can either enter a time for each student in the appropriate column or you can set a default time for the entire exam under "Edit". ExternalExamUserCsvRegister: Store exam achievement ExternalExamUserCsvSetTime: Adjust exam time @@ -2378,3 +2381,13 @@ AllocationPrioritiesFile: CSV file AllocationPrioritiesSunk num: Successfully registered central priorities for #{num} #{pluralEN num "applicant" "applicants"} AllocationPrioritiesMissing num: Could not register central priorities for #{num} #{pluralEN num "applicant" "applicants"} because their matriculation was not found in the uploaded CSV file AllocationMissingPrioritiesIgnored: Applicants for whom no central priority has been registered will be ignored during assignment! + +ExampleUser1FirstName: Max SecondName +ExampleUser1Surname: Mustermann +ExampleUser1DisplayName: Max Mustermann +ExampleUser2FirstName: Martha +ExampleUser2Surname: Musterstudent +ExampleUser2DisplayName: Musterstudent Martha +ExampleUser3FirstName: Maria +ExampleUser3Surname: Example +ExampleUser3DisplayName: Example \ No newline at end of file diff --git a/src/Data/Time/Clock/Instances.hs b/src/Data/Time/Clock/Instances.hs index d1b0af22e..4b49cfa1f 100644 --- a/src/Data/Time/Clock/Instances.hs +++ b/src/Data/Time/Clock/Instances.hs @@ -1,8 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Time.Clock.Instances - ( iso8601OutputFormat, iso8601ParseFormat - ) where + () where import ClassyPrelude @@ -19,6 +18,8 @@ import Web.PathPieces import qualified Data.Csv as Csv +import Data.Time.Format.ISO8601 + instance Hashable DiffTime where hashWithSalt s = hashWithSalt s . toRational @@ -31,23 +32,18 @@ instance PersistFieldSql NominalDiffTime where sqlType _ = sqlType (Proxy @Rational) -iso8601OutputFormat, iso8601ParseFormat :: String -iso8601OutputFormat = "%0Y-%m-%dT%H:%M:%S%Q%z" -iso8601ParseFormat = "%Y-%m-%dT%H:%M:%S%Q%z" - - deriving instance Generic UTCTime instance Hashable UTCTime instance PathPiece UTCTime where - toPathPiece = pack . formatTime defaultTimeLocale iso8601OutputFormat - fromPathPiece = parseTimeM False defaultTimeLocale iso8601ParseFormat . unpack + toPathPiece = pack . iso8601Show + fromPathPiece = iso8601ParseM . unpack instance Csv.ToField UTCTime where - toField = Csv.toField . formatTime defaultTimeLocale iso8601OutputFormat + toField = Csv.toField . iso8601Show instance Csv.FromField UTCTime where - parseField = parseTimeM False defaultTimeLocale iso8601ParseFormat <=< Csv.parseField + parseField = iso8601ParseM <=< Csv.parseField instance Binary DiffTime where diff --git a/src/Data/Time/LocalTime/Instances.hs b/src/Data/Time/LocalTime/Instances.hs index 6bdf4610d..39c0d70f0 100644 --- a/src/Data/Time/LocalTime/Instances.hs +++ b/src/Data/Time/LocalTime/Instances.hs @@ -12,12 +12,6 @@ import Data.Binary (Binary) import qualified Language.Haskell.TH.Syntax as TH -import qualified Data.Csv as Csv - -import Data.Time.Clock.Instances - ( iso8601OutputFormat, iso8601ParseFormat - ) - deriving instance Generic TimeOfDay deriving instance Typeable TimeOfDay @@ -27,9 +21,3 @@ instance Binary TimeOfDay deriving instance TH.Lift TimeZone - -instance Csv.ToField ZonedTime where - toField = Csv.toField . formatTime defaultTimeLocale iso8601OutputFormat - -instance Csv.FromField ZonedTime where - parseField = parseTimeM False defaultTimeLocale iso8601ParseFormat <=< Csv.parseField diff --git a/src/Foundation.hs b/src/Foundation.hs index 07f373149..35bcd7871 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -3822,6 +3822,17 @@ pageActions (EExamR tid ssh coursen examn EEGradesR) = return } , navChildren = [] } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExternalExamEdit + , navRoute = EExamR tid ssh coursen examn EEEditR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } ] pageActions (EExamR tid ssh coursen examn EEUsersR) = return [ NavPageActionPrimary @@ -3835,6 +3846,17 @@ pageActions (EExamR tid ssh coursen examn EEUsersR) = return } , navChildren = [] } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExternalExamEdit + , navRoute = EExamR tid ssh coursen examn EEEditR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } ] pageActions ParticipantsListR = return [ NavPageActionPrimary diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index f4093afea..e95121686 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -452,6 +452,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do , dbtCsvName = unpack csvName , dbtCsvNoExportData = Nothing , dbtCsvHeader = return . Vector.filter csvColumns' . flip (userTableCsvHeader showSex) tutorials . fromMaybe def + , dbtCsvExampleData = Nothing } where userNote = runMaybeT $ do diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 91e19c86c..e567406c9 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -617,6 +617,7 @@ postEUsersR tid ssh csh examn = do , dbtCsvName = unpack csvName , dbtCsvNoExportData = Just id , dbtCsvHeader = const . return . examUserTableCsvHeader allBoni doBonus $ examParts ^.. folded . _entityVal . _examPartNumber + , dbtCsvExampleData = Nothing } where doEncode' = ExamUserTableCsv diff --git a/src/Handler/ExamOffice/Exam.hs b/src/Handler/ExamOffice/Exam.hs index b7c497762..228bb0455 100644 --- a/src/Handler/ExamOffice/Exam.hs +++ b/src/Handler/ExamOffice/Exam.hs @@ -412,6 +412,7 @@ postEGradesR tid ssh csh examn = do , dbtCsvName = unpack csvName , dbtCsvNoExportData = Nothing , dbtCsvHeader = const . return $ Csv.headerOrder (error "headerOrder" :: ExamUserTableCsv) + , dbtCsvExampleData = Nothing } dbtCsvDecode = Nothing diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 59bb82141..a83efa0af 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Handler.Utils.DateTime ( utcToLocalTime, utcToZonedTime , localTimeToUTC, TZ.LocalToUTCResult(..) @@ -24,11 +26,14 @@ import qualified Data.Time.Zones as TZ import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime, utcToZonedTime) -- import Data.Time.Clock (addUTCTime,nominalDay) import qualified Data.Time.Format as Time +import Data.Time.Format.ISO8601 (iso8601Show) import qualified Data.Set as Set import Data.Time.Clock.System (systemEpochDay) +import qualified Data.Csv as Csv + ------------- -- UTCTime -- @@ -274,3 +279,30 @@ formatTimeRangeMail = formatTimeRange' formatTimeMail formatGregorianW :: Integer -> Int -> Int -> Widget formatGregorianW year month day = formatTimeW SelFormatDate $ fromGregorian year month day + +instance Csv.ToField ZonedTime where + toField = Csv.toField . iso8601Show + +instance Csv.FromField ZonedTime where + parseField = parse <=< Csv.parseField + where + parse t = asum $ do + (doZone, fmt) <- parseFormats + return $ do + zonedRes <- parseTimeM False defaultTimeLocale fmt t + if | doZone -> return zonedRes + | otherwise -> do + let localRes = zonedTimeToLocalTime zonedRes + utcRes = localTimeToUTC localRes + LTUUnique{_ltuResult} <- pure utcRes + return $ utcToZonedTime _ltuResult + + parseFormats = do + date <- ["%Y-%m-%d", "%d.%m.%Y"] + sep <- ["T", " "] + doZone <- [True, False] + let zone = bool "" "%z" doZone + time <- ["%H:%M:%S", "%H:%M", ""] + + return . (doZone, ) $ date <> sep <> time <> zone + diff --git a/src/Handler/Utils/ExternalExam/Users.hs b/src/Handler/Utils/ExternalExam/Users.hs index 0545297cf..541f6f4bc 100644 --- a/src/Handler/Utils/ExternalExam/Users.hs +++ b/src/Handler/Utils/ExternalExam/Users.hs @@ -26,6 +26,8 @@ import qualified Data.Text.Lens as Text import qualified Data.Conduit.List as C +import Data.List (cycle) + data ExternalExamUserMode = EEUMUsers | EEUMGrades deriving (Eq, Ord, Read, Show, Bounded, Enum, Generic, Typeable) @@ -70,7 +72,7 @@ data ExternalExamUserTableCsv = ExternalExamUserTableCsv , csvEUserFirstName :: Maybe Text , csvEUserName :: Maybe Text , csvEUserMatriculation :: Maybe Text - , csvEUserOccurrenceStart :: ZonedTime + , csvEUserOccurrenceStart :: Maybe ZonedTime , csvEUserExamResult :: ExamResultPassedGrade } deriving (Generic) makeLenses_ ''ExternalExamUserTableCsv @@ -91,7 +93,7 @@ instance FromNamedRecord ExternalExamUserTableCsv where <*> csv .:?? "first-name" <*> csv .:?? "name" <*> csv .:?? "matriculation" - <*> csv .: "occurrence-start" + <*> csv .:?? "occurrence-start" <*> csv .: "exam-result" @@ -123,6 +125,7 @@ newtype ExternalExamUserCsvExportDataGrades = ExternalExamUserCsvExportDataGrade data ExamUserCsvException = ExamUserCsvExceptionNoMatchingUser + | ExamUserCsvExceptionNoOccurrenceTime deriving (Show, Generic, Typeable) instance Exception ExamUserCsvException @@ -176,6 +179,8 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do csvName <- getMessageRender <*> pure (MsgExternalExamUserCsvName tid ssh coursen examn) isLecturer <- hasReadAccessTo $ EExamR tid ssh coursen examn EEUsersR currentRoute <- fromMaybe (error "makeExternalExamUsersTable called from 404-handler") <$> getCurrentRoute + MsgRenderer mr <- getMsgRenderer + exampleTime <- over _utctDayTime (fromInteger . round . toRational) <$> liftIO getCurrentTime let dbtSQLQuery = runReaderT $ do @@ -319,8 +324,46 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do , dbtCsvName = unpack csvName , dbtCsvNoExportData = Nothing , dbtCsvHeader = const . return $ headerOrder (error "headerOrder" :: ExternalExamUserTableCsv) + , dbtCsvExampleData = Nothing } - EEUMUsers -> simpleCsvEncode csvName encodeCsv' + EEUMUsers -> + let baseEncode = simpleCsvEncode csvName encodeCsv' + in baseEncode <&> \enc -> enc + { dbtCsvExampleData = Just + [ ExternalExamUserTableCsv{..} + | (csvEUserSurname, csvEUserFirstName, csvEUserName, csvEUserMatriculation) <- + [ ( Just $ mr MsgExampleUser1Surname + , Just $ mr MsgExampleUser1FirstName + , Just $ mr MsgExampleUser1DisplayName + , Just "12345678" + ) + , ( Nothing + , Nothing + , Nothing + , Just "87654321" + ) + , ( Nothing + , Nothing + , Just $ mr MsgExampleUser2DisplayName + , Nothing + ) + , ( Just $ mr MsgExampleUser3Surname + , Nothing + , Nothing + , Nothing + ) + ] + | csvEUserOccurrenceStart <- catMaybes $ + guardOn (is _Just externalExamDefaultTime) Nothing + : repeat (Just . Just $ utcToZonedTime exampleTime) + | csvEUserExamResult <- cycle . catMaybes $ + [ guardOn (hasExamGradingPass externalExamGradingMode) $ ExamAttended (Left $ ExamPassed True) + , guardOn (hasExamGradingGrades externalExamGradingMode) $ ExamAttended (Right $ Grade50) + , pure $ ExamVoided + , pure $ ExamNoShow + ] + ] + } where encodeCsv' :: ExternalExamUserTableData -> ExternalExamUserTableCsv encodeCsv' row = ExternalExamUserTableCsv @@ -328,7 +371,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do , csvEUserFirstName = row ^? resultUser . _entityVal . _userFirstName , csvEUserName = row ^? resultUser . _entityVal . _userDisplayName , csvEUserMatriculation = row ^? resultUser . _entityVal . _userMatrikelnummer . _Just - , csvEUserOccurrenceStart = row ^. resultResult . _entityVal . _externalExamResultTime . to utcToZonedTime + , csvEUserOccurrenceStart = row ^? resultResult . _entityVal . _externalExamResultTime . to utcToZonedTime , csvEUserExamResult = row ^. resultResult . _entityVal . _externalExamResultResult } dbtCsvDecode @@ -344,11 +387,13 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do pid <- lift $ guessUser' dbCsvNew let ExternalExamUserTableCsv{..} = dbCsvNew - yield $ ExternalExamUserCsvRegisterData pid (zonedTimeToUTC csvEUserOccurrenceStart) csvEUserExamResult + occTime <- maybe (throwM ExamUserCsvExceptionNoOccurrenceTime) return $ fmap zonedTimeToUTC csvEUserOccurrenceStart <|> externalExamDefaultTime + yield $ ExternalExamUserCsvRegisterData pid occTime csvEUserExamResult DBCsvDiffExisting{..} -> do let ExternalExamUserTableCsv{..} = dbCsvNew - when (zonedTimeToUTC csvEUserOccurrenceStart /= dbCsvOld ^. resultResult . _entityVal . _externalExamResultTime) $ - yield $ ExternalExamUserCsvSetTimeData (E.unValue dbCsvOldKey) (zonedTimeToUTC csvEUserOccurrenceStart) + whenIsJust (zonedTimeToUTC <$> csvEUserOccurrenceStart) $ \occTime -> + when (occTime /= dbCsvOld ^. resultResult . _entityVal . _externalExamResultTime) $ + yield $ ExternalExamUserCsvSetTimeData (E.unValue dbCsvOldKey) occTime when (csvEUserExamResult /= dbCsvOld ^. resultResult . _entityVal . _externalExamResultResult) $ yield $ ExternalExamUserCsvSetResultData (E.unValue dbCsvOldKey) csvEUserExamResult diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 68eec954d..dd07ad173 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -372,6 +372,7 @@ data DBCsvMode | DBCsvImport { dbCsvFiles :: [FileInfo] } + | DBCsvExportExample data DBCsvDiff r' csv k' = DBCsvDiffNew @@ -555,7 +556,8 @@ data DBTCsvEncode r' k' csv = forall exportData. , Typeable exportData ) => DBTCsvEncode { dbtCsvExportForm :: AForm DB exportData - , dbtCsvHeader :: Maybe exportData -> DB Csv.Header -- ^ @exportData@ is @Nothing@, if we're reporting an error + , dbtCsvHeader :: Maybe exportData -> DB Csv.Header -- ^ @exportData@ is @Nothing@, if we're reporting an error or exporting example data + , dbtCsvExampleData :: Maybe [csv] , dbtCsvDoEncode :: exportData -> ConduitT (k', r') csv DB () , dbtCsvName :: FilePath , dbtCsvNoExportData :: Maybe (AnIso' exportData ()) @@ -616,6 +618,7 @@ simpleCsvEncode fName f = Just DBTCsvEncode , dbtCsvName = unpack fName , dbtCsvNoExportData = Just id , dbtCsvHeader = const . return $ headerOrder (error "headerOrder" :: csv) + , dbtCsvExampleData = Nothing } simpleCsvEncodeM :: forall fp r' k' csv. @@ -630,6 +633,7 @@ simpleCsvEncodeM fName f = Just DBTCsvEncode , dbtCsvName = unpack fName , dbtCsvNoExportData = Just id , dbtCsvHeader = const . return $ headerOrder (error "headerOrder" :: csv) + , dbtCsvExampleData = Nothing } @@ -940,10 +944,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db -> pure $ toDyn () ((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport <$> areq fileFieldMultiple (fslI MsgCsvFile) Nothing + exportExampleRes <- guardOn <$> hasGlobalGetParam GetCsvExampleData <*> pure DBCsvExportExample let csvMode = asum - [ csvExportRes <* guard (is _Just dbtCsvEncode) + [ maybe FormMissing FormSuccess exportExampleRes + , csvExportRes <* guard (is _Just dbtCsvEncode) , csvImportRes <* guard (is _Just dbtCsvDecode) , FormSuccess DBCsvNormal ] @@ -1035,8 +1041,19 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db (currentKeys, rows) <- fmap (unzip . sortProjected) . mapMaybeM' (assertMM allFilterProjected . lift . dbtProj) . map (\(E.Value dbrCount, dbrKey, dbrOutput) -> (dbrKey, DBRow{..})) $ reproduceSorting rows' + csvExample <- runMaybeT $ do + DBTCsvEncode{..} <- hoistMaybe dbtCsvEncode + exData <- hoistMaybe dbtCsvExampleData + hdr <- lift $ dbtCsvHeader Nothing + exportUrl <- toTextUrl (currentRoute, [(toPathPiece GetCsvExampleData, "")]) + return $(widgetFile "table/csv-example") formResult csvMode $ \case + DBCsvExportExample{} + | Just DBTCsvEncode{..} <- dbtCsvEncode + , Just exData <- dbtCsvExampleData -> do + hdr <- dbtCsvHeader Nothing + sendResponse <=< liftHandler . respondCsv hdr $ C.sourceList exData DBCsvExport{..} | Just DBTCsvEncode{..} <- dbtCsvEncode , Just exportData <- fromDynamic dbCsvExportData -> do diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs index 265686c14..25cb813a5 100644 --- a/src/Model/Types/Exam.hs +++ b/src/Model/Types/Exam.hs @@ -29,6 +29,7 @@ module Model.Types.Exam , ExamResultPassedGrade , ExamGradingMode(..) , _ExamGradingPass, _ExamGradingGrades, _ExamGradingMixed + , hasExamGradingPass, hasExamGradingGrades , ExamPartNumber , _ExamPartNumber, _ExamPartNumber' ) where @@ -365,6 +366,12 @@ pathPieceJSONKey ''ExamGradingMode derivePersistFieldPathPiece ''ExamGradingMode makePrisms ''ExamGradingMode +hasExamGradingPass, hasExamGradingGrades :: ExamGradingMode -> Bool +hasExamGradingPass ExamGradingGrades = False +hasExamGradingPass _ = True +hasExamGradingGrades ExamGradingPass = False +hasExamGradingGrades _ = True + newtype ExamPartNumber = ExamPartNumber { examPartNumberFragments :: [Either (CI Text) Natural] } deriving (Eq, Ord, Generic, Typeable) diff --git a/src/Utils/Parameters.hs b/src/Utils/Parameters.hs index cdc4a80c1..dbbd78070 100644 --- a/src/Utils/Parameters.hs +++ b/src/Utils/Parameters.hs @@ -20,7 +20,7 @@ import Data.Universe import Control.Monad.Trans.Maybe (MaybeT(..)) -data GlobalGetParam = GetReferer | GetBearer | GetRecipient +data GlobalGetParam = GetReferer | GetBearer | GetRecipient | GetCsvExampleData deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) instance Universe GlobalGetParam diff --git a/templates/table/csv-example.hamlet b/templates/table/csv-example.hamlet new file mode 100644 index 000000000..47f90633d --- /dev/null +++ b/templates/table/csv-example.hamlet @@ -0,0 +1,5 @@ +$newline never +

+ + _{MsgCsvExportExample} +^{toCsvRendered hdr exData} diff --git a/templates/table/csv-transcode.hamlet b/templates/table/csv-transcode.hamlet index b2b7a2a7b..f5f9832aa 100644 --- a/templates/table/csv-transcode.hamlet +++ b/templates/table/csv-transcode.hamlet @@ -6,6 +6,9 @@ $if is _Just dbtCsvDecode

^{csvImportExplanation} + $maybe wgt <- csvExample +

+ ^{modal (i18n MsgCsvExampleData) (Right wgt)} ^{csvImportWdgt'} $if is _Just dbtCsvEncode

diff --git a/templates/widgets/csvRendered.hamlet b/templates/widgets/csvRendered.hamlet index 91ffee919..5370109de 100644 --- a/templates/widgets/csvRendered.hamlet +++ b/templates/widgets/csvRendered.hamlet @@ -1,14 +1,16 @@ $newline never - - - - $forall header <- headers - - $forall row <- csvData - - $forall cell <- row -
- #{header} -
- $maybe cellText <- cell - #{cellText} +
+ + + + $forall header <- headers + + $forall row <- csvData + + $forall cell <- row +
+ #{header} +
+
+ $maybe cellText <- cell + #{cellText}