parent
3a92a1c1f2
commit
37cdc775b5
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user