From 37cdc775b5b2d3e4cd1cc22858b2c05e75de8a3c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Mon, 12 Apr 2021 11:54:13 +0200
Subject: [PATCH] feat: partial support for lsf import

Work on #686
---
 src/Handler/Exam/Users.hs               |  2 +-
 src/Handler/Utils/Csv.hs                |  7 ++++++-
 src/Handler/Utils/ExternalExam/Users.hs |  2 +-
 src/Model/Types/Exam.hs                 | 28 +++++++++++++------------
 src/Utils/Csv.hs                        | 17 +++++++++++++++
 5 files changed, 40 insertions(+), 16 deletions(-)

diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs
index c1efbcf8c..1ae091831 100644
--- a/src/Handler/Exam/Users.hs
+++ b/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"
diff --git a/src/Handler/Utils/Csv.hs b/src/Handler/Utils/Csv.hs
index e85d60d8d..813527281 100644
--- a/src/Handler/Utils/Csv.hs
+++ b/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
diff --git a/src/Handler/Utils/ExternalExam/Users.hs b/src/Handler/Utils/ExternalExam/Users.hs
index f1d2984bb..01969bb51 100644
--- a/src/Handler/Utils/ExternalExam/Users.hs
+++ b/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"
diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs
index 979713ded..193e319fb 100644
--- a/src/Model/Types/Exam.hs
+++ b/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
-      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
diff --git a/src/Utils/Csv.hs b/src/Utils/Csv.hs
index 27103fbc2..7070720b1 100644
--- a/src/Utils/Csv.hs
+++ b/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]