feat: partial support for lsf import

Work on #686

src/Handler/Exam/Users.hs

@@ -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"

src/Handler/Utils/Csv.hs

@@ -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

src/Handler/Utils/ExternalExam/Users.hs

@@ -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"

src/Model/Types/Exam.hs

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

src/Utils/Csv.hs

@@ -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]