feat: partial support for lsf import

Work on #686
This commit is contained in:
Gregor Kleen 2021-04-12 11:54:13 +02:00
parent 3a92a1c1f2
commit 37cdc775b5
5 changed files with 40 additions and 16 deletions

View File

@ -222,7 +222,7 @@ instance ToNamedRecord ExamUserTableCsv where
\pNumber pResult -> pure $ (csvExamPartHeader # pNumber) Csv..= pResult
instance FromNamedRecord ExamUserTableCsv where
parseNamedRecord csv
parseNamedRecord (lsfHeaderTranslate -> csv)
= ExamUserTableCsv
<$> csv .:?? "surname"
<*> csv .:?? "first-name"

View File

@ -88,7 +88,12 @@ decodeCsvPositional :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, F
decodeCsvPositional hdr = decodeCsv' $ \opts -> fromCsvStreamError opts hdr (review _haltingCsvParseError) .| throwIncrementalErrors
decodeCsv' :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => (forall m'. Monad m' => DecodeOptions -> ConduitT ByteString (MaybeEmptyRecord csv) (ExceptT CsvParseError m') ()) -> ConduitT ByteString csv m ()
decodeCsv' :: forall csv m.
( MonadHandler m, HandlerSite m ~ UniWorX
, MonadThrow m
)
=> (forall m'. Monad m' => DecodeOptions -> ConduitT ByteString (MaybeEmptyRecord csv) (ExceptT CsvParseError m') ())
-> ConduitT ByteString csv m ()
decodeCsv' fromCsv' = do
encOpts <- maybe def (userCsvOptions . entityVal) <$> lift maybeAuth
recodeCsv encOpts False decodeCsv'' .| C.mapMaybe unMaybeEmptyRecord

View File

@ -96,7 +96,7 @@ instance DefaultOrdered ExternalExamUserTableCsv where
headerOrder = Csv.genericHeaderOrder externalExamUserTableCsvOptions
instance FromNamedRecord ExternalExamUserTableCsv where
parseNamedRecord csv
parseNamedRecord (lsfHeaderTranslate -> csv)
= ExternalExamUserTableCsv
<$> csv .:?? "surname"
<*> csv .:?? "first-name"

View File

@ -294,19 +294,21 @@ numberGrade = prism toNumberGrade fromNumberGrade
Grade13 -> 1.3
Grade10 -> 1.0
fromNumberGrade :: Rational -> Either Rational ExamGrade
fromNumberGrade = \case
5.0 -> Right Grade50
4.0 -> Right Grade40
3.7 -> Right Grade37
3.3 -> Right Grade33
3.0 -> Right Grade30
2.7 -> Right Grade27
2.3 -> Right Grade23
2.0 -> Right Grade20
1.7 -> Right Grade17
1.3 -> Right Grade13
1.0 -> Right Grade10
n -> Left n
fromNumberGrade n
| n >= 100 = fromNumberGrade $ n / 100
| otherwise = case n of
5.0 -> Right Grade50
4.0 -> Right Grade40
3.7 -> Right Grade37
3.3 -> Right Grade33
3.0 -> Right Grade30
2.7 -> Right Grade27
2.3 -> Right Grade23
2.0 -> Right Grade20
1.7 -> Right Grade17
1.3 -> Right Grade13
1.0 -> Right Grade10
n' -> Left n'
instance PathPiece ExamGrade where
toPathPiece = toPathPiece . (fromRational :: Rational -> Deci) . review numberGrade

View File

@ -5,6 +5,7 @@ module Utils.Csv
, typeXlsx, extensionXlsx
, pathPieceCsv
, (.:??)
, lsfHeaderTranslate
, CsvRendered(..)
, toCsvRendered
, toDefaultOrderedCsvRendered
@ -34,6 +35,10 @@ import Control.Lens
import Data.Default
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.CaseInsensitive as CI
deriving instance Typeable CsvParseError
instance Exception CsvParseError
@ -65,6 +70,18 @@ pathPieceCsv (conT -> t) =
m .:?? name = lookup m name <|> return Nothing
lsfHeaderTranslate :: NamedRecord -> NamedRecord
lsfHeaderTranslate = HashMap.fromList . over (traverse . _1) lsfHeaderTranslate' . HashMap.toList
where
lsfHeaderTranslate' k = case CI.mk . Text.strip <$> Text.decodeUtf8' k of
Right k'
| k' == "mtknr" -> "matriculation"
| k' == "nachname" -> "surname"
| k' == "vorname" -> "first-name"
| k' == "bewertung" -> "exam-result"
_other -> k
data CsvRendered = CsvRendered
{ csvRenderedHeader :: Header
, csvRenderedData :: [NamedRecord]