fix(csv-import): major usability improvements

frontend/src/app.sass

@@ -264,6 +264,9 @@ button,
 
   .buttongroup > &
     min-width: 0
+    
+  &.btn-danger
+    background-color: var(--color-error-dark)
 
 .buttongroup
   display: grid
@@ -284,6 +287,9 @@ button:not([disabled]):hover,
   background-color: var(--color-light)
   color: white
 
+  &.btn-danger
+    background-color: var(--color-error)
+
 .btn-primary
   background-color: var(--color-primary)
 
@@ -1220,3 +1226,9 @@ a.breadcrumbs__home
 
 .course__registration-status
   margin-bottom: 12px
+
+.csv-parse-error
+  white-space: pre-wrap
+  font-family: monospace
+  overflow: auto
+  max-height: 75vh

messages/uniworx/de-de-formal.msg

@@ -1756,6 +1756,7 @@ CsvDeleteMissing: Fehlende Einträge entfernen
 BtnCsvExport: CSV-Datei exportieren
 BtnCsvImport: CSV-Datei importieren
 BtnCsvImportConfirm: CSV-Import abschließen
+BtnCsvImportAbort: Abbrechen
 
 CsvImportNotConfigured: CSV-Import nicht vorgesehen
 CsvImportConfirmationHeading: CSV-Import Vorschau (noch keine Änderungen importiert)
@@ -1830,6 +1831,8 @@ DBCsvDuplicateKey: Zwei Zeilen der CSV-Dateien referenzieren den selben internen
 DBCsvDuplicateKeyTip: Entfernen Sie eine der unten aufgeführten Zeilen aus Ihren CSV-Dateien und versuchen Sie es erneut.
 DBCsvKeyException: Für eine Zeile der CSV-Dateien konnte nicht festgestellt werden, ob sie zu einem bestehenden internen Datensatz korrespondieren.
 DBCsvException: Bei der Berechnung der auszuführenden Aktionen für einen Datensatz ist ein Fehler aufgetreten.
+DBCsvParseError: Eine hochgeladene Datei konnte nicht korrekt als CSV-Datei im erwarteten Format interpretiert werden.
+DBCsvParseErrorTip: Die Uni2work-Komponente, die für das Interpretieren von CSV-Dateien zuständig ist, hat folgende Fehlermeldung produziert:
 
 ExamUserCsvCourseRegister: Benutzer zum Kurs und zur Prüfung anmelden
 ExamUserCsvRegister: Kursteilnehmer zur Prüfung anmelden
@@ -1846,9 +1849,9 @@ ExamBonusNone: Keine Bonuspunkte
 
 ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht
 
-ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identifiziert werden
-ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden
-ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
+ExamUserCsvExceptionNoMatchingUser: Benutzer konnte nicht eindeutig identifiziert werden. Alle Identifikatoren des Benutzers (Vorname(n), Nachname, Voller Name, Matrikelnummer, ...) müssen exakt übereinstimmen. Sie können versuchen für diese Zeile manche der Identifikatoren zu entfernen (also z.B. nur eine Matrikelnummer angeben) um dem System zu erlauben nur Anhand der verbleibenden Identifikatoren zu suchen. Sie sollten dann natürlich besonders kontrollieren, dass das System den fraglichen Benutzer korrekt identifiziert hat.
+ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Benutzers zugeordnet werden. Sie können versuchen für diese Zeile die Studiengangsdaten zu entfernen um das System automatisch ein Studienfach wählen zu lassen.
+ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden. Überprüfen Sie, dass diese Zeile nur interne Raumbezeichnungen enthält, wie sie auch für die Prüfung konfiguriert wurden.
 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.
 

messages/uniworx/en-eu.msg

@@ -1755,6 +1755,7 @@ CsvDeleteMissing: Delete missing entries
 BtnCsvExport: Export CSV file
 BtnCsvImport: Import CSV file
 BtnCsvImportConfirm: Finalise CSV import
+BtnCsvImportAbort: Abort
 
 CsvImportNotConfigured: CSV import not configured
 CsvImportConfirmationHeading: CSV import preview (no changes have been made yet)
@@ -1829,6 +1830,8 @@ DBCsvDuplicateKey: Two rows in the CSV file reference the same database entry an
 DBCsvDuplicateKeyTip: Please remove one of the lines listed below and try again.
 DBCsvKeyException: For a row in the CSV file it could not be determined whether it references any database entry.
 DBCsvException: An error occurred hile computing the set of edits this CSV import corresponds to.
+DBCsvParseError: An uploaded file could not be interpreted as CSV of the expected format.
+DBCsvParseErrorTip: The Uni2work-component that handles CSV decoding has reported the following error:
 
 ExamUserCsvCourseRegister: Register users for the exam and enroll them in the course
 ExamUserCsvRegister: Register users for the exam
@@ -1845,9 +1848,9 @@ ExamBonusNone: No bonus points
 
 ExamUserCsvCourseNoteDeleted: Course note will be deleted
 
-ExamUserCsvExceptionNoMatchingUser: Course participant could not be identified uniquely
-ExamUserCsvExceptionNoMatchingStudyFeatures: The specified field did not match with any of the participant's fields of study
-ExamUserCsvExceptionNoMatchingOccurrence: Occurrence/room could not be identified uniquely
+ExamUserCsvExceptionNoMatchingUser: Course participant could not be identified uniquely. All identifiers (given name(s), surname, display name, matriculation, ..) must match exactly. You can try to remove some of the identifiers for the given line (i.e. all but matriculation). Uni2work will then search for users using only the remaining identifiers. In this case special care should be taken that Uni2work correctly identifies the intended user.
+ExamUserCsvExceptionNoMatchingStudyFeatures: The specified field did not match with any of the participant's fields of study. You can try to remove the field of study for the given line. Uni2work will then automatically choose a field of study.
+ExamUserCsvExceptionNoMatchingOccurrence: Occurrence/room could not be identified uniquely. Please ensure that the given line only contains internal room identifiers exactly as they have been configured for this exam.
 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".
 

src/Handler/Utils/Csv.hs

@@ -39,6 +39,8 @@ import qualified Data.Attoparsec.ByteString.Lazy as A
 import Handler.Utils.DateTime
 import Data.Time.Format (iso8601DateFormat)
 
+import qualified Data.Char as Char
+
 
 decodeCsv :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, FromNamedRecord csv) => ConduitT ByteString csv m ()
 decodeCsv = decodeCsv' fromNamedCsv
@@ -69,6 +71,7 @@ decodeCsv' fromCsv' = do
 
       let decodeOptions = defaultDecodeOptions
             & guessDelimiter testBuffer
+            & noAlphaNumDelimiters
       $logInfoS "decodeCsv" [st|Guessed Csv.DecodeOptions from buffer of size #{tshow (LBS.length testBuffer)}/#{tshow testBufferSize}: #{tshow decodeOptions}|]
 
       fromCsv' decodeOptions
@@ -104,6 +107,12 @@ decodeCsv' fromCsv' = do
       | otherwise
       = id
 
+    noAlphaNumDelimiters opts
+      | Char.isAlphaNum . Char.chr . fromIntegral $ decDelimiter opts
+      = opts { decDelimiter = decDelimiter defaultDecodeOptions }
+      | otherwise
+      = opts
+
 
     quotedField :: A.Parser () -- We don't care about the return value
     quotedField = void . Csv.field $ Csv.decDelimiter defaultDecodeOptions -- We can use comma as a separator, because we know that the field we're trying to parse is quoted and so does not rely on the delimiter

src/Handler/Utils/Table/Pagination.hs

@@ -345,7 +345,7 @@ deriveJSON defaultOptions
   } ''DBCsvActionMode
 
 
-data ButtonCsvMode = BtnCsvExport | BtnCsvImport | BtnCsvImportConfirm
+data ButtonCsvMode = BtnCsvExport | BtnCsvImport | BtnCsvImportConfirm | BtnCsvImportAbort
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonCsvMode
 instance Finite ButtonCsvMode
@@ -363,6 +363,13 @@ instance Button UniWorX ButtonCsvMode where
       |]
   btnLabel x = [whamlet|_{x}|]
 
+  btnClasses BtnCsvImportAbort   = [BCIsButton, BCDanger]
+  btnClasses BtnCsvImportConfirm = [BCIsButton, BCPrimary]
+  btnClasses _                   = [BCIsButton]
+
+  btnValidate _ BtnCsvImportAbort = False
+  btnValidate _ _                 = True
+
 
 data DBCsvMode
   = DBCsvNormal
@@ -373,6 +380,7 @@ data DBCsvMode
     { dbCsvFiles :: [FileInfo]
     }
   | DBCsvExportExample
+  | DBCsvAbort
 
 data DBCsvDiff r' csv k'
   = DBCsvDiffNew
@@ -942,7 +950,15 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
         -> toDyn <$> dbtCsvExportForm
     Nothing
         -> pure $ toDyn ()
-  ((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport
+  let importButtons prevRes = do
+        isReImport <- hasGlobalPostParamForm PostDBCsvReImport
+        if | is _FormSuccess prevRes || isReImport
+             -> return [BtnCsvImport, BtnCsvImportAbort]
+           | otherwise
+             -> return [BtnCsvImport]
+      handleBtnAbort _ (FormSuccess BtnCsvImportAbort) = pure DBCsvAbort
+      handleBtnAbort x btn = x <* btn
+  ((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . withGlobalPostParam PostDBCsvReImport () . withButtonFormCombM' handleBtnAbort importButtons . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport
     <$> areq fileFieldMultiple (fslI MsgCsvFile) Nothing
   exportExampleRes <- guardOn <$> hasGlobalGetParam GetCsvExampleData <*> pure DBCsvExportExample
 
@@ -961,12 +977,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , formSubmit = FormSubmit
       , formAnchor = Just $ wIdent "csv-export"
       }
-    csvImportWdgt' = wrapForm' BtnCsvImport csvImportWdgt FormSettings
+    csvImportWdgt' = wrapForm csvImportWdgt FormSettings
       { formMethod = POST
       , formAction = Just $ tblLink id
       , formEncoding = csvImportEnctype
       , formAttrs = []
-      , formSubmit = FormSubmit
+      , formSubmit = FormNoSubmit
       , formAnchor = Just $ wIdent "csv-import"
       }
     csvImportExplanation :: Widget
@@ -1049,6 +1065,9 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     return $(widgetFile "table/csv-example") 
 
   formResult csvMode $ \case
+    DBCsvAbort{} -> do
+      addMessageI Info MsgCsvImportAborted
+      redirect $ tblLink id
     DBCsvExportExample{}
       | Just DBTCsvEncode{..} <- dbtCsvEncode
       , Just exData <- dbtCsvExampleData -> do
@@ -1113,6 +1132,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                 addMessageI Info MsgCsvImportUnnecessary
                 redirect $ tblLink id
 
+              E.transactionSave -- If dbtCsvComputeActions has side-effects, commit those
+
               liftHandler . (>>= sendResponse) $
                 siteLayoutMsg MsgCsvImportConfirmationHeading $ do
                   setTitleI MsgCsvImportConfirmationHeading
@@ -1136,18 +1157,20 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                               <input id=#{theId} *{attrs} type=checkbox name=#{name} value=#{either id id val} :defaultChecked (dbtCsvClassifyAction act):checked>
                             |]
                         fieldView sJsonField (actionIdent act) (toPathPiece PostDBCsvImportAction) vAttrs (Right act) False
-                  (csvImportConfirmForm', csvImportConfirmEnctype) <- liftHandler . generateFormPost . identifyForm FIDDBTableCsvImportConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation"))
-                  let csvImportConfirmForm = wrapForm' BtnCsvImportConfirm csvImportConfirmForm' FormSettings
+                  (csvImportConfirmForm', csvImportConfirmEnctype) <- liftHandler . generateFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm FIDDBTableCsvImportConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation"))
+                  let csvImportConfirmForm = wrapForm csvImportConfirmForm' FormSettings
                         { formMethod = POST
                         , formAction = Just $ tblLink id
                         , formEncoding = csvImportConfirmEnctype
                         , formAttrs = []
-                        , formSubmit = FormSubmit
+                        , formSubmit = FormNoSubmit
                         , formAnchor = Nothing :: Maybe Text
                         }
 
                   $(widgetFile "csv-import-confirmation-wrapper")
 
+            csvReImport = $(widgetFile "table/csv-reimport")
+
         hdr <- dbtCsvHeader Nothing
         catches importCsv
           [ Catch.Handler $ \case
@@ -1161,9 +1184,13 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                      siteLayoutMsg heading $ do
                        setTitleI heading
                        [whamlet|
-                         <p>_{MsgDBCsvDuplicateKey}
-                         <p>_{MsgDBCsvDuplicateKeyTip}
-                         ^{offendingCsv}
+                         $newline never
+                         <section>
+                           <p>_{MsgDBCsvDuplicateKey}
+                           <p>_{MsgDBCsvDuplicateKeyTip}
+                           ^{offendingCsv}
+                         <section>
+                           ^{csvReImport}
                        |]
               (DBCsvException{..} :: DBCsvException k')
                 -> liftHandler $ sendResponseStatus badRequest400 =<< do
@@ -1175,11 +1202,36 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                      siteLayoutMsg heading $ do
                        setTitleI heading
                        [whamlet|
-                         <p>_{MsgDBCsvException}
-                         $if not (Text.null dbCsvException)
-                           <p>#{dbCsvException}
-                         ^{ offendingCsv}
+                         $newline never
+                         <section>
+                           <p>_{MsgDBCsvException}
+                           $if not (Text.null dbCsvException)
+                             <p>#{dbCsvException}
+                           ^{offendingCsv}
+                         <section>
+                           ^{csvReImport}
                        |]
+          , Catch.Handler $ \(csvParseError :: CsvParseError)
+              -> liftHandler $ sendResponseStatus badRequest400 =<< do
+                   mr <- getMessageRender
+
+                   let heading = ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvParseError]
+
+                   siteLayoutMsg heading $ do
+                     setTitleI heading
+                     [whamlet|
+                       $newline never
+                       <section>
+                         <p>_{MsgDBCsvParseErrorTip}
+                         <pre .csv-parse-error>
+                           $case csvParseError
+                             $of CsvParseError _ errMsg
+                               #{errMsg}
+                             $of IncrementalError errMsg
+                               #{errMsg}
+                       <section>
+                         ^{csvReImport}
+                     |]
           ]
     _other      -> return ()
 
@@ -1260,11 +1312,11 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
           return . dbInvalidateResult dbtParams . DBTIRowsMissing $ length previousKeys - length currentKeys
       ]
 
-  ((csvImportConfirmRes, ()), _enctype) <- case dbtCsvDecode of
+  ((csvImportConfirmRes, _confirmView), _enctype) <- case dbtCsvDecode of
     Just (DBTCsvDecode{dbtCsvExecuteActions} :: DBTCsvDecode r' k' csv) -> do
-      lift . runFormPost . identifyForm FIDDBTableCsvImportConfirm $ \_csrf -> do
+      lift . runFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm FIDDBTableCsvImportConfirm $ \_csrf -> do
         acts <- globalPostParamFields PostDBCsvImportAction secretJsonField
-        return . (, ()) $ if
+        return . (, mempty) $ if
           | null acts -> FormSuccess $ do
               addMessageI Info MsgCsvImportAborted
               redirect $ tblLink id
@@ -1273,8 +1325,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
               addMessageI Success . MsgCsvImportSuccessful $ length acts
               E.transactionSave
               redirect finalDest
-    _other -> return ((FormMissing, ()), mempty)
-  formResult csvImportConfirmRes id
+    _other -> return ((FormMissing, mempty), mempty)
+  formResult csvImportConfirmRes $ \case
+    (_, BtnCsvImportAbort) -> do
+      addMessageI Info MsgCsvImportAborted
+      redirect $ tblLink id
+    (act, _) -> act
 
   dbInvalidateResult' <=< bool (dbHandler (Proxy @m) (Proxy @x) $ (\table -> $(widgetFile "table/layout-wrapper")) . uiLayout) (sendResponse <=< tblLayout . uiLayout <=< dbWidget (Proxy @m) (Proxy @x)) psShortcircuit <=< runDBTable dbtable paginationInput currentKeys . fmap swap $ runWriterT table'
   where

src/Handler/Utils/Users.hs

@@ -2,6 +2,8 @@ module Handler.Utils.Users
   ( computeUserAuthenticationDigest
   , Digest, SHA3_256
   , constEq
+  , NameMatchQuality(..)
+  , matchesName
   , GuessUserInfo(..)
   , guessUser
   ) where
@@ -21,6 +23,10 @@ import qualified Data.CaseInsensitive as CI
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 
+import qualified Data.MultiSet as MultiSet
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+
 
 computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256
 computeUserAuthenticationDigest = hashlazy . JSON.encode
@@ -36,14 +42,44 @@ instance Binary GuessUserInfo
 
 makeLenses_ ''GuessUserInfo
 
+data NameMatchQuality
+  = NameMatchSuffix
+  | NameMatchPrefix
+  | NameMatchPermutation
+  | NameMatchEqual
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+
+matchesName :: Textual t
+            => t -- ^ haystack
+            -> t -- ^ needle
+            -> Maybe NameMatchQuality
+matchesName (repack -> haystack) (repack -> needle)
+  = fmap (view _1) . Map.lookupMax $ Map.filter id tests
+  where
+    asWords :: Text -> [CI Text]
+    asWords = map CI.mk . filter (not . Text.null) . Text.words . Text.strip
+
+    tests :: Map NameMatchQuality Bool
+    tests = mconcat
+      [ singletonMap NameMatchEqual       $ asWords needle == asWords haystack
+      , singletonMap NameMatchPrefix      $ asWords needle `isPrefixOf` asWords haystack
+      , singletonMap NameMatchSuffix      $ asWords needle `isSuffixOf` asWords haystack
+      , singletonMap NameMatchPermutation $ ((==) `on` MultiSet.fromList) (asWords needle) (asWords haystack)
+      ]
+
 guessUser :: Set GuessUserInfo -> DB (Maybe UserId)
 guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
   where
+    asWords :: Text -> [Text]
+    asWords = filter (not . Text.null) . Text.words . Text.strip
+
+    containsAsSet x y = E.and . map (\y' -> x `E.hasInfix` E.val y') $ asWords y
+    
     toSql user = \case
-      GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer  E.==.       E.val (Just userMatriculation')
-      GuessUserDisplayName    userDisplayName'   -> user E.^. UserDisplayName    `E.hasInfix` E.val userDisplayName'
-      GuessUserSurname        userSurname'       -> user E.^. UserSurname        `E.hasInfix` E.val userSurname'
-      GuessUserFirstName      userFirstName'     -> user E.^. UserFirstName      `E.hasInfix` E.val userFirstName'
+      GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer  E.==.          E.val (Just userMatriculation')
+      GuessUserDisplayName    userDisplayName'   -> user E.^. UserDisplayName    `containsAsSet` userDisplayName'
+      GuessUserSurname        userSurname'       -> user E.^. UserSurname        `containsAsSet` userSurname'
+      GuessUserFirstName      userFirstName'     -> user E.^. UserFirstName      `containsAsSet` userFirstName'
 
     go didLdap = do
       let retrieveUsers = E.select . E.from $ \user -> do
@@ -58,9 +94,9 @@ guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
           closeness :: Entity User -> Entity User -> Ordering
           closeness = mconcat $ concat
             [ pure $ comparing (fmap Down . matchesMatriculation)
-            , (criteria ^.. folded . _guessUserSurname) <&> \surn -> comparing (preview $ _entityVal . _userSurname . to CI.mk . only (CI.mk surn))
-            , (criteria ^.. folded . _guessUserFirstName) <&> \firstn -> comparing (preview $ _entityVal . _userFirstName . to CI.mk . only (CI.mk firstn))
-            , (criteria ^.. folded . _guessUserDisplayName) <&> \dispn -> comparing (preview $ _entityVal . _userDisplayName . to CI.mk . only (CI.mk dispn))
+            , (criteria ^.. folded . _guessUserSurname) <&> \surn -> comparing (view $ _entityVal . _userSurname . to (`matchesName` surn))
+            , (criteria ^.. folded . _guessUserFirstName) <&> \firstn -> comparing (view $ _entityVal . _userFirstName . to (`matchesName` firstn))
+            , (criteria ^.. folded . _guessUserDisplayName) <&> \dispn -> comparing (view $ _entityVal . _userDisplayName . to (`matchesName` dispn))
             ]
 
           doLdap userMatr = do
@@ -70,19 +106,17 @@ guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
               ldapData <- campusUserMatr' ldapConf ldapPool userMatr
               for ldapData $ upsertCampusUser UpsertCampusUser
 
-
-      case users' of
-        x@(Entity pid _) : xs
-          | [] <- xs
-          , fromMaybe False (matchesMatriculation x) || didLdap
-            -> return $ Just pid
-          | x' : _ <- xs
-          , fromMaybe False (matchesMatriculation x) || didLdap
-          , GT <- x `closeness` x'
-            -> return $ Just pid
-          | not didLdap
-          , userMatr : userMatrs' <- criteria ^.. folded . _guessUserMatrikelnummer
-          , all (== userMatr) userMatrs'
-            -> doLdap userMatr >>= maybe (go True) (return . Just)
-        _other
+      if
+        | x@(Entity pid _) : [] <- users'
+        , fromMaybe False (matchesMatriculation x) || didLdap
+          -> return $ Just pid
+        | x@(Entity pid _) : x' : _ <- users'
+        , fromMaybe False (matchesMatriculation x) || didLdap
+        , GT <- x `closeness` x'
+          -> return $ Just pid
+        | not didLdap
+        , userMatr : userMatrs' <- criteria ^.. folded . _guessUserMatrikelnummer
+        , all (== userMatr) userMatrs'
+          -> doLdap userMatr >>= maybe (go True) (return . Just)
+        | otherwise
           -> return Nothing

src/Utils/Form.hs

@@ -393,11 +393,11 @@ buttonView btn = do
 
 
 -- | generate a form that only shows a finite amount of buttons
-buttonForm :: (Button site a, Finite a) => Html -> MForm (HandlerT site IO) (FormResult a, WidgetT site IO ())
+buttonForm :: (MonadHandler m, Button (HandlerSite m) a, Finite a) => Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ())
 buttonForm = buttonForm' universeF
 
 -- | like `buttonForm`, but for a given list of buttons, i.e. a subset or for buttons outside the Finite typeclass
-buttonForm' :: Button site a => [a] -> Html -> MForm (HandlerT site IO) (FormResult a, WidgetT site IO ())
+buttonForm' :: (MonadHandler m, Button (HandlerSite m) a) => [a] -> Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ())
 buttonForm' btns csrf = do
   (res, ($ []) -> fViews) <- aFormToForm . disambiguateButtons $ combinedButtonField btns ""
   return (res, [whamlet|
@@ -407,6 +407,36 @@ buttonForm' btns csrf = do
         ^{fvInput bView}
     |])
 
+withButtonForm' :: (MonadHandler m, Button (HandlerSite m) btn)
+                => [btn]
+                -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
+                -> (Html -> MForm m (FormResult (a, btn), WidgetT (HandlerSite m) IO ()))
+withButtonForm' = withButtonFormM' . const . return
+
+withButtonFormComb' :: (MonadHandler m, Button (HandlerSite m) btn)
+                    => (FormResult a -> FormResult btn -> FormResult b)
+                    -> [btn]
+                    -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
+                    -> (Html -> MForm m (FormResult b, WidgetT (HandlerSite m) IO ()))
+withButtonFormComb' f = withButtonFormCombM' f . const . return
+
+withButtonFormM' :: (MonadHandler m, Button (HandlerSite m) btn)
+                 => (FormResult a -> MForm m [btn])
+                 -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
+                 -> (Html -> MForm m (FormResult (a, btn), WidgetT (HandlerSite m) IO ()))
+withButtonFormM' = withButtonFormCombM' (\x btn -> (,) <$> x <*> btn)
+
+withButtonFormCombM' :: (MonadHandler m, Button (HandlerSite m) btn)
+                     => (FormResult a -> FormResult btn -> FormResult b)
+                     -> (FormResult a -> MForm m [btn])
+                     -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
+                     -> (Html -> MForm m (FormResult b, WidgetT (HandlerSite m) IO ()))
+withButtonFormCombM' combF mkBtns innerForm csrf = do
+  (innerRes, innerView) <- innerForm csrf
+  btns <- mkBtns innerRes
+  (buttonRes, btnView) <- buttonForm' btns mempty
+  return (combF innerRes buttonRes, innerView <> btnView)
+
 -- | buttons-only form complete with widget-generation and evaluation; return type determines buttons shown.
 runButtonForm ::(PathPiece ident, Eq ident, RenderMessage site FormMessage,
                 Button site ButtonSubmit, Button site a, Finite a)

src/Utils/Parameters.hs

@@ -7,6 +7,7 @@ module Utils.Parameters
   , lookupGlobalPostParam, hasGlobalPostParam, lookupGlobalPostParams
   , lookupGlobalPostParamForm, hasGlobalPostParamForm
   , globalPostParamField, globalPostParamFields
+  , withGlobalPostParam
   ) where
 
 import ClassyPrelude.Yesod
@@ -56,6 +57,7 @@ data GlobalPostParam = PostFormIdentifier
                      | PostMassInputShape
                      | PostBearer
                      | PostDBCsvImportAction
+                     | PostDBCsvReImport
                      | PostLoginDummy
                      | PostExamAutoOccurrencePrevious
                      | PostLanguage
@@ -94,3 +96,7 @@ globalPostParamFields ident Field{fieldParse} = fmap (fromMaybe []) . runMaybeT
   ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
   fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
   forM ((Left <$> fs) ++ (Right <$> ts)) $ \inp -> MaybeT $ either (const Nothing) id <$> lift (either (\f -> fieldParse [] [f]) (\t -> fieldParse [t] []) inp)
+
+withGlobalPostParam :: PathPiece result => GlobalPostParam -> result -> (Html -> MForm m a) -> (Html -> MForm m a)
+withGlobalPostParam (toPathPiece -> ident) (toPathPiece -> res) f csrf
+  = f $ csrf <> [shamlet|<input type=hidden name=#{ident} value=#{res}>|]

templates/table/csv-column-explanations.hamlet

@@ -1,3 +1,4 @@
+$newline never
 <h3>_{MsgCsvColumnsExplanationsTip}
 <dl .deflist>
   $forall (colName, colExplanation) <- csvColExplanations''

templates/table/csv-reimport.hamlet

@@ -0,0 +1,9 @@
+$newline never
+<p>^{csvImportExplanation}
+<p>^{csvColExplanations'}
+$maybe wgt <- csvExample
+  <p>
+    ^{modal (i18n MsgCsvExampleData) (Right wgt)}
+<p>
+  ^{modal (i18n MsgCsvChangeOptionsLabel) (Left (SomeRoute CsvOptionsR))}
+^{csvImportWdgt'}