feat(csv): implement csv import

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

@@ -933,6 +933,8 @@ CommTutorialHeading: Tutorium-Mitteilung
 RecipientCustom: Weitere Empfänger
 RecipientToggleAll: Alle/Keine
 
+DBCsvImportActionToggleAll: Alle/Keine
+
 RGCourseParticipants: Kursteilnehmer
 RGCourseLecturers: Kursverwalter
 RGCourseCorrectors: Korrektoren
@@ -1200,6 +1202,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 +1228,14 @@ 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 ein der unten aufgeführten Zeilen aus Ihren CSV-Dateien und versuchen Sie es erneut.
+
+ExamUserCsvRegister: Teilnehmer zur Klausur anmelden
+ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen
+ExamUserCsvDeregister: Teilnehmer von der Klausur abmelden
+
+TableHeadingFilter: Filter
+TableHeadingCsvImport: CSV-Import
+TableHeadingCsvExport: CSV-Export

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)
@@ -883,6 +886,31 @@ embedRenderMessage ''UniWorX ''ExamUserAction id
 data ExamUserActionData = ExamUserDeregisterData
                         | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
 
+data ExamUserCsvActionClass
+  = ExamUserCsvRegister
+  | ExamUserCsvAssignOccurrence
+  | ExamUserCsvDeregister
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id
+
+data ExamUserCsvAction
+  = ExamUserCsvRegisterData
+    { examUserCsvUser :: UserId
+    }
+  | ExamUserCsvAssignOccurrenceData
+    { examUserCsvRegistration :: ExamRegistrationId
+    , examUserCsvOccurrence :: ExamOccurrenceId
+    }
+  | ExamUserCsvDeregisterData
+    { examUserCsvRegistration :: 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
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -994,7 +1022,31 @@ 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 = \ExamUserTableCsv{} -> mzero -- FIXME: guess user from csv row and do lookup via UniqueExamRegistration
+            , dbtCsvComputeActions = awaitForever $ \case
+                DBCsvDiffMissing{dbCsvOldKey} -> yield . ExamUserCsvDeregisterData $ E.unValue dbCsvOldKey
+                _other -> return () -- FIXME: compute edit on existing rows & add rows
+            , dbtCsvClassifyAction = \case
+                ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
+                ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
+                ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
+            , dbtCsvCoarsenActionClass = \case
+                ExamUserCsvRegister   -> DBCsvActionNew
+                ExamUserCsvDeregister -> DBCsvActionMissing
+                _other                -> DBCsvActionExisting 
+            , dbtCsvExecuteActions = do
+                C.mapM_ $ \case
+                  ExamUserCsvDeregisterData{..} -> delete examUserCsvRegistration
+                  _other -> return () -- FIXME
+                return $ CExamR tid ssh csh examn EUsersR
+            , dbtCsvRenderKey = \existing -> \case
+                ExamUserCsvDeregisterData{..}
+                  -> let Entity _ User{..} = view resultUser $ existing ! E.Value examUserCsvRegistration
+                      in nameWidget userDisplayName userSurname
+                _other -> mempty -- FIXME
+            , dbtCsvRenderActionClass = \c -> [whamlet|_{c}|]
+            }
 
       examUsersDBTableValidator = def
 

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,29 @@ 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 qualified Data.Csv as Csv (encodeByName)
+
 import Colonnade hiding (bool, fromMaybe, singleton)
 import qualified Colonnade (singleton)
-import Colonnade.Encode
+import Colonnade.Encode hiding (row)
 
 import Text.Hamlet (hamletFile)
 
@@ -97,6 +105,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 +282,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 +309,45 @@ instance Button UniWorX ButtonCsvMode where
         #{iconCSV}
         \ _{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
+    }
+  deriving (Show, Typeable)
+
+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 +485,23 @@ 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.
+  ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
+  , DBTableKey k'
+  , RedirectUrl UniWorX route
+  , Typeable csv
+  , Ord csvAction, FromJSON csvAction, ToJSON csvAction
+  , Ord csvActionClass
+  ) => DBTCsvDecode
+  { dbtCsvRowKey :: csv -> MaybeT (YesodDB UniWorX) k'
+  , dbtCsvComputeActions :: Conduit (DBCsvDiff r' csv k') (YesodDB UniWorX) csvAction
+  , dbtCsvClassifyAction :: csvAction -> csvActionClass
+  , dbtCsvCoarsenActionClass :: csvActionClass -> DBCsvActionMode
+  , dbtCsvExecuteActions :: Sink csvAction (YesodDB UniWorX) route
+  , dbtCsvRenderKey :: Map k' r' -> csvAction -> Widget
+  , dbtCsvRenderActionClass :: csvActionClass -> Widget
+  }
 
 data DBTable m x = forall a r r' h i t k k' csv.
   ( ToSortable h, Functor h
@@ -460,7 +519,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 +815,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 +882,97 @@ 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 . 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
+              actionMap <- flip evalStateT Map.empty . runConduit $ sourceDiff .| transPipe lift dbtCsvComputeActions .| C.fold accActionMap Map.empty
+
+              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")
+        catches importCsv
+          [ Catch.Handler $ \case
+              (DBCsvDuplicateKey{..} :: DBCsvException k')
+                -> liftHandlerT $ sendResponseStatus badRequest400 =<< do
+                     let offendingCsv = decodeUtf8 $ Csv.encodeByName (headerOrder (error "not to be forced" :: csv)) [ dbCsvDuplicateKeyRowA, dbCsvDuplicateKeyRowB ]
+
+                     mr <- getMessageRender
+
+                     siteLayoutMsg (ErrorResponseTitle $ InvalidArgs [mr MsgDBCsvDuplicateKey]) $
+                       [whamlet|
+                         <p>_{MsgDBCsvDuplicateKey}
+                         <p>_{MsgDBCsvDuplicateKeyTip}
+                         <pre style="white-space: pre; font-family: monospace">
+                           #{offendingCsv}
+                       |]
+          ]
     _other      -> return ()
 
   let
@@ -889,7 +1029,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 +1038,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/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}