Merge branch 'master' into alert-icons

frontend/src/utils/inputs/file-input.js

@@ -1,4 +1,5 @@
 import { Utility } from '../../core/utility';
+import './file-input.scss';
 
 const FILE_INPUT_CLASS = 'file-input';
 const FILE_INPUT_INITIALIZED_CLASS = 'file-input--initialized';

frontend/src/utils/inputs/file-input.scss

@@ -0,0 +1,3 @@
+.file-input__list:empty {
+  display: none;
+}

frontend/src/utils/inputs/inputs.scss

@@ -25,6 +25,11 @@
   color: var(--color-fontsec);
 }
 
+.form-section-legend {
+  color: var(--color-fontsec);
+  margin: 7px 0;
+}
+
 .form-group-label {
   font-weight: 600;
   padding-top: 6px;

messages/uniworx/de.msg

@@ -91,6 +91,7 @@ CourseDeregisterOk: Erfolgreich abgemeldet
 CourseDeregisterLecturerTip: Wenn Sie den Teilnehmer vom Kurs abmelden kann es sein, dass sie Zugriff auf diese Daten verlieren
 CourseStudyFeature: Assoziiertes Hauptfach
 CourseStudyFeatureUpdated: Assoziiertes Hauptfach geändert
+CourseStudyFeatureNone: Kein assoziiertes Hauptfach
 CourseTutorial: Tutorium
 CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen
 CourseSecretWrong: Falsches Kennwort
@@ -933,6 +934,8 @@ CommTutorialHeading: Tutorium-Mitteilung
 RecipientCustom: Weitere Empfänger
 RecipientToggleAll: Alle/Keine
 
+DBCsvImportActionToggleAll: Alle/Keine
+
 RGCourseParticipants: Kursteilnehmer
 RGCourseLecturers: Kursverwalter
 RGCourseCorrectors: Korrektoren
@@ -1062,7 +1065,7 @@ HealthWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
 CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer
 CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
 CourseParticipantsAlreadyRegistered n@Int: #{n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
-CourseParticipantsRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
+CourseParticipantsRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden ohne assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
 CourseParticipantsRegistered n@Int: #{n} Teilnehmer erfolgreich angemeldet
 CourseParticipantsRegisterHeading: Kursteilnehmer hinzufügen
 
@@ -1119,7 +1122,9 @@ ExamRoomMatriculation': Nach Matrikelnummer
 ExamRoomRandom': Zufällig pro Teilnehmer
 
 ExamOccurrence: Termin/Raum
+ExamNoOccurrence: Kein Termin/Raum
 ExamOccurrences: Prüfungen
+ExamRooms: Räume
 ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
 ExamRoomName: Interne Bezeichnung
 ExamRoom: Raum
@@ -1200,6 +1205,14 @@ CsvAddNew: Neue Einträge einfügen
 CsvDeleteMissing: Fehlende Einträge entfernen
 BtnCsvExport: CSV-Datei exportieren
 BtnCsvImport: CSV-Datei importieren
+BtnCsvImportConfirm: CSV-Import abschließen
+
+CsvImportNotConfigured: CSV-Import nicht vorgesehen
+CsvImportConfirmationHeading: CSV-Import abschließen
+CsvImportConfirmationTip: Durch den CSV-Import würden die unten aufgeführten Änderungen vorgenommen. Bitte überprüfen Sie diese zunächst sorgfältig.
+CsvImportUnnecessary: Durch den CSV-Import würden keine Änderungen vorgenommen werden
+CsvImportSuccessful n@Int: CSV-Import erfolgreich, es #{pluralDE n "wurde eine Aktion" (mappend (mappend "wurden " (toMessage n)) " Aktionen")} durchgeführt
+CsvImportAborted: CSV-Import abgebrochen
 
 Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
 
@@ -1218,3 +1231,22 @@ CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer
 CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können
 
 Action: Aktion
+
+DBCsvDuplicateKey: Zwei Zeilen der CSV-Dateien referenzieren den selben internen Datensatz und können daher nicht verarbeitet werden.
+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. 
+
+ExamUserCsvCourseRegister: Benutzer zum Kurs und zur Klausur anmelden
+ExamUserCsvRegister: Kursteilnehmer zur Klausur anmelden
+ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen
+ExamUserCsvDeregister: Teilnehmer von der Klausur abmelden
+ExamUserCsvSetCourseField: Kurs-assoziiertes Hauptfach ändern
+
+ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identifiziert werden
+ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Hauptfach des Kursteilnehmers zugeordnet werden
+ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
+
+TableHeadingFilter: Filter
+TableHeadingCsvImport: CSV-Import
+TableHeadingCsvExport: CSV-Export

src/Data/CaseInsensitive/Instances.hs

@@ -108,4 +108,4 @@ instance Csv.ToField s => Csv.ToField (CI s) where
   toField = Csv.toField . CI.original
 
 instance (CI.FoldCase s, Csv.FromField s) => Csv.FromField (CI s) where
-  parseField = fmap CI.original . Csv.parseField
+  parseField = fmap CI.mk . Csv.parseField

src/Database/Esqueleto/Utils.hs

@@ -4,6 +4,7 @@ module Database.Esqueleto.Utils
   ( true, false
   , isJust
   , isInfixOf, hasInfix
+  , or, and
   , any, all
   , SqlIn(..)
   , mkExactFilter, mkExactFilterWith
@@ -11,15 +12,17 @@ module Database.Esqueleto.Utils
   , mkExistsFilter
   , anyFilter, allFilter
   , orderByOrd, orderByEnum
+  , lower, ciEq
   ) where
 
 
-import ClassyPrelude.Yesod hiding (isInfixOf, any, all, isJust)
+import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust)
 import Data.Universe
 import qualified Data.Set as Set
 import qualified Data.List as List
 import qualified Data.Foldable as F
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
 
@@ -58,17 +61,19 @@ hasInfix :: ( E.Esqueleto query expr backend
          => expr (E.Value s2) -> expr (E.Value s1) -> expr (E.Value Bool)
 hasInfix = flip isInfixOf
 
+and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
+and = F.foldr (E.&&.) true
+or = F.foldr (E.||.) false
+
 -- | Given a test and a set of values, check whether anyone succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)
-any :: Foldable f =>
+any :: MonoFoldable f => (Element f -> E.SqlExpr (E.Value Bool)) -> f -> E.SqlExpr (E.Value Bool)
-  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
+any test = or . map test . otoList
-any test = F.foldr (\needle acc -> acc E.||. test needle) false
 
 -- | Given a test and a set of values, check whether all succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `&&` is short curcuited (i.e. lazily evaluated)
-all :: Foldable f =>
+all :: MonoFoldable f => (Element f -> E.SqlExpr (E.Value Bool)) -> f -> E.SqlExpr (E.Value Bool)
-  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
+all test = and . map test . otoList
-all test = F.foldr (\needle acc -> acc E.&&. test needle) true
 
 
 -- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples
@@ -165,3 +170,10 @@ orderByOrd = let sortUni = zip [1..] $ List.sort universeF in -- memoize this, m
 
 orderByEnum :: (Enum a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
 orderByEnum x = E.case_ [ (x E.==. E.val u, E.val $ fromEnum u) | u <- universeF ] (E.val (-1))
+
+
+lower :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
+lower = E.unsafeSqlFunction "LOWER"
+
+ciEq :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
+ciEq a b = lower a E.==. lower b

src/Handler/Exam.hs

@@ -22,6 +22,9 @@ import Data.Map ((!), (!?))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
+import qualified Data.Text as Text
+import qualified Data.Text.Lens as Text
+
 import Data.Aeson hiding (Result(..))
 import Text.Hamlet (ihamlet)
 import Text.Blaze.Html.Renderer.String (renderHtml)
@@ -29,6 +32,7 @@ import Text.Blaze.Html.Renderer.String (renderHtml)
 import qualified Data.CaseInsensitive as CI
 
 import qualified Control.Monad.State.Class as State
+import Control.Arrow (Kleisli(..))
 
 import qualified Data.Csv as Csv
 
@@ -883,6 +887,53 @@ embedRenderMessage ''UniWorX ''ExamUserAction id
 data ExamUserActionData = ExamUserDeregisterData
                         | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
 
+data ExamUserCsvActionClass
+  = ExamUserCsvCourseRegister
+  | ExamUserCsvRegister
+  | ExamUserCsvAssignOccurrence
+  | ExamUserCsvSetCourseField
+  | ExamUserCsvDeregister
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id
+
+data ExamUserCsvAction
+  = ExamUserCsvCourseRegisterData
+    { examUserCsvActUser :: UserId
+    , examUserCsvActCourseField :: Maybe StudyFeaturesId
+    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
+    }
+  | ExamUserCsvRegisterData
+    { examUserCsvActUser :: UserId
+    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
+    }
+  | ExamUserCsvAssignOccurrenceData
+    { examUserCsvActRegistration :: ExamRegistrationId
+    , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
+    }
+  | ExamUserCsvSetCourseFieldData
+    { examUserCsvActCourseParticipant :: CourseParticipantId
+    , examUserCsvActCourseField :: Maybe StudyFeaturesId
+    }
+  | ExamUserCsvDeregisterData
+    { examUserCsvActRegistration :: ExamRegistrationId
+    }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 3 . dropEnd 1 . splitCamel
+  , fieldLabelModifier = camelToPathPiece' 3
+  , sumEncoding = TaggedObject "action" "data"
+  } ''ExamUserCsvAction
+
+data ExamUserCsvException
+  = ExamUserCsvExceptionNoMatchingUser
+  | ExamUserCsvExceptionNoMatchingStudyFeatures
+  | ExamUserCsvExceptionNoMatchingOccurrence
+  deriving (Show, Generic, Typeable)
+
+instance Exception ExamUserCsvException
+
+embedRenderMessage ''UniWorX ''ExamUserCsvException id
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -994,7 +1045,204 @@ postEUsersR tid ssh csh examn = do
             <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
-          dbtCsvDecode = Nothing
+          dbtCsvDecode = Just DBTCsvDecode
+            { dbtCsvRowKey = \csv -> do
+                uid <- lift $ view _2 <$> guessUser csv
+                fmap E.Value . MaybeT . getKeyBy $ UniqueExamRegistration eid uid
+            , dbtCsvComputeActions = \case
+                DBCsvDiffMissing{dbCsvOldKey}
+                  -> yield . ExamUserCsvDeregisterData $ E.unValue dbCsvOldKey
+                DBCsvDiffNew{dbCsvNewKey = Just _}
+                  -> fail "An UniqueExamRegistration could be found, but the ExamRegistrationKey is not among the existing keys"
+                DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
+                  (isPart, uid) <- lift $ guessUser dbCsvNew
+                  if
+                    | isPart -> do
+                        yieldM $ ExamUserCsvRegisterData <$> pure uid <*> lookupOccurrence dbCsvNew
+                        newFeatures <- lift $ lookupStudyFeatures dbCsvNew
+                        Just (Entity cpId CourseParticipant{ courseParticipantField = oldFeatures }) <- lift . getBy $ UniqueParticipant uid examCourse
+                        when (newFeatures /= oldFeatures) $
+                          yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
+                    | otherwise ->
+                        yieldM $ ExamUserCsvCourseRegisterData uid <$> lookupStudyFeatures dbCsvNew <*> lookupOccurrence dbCsvNew
+                DBCsvDiffExisting{..} -> do
+                  newOccurrence <- lift $ lookupOccurrence dbCsvNew
+                  when (newOccurrence /= dbCsvOld ^? resultExamOccurrence . _entityKey) $
+                    yield $ ExamUserCsvAssignOccurrenceData (E.unValue dbCsvOldKey) newOccurrence
+
+                  newFeatures <- lift $ lookupStudyFeatures dbCsvNew
+                  when (newFeatures /= dbCsvOld ^? resultStudyFeatures . _entityKey) $ do
+                    Just (Entity cpId _) <- lift . getBy . flip UniqueParticipant examCourse $ dbCsvOld ^. resultUser . _entityKey
+                    yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
+            , dbtCsvClassifyAction = \case
+                ExamUserCsvCourseRegisterData{}   -> ExamUserCsvCourseRegister
+                ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
+                ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
+                ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
+                ExamUserCsvSetCourseFieldData{}   -> ExamUserCsvSetCourseField
+            , dbtCsvCoarsenActionClass = \case
+                ExamUserCsvCourseRegister -> DBCsvActionNew
+                ExamUserCsvRegister       -> DBCsvActionNew
+                ExamUserCsvDeregister     -> DBCsvActionMissing
+                _other                    -> DBCsvActionExisting 
+            , dbtCsvExecuteActions = do
+                C.mapM_ $ \case
+                  ExamUserCsvCourseRegisterData{..} -> do
+                    now <- liftIO getCurrentTime
+                    insert_ CourseParticipant
+                      { courseParticipantCourse = examCourse
+                      , courseParticipantUser = examUserCsvActUser
+                      , courseParticipantRegistration = now
+                      , courseParticipantField = examUserCsvActCourseField
+                      }
+                    insert_ ExamRegistration
+                      { examRegistrationExam = eid
+                      , examRegistrationUser = examUserCsvActUser
+                      , examRegistrationOccurrence = examUserCsvActOccurrence
+                      , examRegistrationTime = now
+                      }
+                  ExamUserCsvRegisterData{..} -> do
+                    examRegistrationTime <- liftIO getCurrentTime
+                    insert_ ExamRegistration
+                      { examRegistrationExam = eid
+                      , examRegistrationUser = examUserCsvActUser
+                      , examRegistrationOccurrence = examUserCsvActOccurrence
+                      , ..
+                      }
+                  ExamUserCsvAssignOccurrenceData{..} ->
+                    update examUserCsvActRegistration [ ExamRegistrationOccurrence =. examUserCsvActOccurrence ]
+                  ExamUserCsvSetCourseFieldData{..} ->
+                    update examUserCsvActCourseParticipant [ CourseParticipantField =. examUserCsvActCourseField ]
+                  ExamUserCsvDeregisterData{..} -> delete examUserCsvActRegistration
+                return $ CExamR tid ssh csh examn EUsersR
+            , dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case
+                ExamUserCsvCourseRegisterData{..} -> do
+                  (User{..}, occ) <- liftHandlerT . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
+                  [whamlet|
+                    $newline never
+                    ^{nameWidget userDisplayName userSurname}
+                    $maybe features <- examUserCsvActCourseField
+                      , ^{studyFeaturesWidget features}
+                    $nothing
+                      , _{MsgCourseStudyFeatureNone}
+                    $maybe ExamOccurrence{examOccurrenceName} <- occ
+                      \ (#{examOccurrenceName})
+                    $nothing
+                      \ (_{MsgExamNoOccurrence})
+                  |]
+                ExamUserCsvRegisterData{..} -> do
+                  (User{..}, occ) <- liftHandlerT . runDB $ (,) <$> getJust examUserCsvActUser <*> for examUserCsvActOccurrence getJust
+                  [whamlet|
+                    $newline never
+                    ^{nameWidget userDisplayName userSurname}
+                    $maybe ExamOccurrence{examOccurrenceName} <- occ
+                      \ (#{examOccurrenceName})
+                    $nothing
+                      \ (_{MsgExamNoOccurrence})
+                  |]
+                ExamUserCsvAssignOccurrenceData{..} -> do
+                  occ <- for examUserCsvActOccurrence $ liftHandlerT . runDB . getJust
+                  [whamlet|
+                    $newline never
+                    ^{registeredUserName' examUserCsvActRegistration}
+                    $maybe ExamOccurrence{examOccurrenceName} <- occ
+                      \ (#{examOccurrenceName})
+                    $nothing
+                      \ (_{MsgExamNoOccurrence})
+                  |]
+                ExamUserCsvSetCourseFieldData{..} -> do
+                  User{..} <- liftHandlerT . runDB $ getJust . courseParticipantUser =<< getJust examUserCsvActCourseParticipant
+                  [whamlet|
+                    $newline never
+                    ^{nameWidget userDisplayName userSurname}
+                    $maybe features <- examUserCsvActCourseField
+                      , ^{studyFeaturesWidget features}
+                    $nothing
+                      , _{MsgCourseStudyFeatureNone}
+                  |]
+                ExamUserCsvDeregisterData{..}
+                  -> registeredUserName' examUserCsvActRegistration
+            , dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
+            , dbtCsvRenderException = ap getMessageRender . pure :: ExamUserCsvException -> DB Text
+            }
+            where
+              studyFeaturesWidget :: StudyFeaturesId -> Widget
+              studyFeaturesWidget featId = do
+                (StudyFeatures{studyFeaturesSemester}, (degree, terms)) <- liftHandlerT . runDB . ($ featId) . runKleisli $ Kleisli getJust >>> Kleisli return &&& Kleisli (getJust . studyFeaturesDegree) &&& Kleisli (getJust . studyFeaturesField)
+                [whamlet|
+                  $newline never
+                  _{StudyDegreeTerm degree terms}, _{MsgStudyFeatureAge} #{studyFeaturesSemester}
+                |]
+               
+              registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget
+              registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
+                where
+                  Entity _ User{..} = view resultUser $ existing ! registration
+              
+              guessUser :: ExamUserTableCsv -> DB (Bool, UserId)
+              guessUser ExamUserTableCsv{..} = $cachedHereBinary (csvEUserMatriculation, csvEUserName, csvEUserSurname) $ do
+                users <- E.select . E.from $ \user -> do
+                  E.where_ . E.and $ catMaybes
+                    [ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvEUserMatriculation
+                    , (user E.^. UserDisplayName E.==.) . E.val <$> csvEUserName
+                    , (user E.^. UserSurname E.==.) . E.val <$> csvEUserSurname
+                    ]
+                  let isCourseParticipant = E.exists . E.from $ \courseParticipant ->
+                        E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse
+                             E.&&. courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
+                  E.limit 2
+                  return $ (isCourseParticipant, user E.^. UserId)
+                case users of
+                  (filter . view $ _1 . _Value -> [(E.Value isPart, E.Value uid)])
+                    -> return (isPart, uid)
+                  [(E.Value isPart, E.Value uid)]
+                    -> return (isPart, uid)
+                  _other
+                    -> throwM ExamUserCsvExceptionNoMatchingUser
+
+              lookupOccurrence :: ExamUserTableCsv -> DB (Maybe ExamOccurrenceId)
+              lookupOccurrence ExamUserTableCsv{..} = $cachedHereBinary (CI.foldedCase <$> csvEUserOccurrence) . for csvEUserOccurrence $ \occName -> do
+                occIds <- selectKeysList [ ExamOccurrenceName ==. occName, ExamOccurrenceExam ==. eid ] []
+                case occIds of
+                  [occId] -> return occId
+                  _other  -> throwM ExamUserCsvExceptionNoMatchingOccurrence
+
+              lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId)
+              lookupStudyFeatures csv@ExamUserTableCsv{..} = do
+                uid <- view _2 <$> guessUser csv
+                studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> do
+                  E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
+                  E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
+                  E.where_ . E.and $ catMaybes 
+                    [ do
+                        field <- csvEUserField
+                        return . E.or $ catMaybes
+                          [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
+                          , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
+                          , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
+                          ]
+                    , do
+                        degree <- csvEUserDegree
+                        return . E.or $ catMaybes
+                          [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
+                          , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
+                          , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
+                          ]
+                    , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
+                    ]
+                  E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
+                       E.&&. studyFeatures E.^. StudyFeaturesType E.==. E.val FieldPrimary
+                       E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True
+                  E.limit 2
+                  return $ studyFeatures E.^. StudyFeaturesId
+                case studyFeatures of
+                  [E.Value fid] -> return $ Just fid
+                  _other
+                    | is _Nothing csvEUserField
+                    , is _Nothing csvEUserDegree
+                    , is _Nothing csvEUserSemester
+                    -> return Nothing
+                  _other        -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures
 
       examUsersDBTableValidator = def
 

src/Handler/Utils/Csv.hs

@@ -10,9 +10,11 @@ module Handler.Utils.Csv
   , ToNamedRecord(..), FromNamedRecord(..)
   , DefaultOrdered(..)
   , ToField(..), FromField(..)
+  , CsvRendered(..)
+  , toCsvRendered
   ) where
 
-import Import
+import Import hiding (Header)
 
 import Data.Csv
 import Data.Csv.Conduit
@@ -21,6 +23,8 @@ import qualified Data.Conduit.List as C
 import qualified Data.Conduit.Combinators as C (sourceLazy)
 
 import qualified Data.Map as Map
+import qualified Data.Vector as Vector
+import qualified Data.HashMap.Strict as HashMap
 
 
 deriving instance Typeable CsvParseError
@@ -69,3 +73,31 @@ fileSourceCsv :: ( FromNamedRecord csv
               => FileInfo
               -> Source m csv
 fileSourceCsv = (.| decodeCsv) . fileSource
+
+
+data CsvRendered = CsvRendered
+  { csvRenderedHeader :: Header
+  , csvRenderedData :: [NamedRecord]
+  } deriving (Eq, Read, Show, Generic, Typeable)
+
+instance ToWidget UniWorX CsvRendered where
+  toWidget CsvRendered{..} = liftWidgetT $(widgetFile "widgets/csvRendered")
+    where
+      csvData = [ [ decodeUtf8 <$> HashMap.lookup columnKey row
+                  | columnKey <- Vector.toList csvRenderedHeader
+                  ]
+                | row <- csvRenderedData
+                ]
+
+      headers = decodeUtf8 <$> Vector.toList csvRenderedHeader
+
+toCsvRendered :: forall mono.
+                 ( ToNamedRecord (Element mono)
+                 , DefaultOrdered (Element mono)
+                 , MonoFoldable mono
+                 )
+              => mono -> CsvRendered
+toCsvRendered (otoList -> csvs) = CsvRendered{..}
+  where
+    csvRenderedHeader = headerOrder (error "not forced" :: Element mono)
+    csvRenderedData   = map toNamedRecord csvs

src/Handler/Utils/Table/Pagination.hs

@@ -7,7 +7,9 @@ module Handler.Utils.Table.Pagination
   , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount
   , DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..)
   , module Handler.Utils.Table.Pagination.CsvColumnExplanations
-  , DBTCsvEncode, DBTCsvDecode
+  , DBCsvActionMode(..)
+  , DBCsvDiff(..), _DBCsvDiffNew, _DBCsvDiffExisting, _DBCsvDiffMissing, _dbCsvOldKey, _dbCsvOld, _dbCsvNewKey, _dbCsvNew
+  , DBTCsvEncode, DBTCsvDecode(..)
   , DBTable(..), noCsvEncode, IsDBTable(..), DBCell(..)
   , singletonFilter
   , DBParams(..)
@@ -50,23 +52,28 @@ import qualified Database.Esqueleto.Internal.Language as E (From)
 
 import qualified Network.Wai as Wai
 
-import Control.Monad.RWS hiding ((<>), mapM_)
+import Control.Monad.RWS (RWST(..), execRWS)
-import Control.Monad.Writer hiding ((<>), mapM_)
+import Control.Monad.Writer (WriterT(..))
 import Control.Monad.Reader (ReaderT(..), mapReaderT)
+import Control.Monad.State (StateT(..), evalStateT)
 import Control.Monad.Trans.Maybe
+import Control.Monad.State.Class (modify)
+import qualified Control.Monad.State.Class as State
 
 import Data.Foldable (Foldable(foldMap))
 
-import Data.Map (Map)
+import Data.Map (Map, (!))
 import qualified Data.Map as Map
 
 import qualified Data.Set as Set
 
 import qualified Data.CaseInsensitive as CI
 
+import Data.Csv (NamedRecord)
+
 import Colonnade hiding (bool, fromMaybe, singleton)
 import qualified Colonnade (singleton)
-import Colonnade.Encode
+import Colonnade.Encode hiding (row)
 
 import Text.Hamlet (hamletFile)
 
@@ -97,6 +104,8 @@ import Data.Semigroup as Sem (Semigroup(..))
 
 import qualified Data.Conduit.List as C
 
+import qualified Control.Monad.Catch as Catch
+
 
 #if MIN_VERSION_base(4,11,0)
 type Monoid' = Monoid
@@ -272,7 +281,18 @@ piIsUnset PaginationInput{..} = and
   ]
 
   
-data ButtonCsvMode = BtnCsvExport | BtnCsvImport
+data DBCsvActionMode = DBCsvActionNew | DBCsvActionExisting | DBCsvActionMissing
+  deriving (Read, Show, Eq, Ord, Enum, Bounded, Generic, Typeable)
+instance Universe DBCsvActionMode
+instance Finite DBCsvActionMode
+
+nullaryPathPiece ''DBCsvActionMode $ camelToPathPiece' 3
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 3
+  } ''DBCsvActionMode
+
+
+data ButtonCsvMode = BtnCsvExport | BtnCsvImport | BtnCsvImportConfirm
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonCsvMode
 instance Finite ButtonCsvMode
@@ -288,21 +308,51 @@ instance Button UniWorX ButtonCsvMode where
         #{iconFileCSV}
         \ _{BtnCsvExport}
       |]
-  btnLabel BtnCsvImport
+  btnLabel x = [whamlet|_{x}|]
-    = [whamlet|
-        $newline never
-        _{BtnCsvImport}
-      |]
-
-data DBCsvMode = DBCsvNormal
-               | DBCsvExport
-               | DBCsvImport
-                 { _dbCsvFiles :: [FileInfo]
-                 , _dbCsvModifyExisting, _dbCsvAddNew, _dbCsvDeleteMissing :: Bool
-                 }
 
 
-type DBTableKey k' = (ToJSON k', FromJSON k', Ord k', Binary k')
+data DBCsvMode
+  = DBCsvNormal
+  | DBCsvExport
+  | DBCsvImport
+    { dbCsvFiles :: [FileInfo]
+    }
+
+data DBCsvDiff r' csv k'
+  = DBCsvDiffNew
+    { dbCsvNewKey :: Maybe k'
+    , dbCsvNew :: csv
+    }
+  | DBCsvDiffExisting
+    { dbCsvOldKey :: k'
+    , dbCsvOld :: r'
+    , dbCsvNew :: csv
+    }
+  | DBCsvDiffMissing
+    { dbCsvOldKey :: k'
+    , dbCsvOld :: r'
+    }
+
+makeLenses_ ''DBCsvDiff
+makePrisms ''DBCsvDiff
+
+data DBCsvException k'
+  = DBCsvDuplicateKey
+    { dbCsvDuplicateKey :: k'
+    , dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB :: NamedRecord
+    }
+  | DBCsvException
+    { dbCsvExceptionRow :: NamedRecord
+    , dbCsvException :: Text
+    }
+  deriving (Show, Typeable)
+
+makeLenses_ ''DBCsvException
+
+instance (Typeable k', Show k') => Exception (DBCsvException k')
+
+
+type DBTableKey k' = (Show k', ToJSON k', FromJSON k', Ord k', Binary k', Typeable k')
 data DBRow r = forall k'. DBTableKey k' => DBRow
   { dbrKey :: k'
   , dbrOutput :: r
@@ -440,9 +490,25 @@ instance PathPiece x => PathPiece (WithIdent x) where
     (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
     WithIdent <$> pure ident <*> fromPathPiece rest
 
-
 type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv)
-type DBTCsvDecode csv = DictMaybe (FromNamedRecord csv) (Sink csv (YesodDB UniWorX) ())
+data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException.
+  ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
+  , DBTableKey k'
+  , RedirectUrl UniWorX route
+  , Typeable csv
+  , Ord csvAction, FromJSON csvAction, ToJSON csvAction
+  , Ord csvActionClass
+  , Exception csvException
+  ) => DBTCsvDecode
+  { dbtCsvRowKey :: csv -> MaybeT (YesodDB UniWorX) k'
+  , dbtCsvComputeActions :: DBCsvDiff r' csv k' -> Source (YesodDB UniWorX) csvAction
+  , dbtCsvClassifyAction :: csvAction -> csvActionClass
+  , dbtCsvCoarsenActionClass :: csvActionClass -> DBCsvActionMode
+  , dbtCsvExecuteActions :: Sink csvAction (YesodDB UniWorX) route
+  , dbtCsvRenderKey :: Map k' r' -> csvAction -> Widget
+  , dbtCsvRenderActionClass :: csvActionClass -> Widget
+  , dbtCsvRenderException :: csvException -> YesodDB UniWorX Text
+  }
 
 data DBTable m x = forall a r r' h i t k k' csv.
   ( ToSortable h, Functor h
@@ -460,7 +526,7 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtStyle :: DBStyle
   , dbtParams :: DBParams m x
   , dbtCsvEncode :: DBTCsvEncode r' csv
-  , dbtCsvDecode :: DBTCsvDecode csv
+  , dbtCsvDecode :: Maybe (DBTCsvDecode r' k' csv)
   , dbtIdent :: i
   }
 
@@ -756,9 +822,6 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
   ((csvExportRes, csvExportWdgt), csvExportEnctype) <- lift . runFormGet . identifyForm FIDDBTableCsvExport . set (mapped . mapped . _1 . mapped) DBCsvExport $ buttonForm' [BtnCsvExport]
   ((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport
     <$> areq fileFieldMultiple (fslI MsgCsvFile) Nothing
-    <*> apopt checkBoxField (fslI MsgCsvModifyExisting) (Just True)
-    <*> apopt checkBoxField (fslI MsgCsvAddNew) (Just True)
-    <*> apopt checkBoxField (fslI MsgCsvDeleteMissing) (Just False)
 
   let
     csvMode = asum
@@ -826,13 +889,127 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
   formResult csvMode $ \case
     DBCsvExport
-      | Just (Dict, dbtCsvEncode') <- dbtCsvEncode
+      | Just (Dict, dbtCsvEncode') <- dbtCsvEncode -> do
-        -> do
+        setContentDisposition' . Just $ unpack dbtIdent <.> unpack extensionCsv
-          setContentDisposition' . Just $ unpack dbtIdent <.> unpack extensionCsv
+        sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList rows .| dbtCsvEncode'
-          sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList rows .| dbtCsvEncode'
+    DBCsvImport{..}
-    DBCsvImport{}
+      | Just (DBTCsvDecode{ dbtCsvClassifyAction = dbtCsvClassifyAction :: csvAction -> csvActionClass
-      | Just (Dict, _dbtCsvDecode) <- dbtCsvDecode
+                          , ..
-        -> error "dbCsvImport"
+                          } :: DBTCsvDecode r' k' csv) <- dbtCsvDecode -> do
+        let existing = Map.fromList $ zip currentKeys rows
+            sourceDiff :: Source (StateT (Map k' csv) (YesodDB UniWorX)) (DBCsvDiff r' csv k')
+            sourceDiff = do
+              let
+                toDiff :: csv -> StateT (Map k' csv) (YesodDB UniWorX) (DBCsvDiff r' csv k')
+                toDiff row = do
+                  rowKey <- lift $
+                    handle (throwM . (DBCsvException (toNamedRecord row) :: Text -> DBCsvException k') <=< dbtCsvRenderException) . runMaybeT $ dbtCsvRowKey row
+                  seenKeys <- State.get
+                  (<* modify (maybe id (flip Map.insert row) rowKey)) $ if
+                    | Just rowKey' <- rowKey
+                    , Just oldRow <- Map.lookup rowKey' seenKeys
+                      -> throwM $ DBCsvDuplicateKey rowKey' (toNamedRecord oldRow) (toNamedRecord row)
+                    | Just rowKey' <- rowKey
+                    , Just oldRow <- Map.lookup rowKey' existing
+                      -> return $ DBCsvDiffExisting rowKey' oldRow row
+                    | otherwise
+                      -> return $ DBCsvDiffNew rowKey row
+              mapM_ fileSourceCsv dbCsvFiles .| C.mapM toDiff
+              
+              seen <- State.get
+              forM_ (Map.toList existing) $ \(rowKey, oldRow) -> if
+                | Map.member rowKey seen -> return ()
+                | otherwise -> yield $ DBCsvDiffMissing rowKey oldRow
+
+            accActionMap :: Map csvActionClass (Set csvAction) -> csvAction -> Map csvActionClass (Set csvAction)
+            accActionMap acc csvAct = Map.insertWith Set.union (dbtCsvClassifyAction csvAct) (Set.singleton csvAct) acc
+
+            importCsv = do
+              let
+                dbtCsvComputeActions' :: Sink (DBCsvDiff r' csv k') (YesodDB UniWorX) (Map csvActionClass (Set csvAction))
+                dbtCsvComputeActions' = do
+                  let innerAct = awaitForever $ \x
+                        -> let doHandle
+                                 | Just inpCsv <- x ^? _dbCsvNew
+                                 = handle $ throwM . (DBCsvException (toNamedRecord inpCsv) :: Text -> DBCsvException k') <=< dbtCsvRenderException
+                                 | otherwise            
+                                 = id
+                            in yieldM . doHandle . runConduit $ dbtCsvComputeActions x .| C.fold accActionMap Map.empty
+                  innerAct .| C.foldMap id
+              actionMap <- flip evalStateT Map.empty . runConduit $ sourceDiff .| transPipe lift dbtCsvComputeActions'
+
+              when (Map.null actionMap) $ do
+                addMessageI Info MsgCsvImportUnnecessary
+                redirect $ tblLink id
+
+              liftHandlerT . (>>= sendResponse) $
+                siteLayoutMsg MsgCsvImportConfirmationHeading $ do
+                  setTitleI MsgCsvImportConfirmationHeading
+
+                  let
+                    precomputeIdents :: forall f m'. (Eq (Element f), MonoFoldable f, MonadHandler m') => f -> m' (Element f -> Text)
+                    precomputeIdents = foldM (\f act -> (\id' x -> bool (f x) id' $ act == x) <$> newIdent) (\_ -> error "No id precomputed") 
+                  actionClassIdent <- precomputeIdents $ Map.keys actionMap
+                  actionIdent <- precomputeIdents . Set.unions $ Map.elems actionMap
+
+                  let defaultChecked actClass = case dbtCsvCoarsenActionClass actClass of
+                        DBCsvActionMissing -> False
+                        _other             -> True
+                      csvActionCheckBox :: [(Text, Text)] -> csvAction -> Widget
+                      csvActionCheckBox vAttrs act = do
+                        let
+                          sJsonField :: Field (HandlerT UniWorX IO) csvAction
+                          sJsonField = secretJsonField' $ \theId name attrs val _isReq ->
+                            [whamlet|
+                              $newline never
+                              <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) <- liftHandlerT . generateFormPost . identifyForm FIDDBTableCsvImportConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation"))
+                  let csvImportConfirmForm = wrapForm' BtnCsvImportConfirm csvImportConfirmForm' FormSettings
+                        { formMethod = POST
+                        , formAction = Just $ tblLink id
+                        , formEncoding = csvImportConfirmEnctype
+                        , formAttrs = []
+                        , formSubmit = FormSubmit
+                        , formAnchor = Nothing :: Maybe Text
+                        }
+                      
+                  $(widgetFile "csv-import-confirmation-wrapper")
+
+        let defaultHeaderOrder = headerOrder (error "not to be forced" :: csv)
+        catches importCsv
+          [ Catch.Handler $ \case
+              (DBCsvDuplicateKey{..} :: DBCsvException k')
+                -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
+                     mr <- getMessageRender
+
+                     let offendingCsv = CsvRendered defaultHeaderOrder [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ]
+                         heading = ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvDuplicateKey]
+
+                     siteLayoutMsg heading $ do
+                       setTitleI heading
+                       [whamlet|
+                         <p>_{MsgDBCsvDuplicateKey}
+                         <p>_{MsgDBCsvDuplicateKeyTip}
+                         ^{offendingCsv}
+                       |]
+              (DBCsvException{..} :: DBCsvException k')
+                -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
+                     mr <- getMessageRender
+
+                     let offendingCsv = CsvRendered defaultHeaderOrder [ dbCsvExceptionRow ]
+                         heading = ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvException]
+
+                     siteLayoutMsg heading $ do
+                       setTitleI heading
+                       [whamlet|
+                         <p>_{MsgDBCsvException}
+                         $if not (Text.null dbCsvException)
+                           <p>#{dbCsvException}
+                         ^{ offendingCsv}
+                       |]
+          ]
     _other      -> return ()
 
   let
@@ -889,7 +1066,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
     csvWdgt = $(widgetFile "table/csv-transcode")
 
-    uiLayout table = dbsFilterLayout filterWdgt filterEnc (SomeRoute $ rawAction :#: wIdent "table-wrapper") $(widgetFile "table/layout")
+    uiLayout table = csvWdgt <> dbsFilterLayout filterWdgt filterEnc (SomeRoute $ rawAction :#: wIdent "table-wrapper") $(widgetFile "table/layout")
 
     dbInvalidateResult' = foldr (<=<) return . catMaybes $
       [ do
@@ -898,6 +1075,22 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
           return . dbInvalidateResult dbtParams . DBTIRowsMissing $ length previousKeys - length currentKeys
       ]
 
+  ((csvImportConfirmRes, ()), _enctype) <- case dbtCsvDecode of
+    Just (DBTCsvDecode{dbtCsvExecuteActions} :: DBTCsvDecode r' k' csv) -> do
+      lift . runFormPost . identifyForm FIDDBTableCsvImportConfirm $ \_csrf -> do
+        acts <- globalPostParamFields PostDBCsvImportAction secretJsonField
+        return . (, ()) $ if
+          | null acts -> FormSuccess $ do
+              addMessageI Info MsgCsvImportAborted
+              redirect $ tblLink id
+          | otherwise -> FormSuccess $ do
+              finalDest <- runConduit $ C.sourceList acts .| dbtCsvExecuteActions
+              addMessageI Success . MsgCsvImportSuccessful $ length acts
+              E.transactionSave
+              redirect finalDest
+    _other -> return ((FormMissing, ()), mempty)
+  formResult csvImportConfirmRes id
+
   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
     tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html

src/Utils/Form.hs

@@ -199,6 +199,7 @@ data FormIdentifier
   | FIDDBTable
   | FIDDBTableCsvExport
   | FIDDBTableCsvImport
+  | FIDDBTableCsvImportConfirm
   | FIDDelete
   | FIDCourseRegister
   | FIDuserRights
@@ -567,7 +568,26 @@ data SecretJSONFieldException = SecretJSONFieldDecryptFailure
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Exception SecretJSONFieldException
 
-secretJsonField :: ( ToJSON a, FromJSON a
+secretJsonField' :: ( ToJSON a, FromJSON a
+                    , MonadHandler m
+                    , MonadSecretBox (ExceptT EncodedSecretBoxException m)
+                    , MonadSecretBox (WidgetT (HandlerSite m) IO)
+                    , RenderMessage (HandlerSite m) FormMessage
+                    , RenderMessage (HandlerSite m) SecretJSONFieldException
+                    )
+                 => FieldViewFunc m Text -> Field m a
+secretJsonField' fieldView' = Field{..}
+  where
+    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
+    fieldParse [] [] = return $ Right Nothing
+    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
+    fieldView theId name attrs val isReq = do
+      val' <- traverse (encodedSecretBox SecretBoxShort) val
+      fieldView' theId name attrs val' isReq
+    fieldEnctype = UrlEncoded
+
+secretJsonField :: forall m a.
+                   ( ToJSON a, FromJSON a
                    , MonadHandler m
                    , MonadSecretBox (ExceptT EncodedSecretBoxException m)
                    , MonadSecretBox (WidgetT (HandlerSite m) IO)
@@ -575,17 +595,7 @@ secretJsonField :: ( ToJSON a, FromJSON a
                    , RenderMessage (HandlerSite m) SecretJSONFieldException
                    )
                 => Field m a
-secretJsonField = Field{..}
+secretJsonField = secretJsonField' $ fieldView (hiddenField :: Field m Text)
-  where
-    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
-    fieldParse [] [] = return $ Right Nothing
-    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
-    fieldView theId name attrs val _isReq = do
-      val' <- traverse (encodedSecretBox SecretBoxShort) val
-      [whamlet|
-        <input id=#{theId} name=#{name} *{attrs} type=hidden value=#{either id id val'}>
-      |]
-    fieldEnctype = UrlEncoded
 
 htmlFieldSmall :: forall m. (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m Html
 htmlFieldSmall = checkMMap sanitize (pack . renderHtml) textField

src/Utils/Parameters.hs

@@ -6,7 +6,7 @@ module Utils.Parameters
   , GlobalPostParam(..)
   , lookupGlobalPostParam, hasGlobalPostParam, lookupGlobalPostParams
   , lookupGlobalPostParamForm, hasGlobalPostParamForm
-  , globalPostParamField
+  , globalPostParamField, globalPostParamFields
   ) where
 
 import ClassyPrelude.Yesod
@@ -55,6 +55,7 @@ data GlobalPostParam = PostFormIdentifier
                      | PostDeleteTarget
                      | PostMassInputShape
                      | PostBearer
+                     | PostDBCsvImportAction
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 instance Universe GlobalPostParam
@@ -84,3 +85,9 @@ globalPostParamField ident Field{fieldParse} = runMaybeT $ do
   ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
   fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
   MaybeT $ either (const Nothing) id <$> lift (fieldParse ts fs)
+
+globalPostParamFields :: Monad m => GlobalPostParam -> Field m a -> MForm m [a]
+globalPostParamFields ident Field{fieldParse} = fmap (fromMaybe []) . runMaybeT $ do
+  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)

templates/csv-import-confirmation-wrapper.hamlet

@@ -0,0 +1,4 @@
+<section>
+  <p>_{MsgCsvImportConfirmationTip}
+<section>
+  ^{csvImportConfirmForm}

templates/csv-import-confirmation.hamlet

@@ -0,0 +1,21 @@
+$newline never
+#{csrf}
+<div .actions>
+  $forall actionClass <- sortOn dbtCsvCoarsenActionClass (Map.keys actionMap)
+    <div .action>
+      <input type=checkbox id=#{actionClassIdent actionClass} .action__checkbox :defaultChecked actionClass:checked>
+      <label .action__label for=#{actionClassIdent actionClass}>
+        ^{dbtCsvRenderActionClass actionClass}
+
+      <fieldset .action__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{actionClassIdent actionClass}>
+        <div .action__checked-counter>
+        <div .action__toggle-all>
+          <input type=checkbox id=#{actionClassIdent actionClass}-toggle-all>
+          <label for=#{actionClassIdent actionClass}-toggle-all .action__option-label>
+            _{MsgDBCsvImportActionToggleAll}
+        <div .action__options>
+          $forall action <- Set.toList (actionMap ! actionClass)
+            <div .action__option>
+              ^{csvActionCheckBox [] action}
+              <label .action__option-label for=#{actionIdent action}>
+                ^{dbtCsvRenderKey existing action}

templates/csv-import-confirmation.julius

@@ -0,0 +1,81 @@
+(function() {
+
+  var IMPORT_ACTIONS_SELECTOR = '.actions';
+  var IMPORT_ACTION_SELECTOR = '.action';
+  var IMPORT_ACTION_CHECKBOX_SELECTOR = '.action__checkbox ';
+  var IMPORT_ACTION_OPTIONS_SELECTOR = '.action__options';
+  var IMPORT_ACTION_TOGGLE_ALL_SELECTOR = '.action__toggle-all [type="checkbox"]';
+  var IMPORT_ACTION_CHECKED_COUNTER_SELECTOR = '.action__checked-counter';
+
+  var importActionsElement;
+
+  document.addEventListener('DOMContentLoaded', function() {
+    importActionsElement = document.querySelector(IMPORT_ACTIONS_SELECTOR);
+
+    setupActions();
+  });
+
+  function setupActions() {
+    var actionElements = Array.from(importActionsElement.querySelectorAll(IMPORT_ACTION_SELECTOR));
+
+    actionElements.forEach(function(element) {
+      setupAction(element);
+    });
+  }
+
+  function setupAction(actionElement) {
+    var actionCheckbox = actionElement.querySelector(IMPORT_ACTION_CHECKBOX_SELECTOR);
+    var actionOptions = actionElement.querySelector(IMPORT_ACTION_OPTIONS_SELECTOR);
+    if (actionOptions) {
+      var actionCheckboxes = Array.from(actionOptions.querySelectorAll('[type="checkbox"]'));
+      var toggleAllCheckbox = actionElement.querySelector(IMPORT_ACTION_TOGGLE_ALL_SELECTOR);
+
+      // setup action checkbox to toggle all child checkboxes if changed
+      actionCheckbox.addEventListener('change', function() {
+        actionCheckboxes.forEach(function(checkbox) {
+          checkbox.checked = actionCheckbox.checked;
+        });
+        updateCheckedCounter(actionElement, actionCheckboxes);
+        updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes);
+      });
+
+      // update counter and toggle checkbox initially
+      updateCheckedCounter(actionElement, actionCheckboxes);
+      updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes);
+
+      // register change listener for individual checkboxes
+      actionCheckboxes.forEach(function(checkbox) {
+        checkbox.addEventListener('change', function() {
+          updateCheckedCounter(actionElement, actionCheckboxes);
+          updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes);
+        });
+      });
+
+      // register change listener for toggle all checkbox
+      if (toggleAllCheckbox) {
+        toggleAllCheckbox.addEventListener('change', function() {
+          actionCheckboxes.forEach(function(checkbox) {
+            checkbox.checked = toggleAllCheckbox.checked;
+          });
+          updateCheckedCounter(actionElement, actionCheckboxes);
+        });
+      }
+    }
+  }
+
+  // update checked state of toggle all checkbox based on all other checkboxes
+  function updateToggleAllCheckbox(toggleAllCheckbox, actionCheckboxes) {
+    var allChecked = actionCheckboxes.reduce(function(acc, checkbox) {
+      return acc && checkbox.checked;
+    }, true);
+    toggleAllCheckbox.checked = allChecked;
+  }
+
+  // update value of checked counter
+  function updateCheckedCounter(actionElement, actionCheckboxes) {
+    var checkedCounter = actionElement.querySelector(IMPORT_ACTION_CHECKED_COUNTER_SELECTOR);
+    var checkedCheckboxes = actionCheckboxes.reduce(function(acc, checkbox) { return checkbox.checked ? acc + 1 : acc; }, 0);
+    checkedCounter.innerHTML = checkedCheckboxes + '/' + actionCheckboxes.length;
+  }
+
+})();

templates/csv-import-confirmation.lucius

@@ -0,0 +1,52 @@
+.action {
+  max-width: 800px;
+  padding: 3px 0;
+
+  &:not(:last-child) {
+    margin-bottom: 7px;
+  }
+
+  &:not(:first-child) {
+    margin-top: 7px;
+  }
+}
+
+.action__options {
+  max-height: 450px;
+  overflow-y: auto;
+}
+
+.action__option {
+  display: flex;
+
+  &:not(:last-child) {
+    margin-bottom: 10px;
+  }
+}
+
+.action__label,
+.action__option-label {
+  margin-left: 15px;
+  vertical-align: top;
+}
+
+.action__fieldset {
+  margin: 7px 0 5px 9px;
+  padding: 5px 0 10px;
+  border-left: 1px solid #bcbcbc;
+  padding-left: 16px;
+  position: relative;
+}
+
+.action__toggle-all {
+  display: flex;
+  border-bottom: 1px solid #bcbcbc;
+  padding-bottom: 8px;
+  margin-bottom: 8px;
+}
+
+.action__checked-counter {
+  position: absolute;
+  right: 5px;
+  top: 5px;
+}

templates/default-layout.lucius

@@ -331,22 +331,6 @@ input[type="button"].btn-info:hover,
   box-shadow: 0 0 1px 1px var(--color-grey-light);
 }
 
-.csv-export, .csv-import {
-  box-shadow: 0 0 1px 1px var(--color-grey);
-
-  * {
-    margin-right: 10px;
-  }
-
-  *:last-child {
-    margin-right: 0;
-
-    &.modal__trigger {
-      margin-right: 10px;
-    }
-  }
-}
-
 @media (max-width: 425px) {
 
   .scrolltable {

templates/exam-show.hamlet

@@ -89,7 +89,10 @@ $maybe desc <- examDescription
 $if not (null occurrences)
   <section>
     <h2>
-      _{MsgExamOccurrences}
+      $if examTimes
+        _{MsgExamOccurrences}
+      $else
+        _{MsgExamRooms}
     <table .table .table--striped .table--hover>
       <thead>
         <tr .table__row .table__row--head>

templates/i18n/changelog/de.hamlet

@@ -1,5 +1,10 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>23.07.2019
+  <dd .deflist__dd>
+    <ul>
+      <li>Import & Export von CSV-Dateien für Klausurteilnehmer
+
   <dt .deflist__dt>26.06.2019
   <dd .deflist__dd> 
     <ul>

templates/table/csv-transcode.hamlet

@@ -1,8 +1,14 @@
 $newline never
 $if is _Just dbtCsvDecode
   <div .csv-import>
-    ^{csvImportWdgt'}
+    <h3 .csv-import__toggle uw-show-hide data-show-hide-id=table-csv-import data-show-hide-collapsed>
+      _{MsgTableHeadingCsvImport}
+    <div .csv-import__content>
+      ^{csvImportWdgt'}
 $if is _Just dbtCsvEncode
   <div .csv-export>
-    ^{csvExportWdgt'}
+    <h3 .csv-import__toggle uw-show-hide data-show-hide-id=table-csv-export>
-    ^{csvColExplanations'}
+      _{MsgTableHeadingCsvExport}
+    <div .csv-export__content>
+      ^{csvExportWdgt'}
+      ^{csvColExplanations'}

templates/table/csv-transcode.lucius

@@ -0,0 +1,21 @@
+.csv-export {
+  margin-bottom: 13px;
+    
+  .csv-export__content {
+    display: flex;
+    align-content: space-between;
+    align-items: center;
+
+    & > * {
+      margin-right: 10px;
+
+      &:last-child {
+        margin-right: 0;
+      }
+    }
+  }
+}
+
+.csv-import {
+  margin-bottom: 13px;
+}

templates/table/layout-filter-default.hamlet

@@ -1,6 +1,7 @@
 $newline never
 <div .table-filter>
-  <h3 .table-filter__toggle uw-show-hide data-show-hide-id=table-filter data-show-hide-collapsed>Filter
+  <h3 .table-filter__toggle uw-show-hide data-show-hide-id=table-filter data-show-hide-collapsed>
+    _{MsgTableHeadingFilter}
   <div>
     ^{filterForm}
 ^{scrolltable}

templates/table/layout.hamlet

@@ -5,7 +5,6 @@ $else
   <div .table-header>
     <div .table__row-count>
       _{MsgRowCount rowCount}
-    ^{csvWdgt}
 
   ^{table}
 

templates/widgets/aform/aform.hamlet

@@ -3,8 +3,9 @@ $newline never
 $case formLayout
   $of FormDBTablePagesize
     $forall view <- fieldViews
-      <label .form-group-label.label-pagesize for=#{fvId view}>#{fvLabel view}
+      <div>
-      ^{fvInput view}
+        <label .form-group-label.label-pagesize for=#{fvId view}>#{fvLabel view}
+        ^{fvInput view}
   $of _
     $forall view <- fieldViews
       $if fvId view == idFormSectionNoinput
@@ -23,6 +24,6 @@ $case formLayout
             $maybe err <- fvErrors view
               <div .form-error>#{err}
     $if formHasRequiredFields
-      <div .form-section-title>
+      <div .form-section-legend>
         <span .form-group__required-marker>
         _{MsgAFormFieldRequiredTip}

templates/widgets/csvRendered.hamlet

@@ -0,0 +1,14 @@
+$newline never
+<table .table .table--striped .table--hover>
+  <thead>
+    <tr .table__row .table__row--head>
+      $forall header <- headers
+        <th .table__th .table__th--csv>
+          #{header}
+  <tbody>
+    $forall row <- csvData
+      <tr .table__row>
+        $forall cell <- row
+          <td .table__td .table__td--csv>
+            $maybe cellText <- cell
+              #{cellText}

templates/widgets/csvRendered.lucius

@@ -0,0 +1,3 @@
+.table__td--csv, .table__th--csv {
+  font-family: monospace;
+}