feat(csv): export example data & improve zoned-time parsing
This commit is contained in:
parent
38dbfe73b2
commit
49d9ab9dba
@ -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
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
5
templates/table/csv-example.hamlet
Normal file
5
templates/table/csv-example.hamlet
Normal file
@ -0,0 +1,5 @@
|
||||
$newline never
|
||||
<p>
|
||||
<a href=#{exportUrl}>
|
||||
_{MsgCsvExportExample}
|
||||
^{toCsvRendered hdr exData}
|
||||
@ -6,6 +6,9 @@ $if is _Just dbtCsvDecode
|
||||
<div .csv-import__content>
|
||||
<p>
|
||||
^{csvImportExplanation}
|
||||
$maybe wgt <- csvExample
|
||||
<p>
|
||||
^{modal (i18n MsgCsvExampleData) (Right wgt)}
|
||||
^{csvImportWdgt'}
|
||||
$if is _Just dbtCsvEncode
|
||||
<div .csv-export>
|
||||
|
||||
@ -1,14 +1,16 @@
|
||||
$newline never
|
||||
<table .table .table--striped .table--hover>
|
||||
<thead>
|
||||
<tr .table__row .table__row--head>
|
||||
$forall header <- headers
|
||||
<th .table__th .table__th--csv>
|
||||
#{header}
|
||||
<tbody>
|
||||
$forall row <- csvData
|
||||
<tr .table__row>
|
||||
$forall cell <- row
|
||||
<td .table__td .table__td--csv>
|
||||
$maybe cellText <- cell
|
||||
#{cellText}
|
||||
<div .scrolltable .scrolltable--bordered>
|
||||
<table .table .table--striped .table--hover>
|
||||
<thead>
|
||||
<tr .table__row .table__row--head>
|
||||
$forall header <- headers
|
||||
<th .table__th .table__th--csv>
|
||||
#{header}
|
||||
<tbody>
|
||||
$forall row <- csvData
|
||||
<tr .table__row>
|
||||
$forall cell <- row
|
||||
<td .table__td .table__td--csv>
|
||||
<div .table__td-content>
|
||||
$maybe cellText <- cell
|
||||
#{cellText}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user