feat(csv): add column explanations

BREAKING CHANGE: CsvColumnsExplained now required

frontend/src/utils/modal/modal.scss

@@ -83,6 +83,10 @@
   cursor: pointer;
 }
 
+div.modal__trigger {
+  display: inline-block;
+}
+
 .modal__trigger-label {
   font-style: italic;
   text-decoration: underline;

messages/uniworx/de.msg

@@ -1194,4 +1194,18 @@ CsvDeleteMissing: Fehlende Einträge entfernen
 BtnCsvExport: CSV-Datei exportieren
 BtnCsvImport: CSV-Datei importieren
 
-Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
+Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
+
+CsvColumnsExplanationsLabel: Spalten
+CsvColumnsExplanationsTip: Bedeutung der in der CSV-Datei enthaltenen Spalten
+CsvColumnExamUserSurname: Nachname des Teilnehmers
+CsvColumnExamUserName: Voller Name des Teilnehmers (inkl. Nachname)
+CsvColumnExamUserMatriculation: Matrikelnummer des Teilnehmers
+CsvColumnExamUserField: Hauptfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
+CsvColumnExamUserDegree: Abschluss, den der Teilnehmer im assoziierten Hauptfach anstrebt
+CsvColumnExamUserSemester: Fachsemester des Teilnehmers im assoziierten Hauptfach
+CsvColumnExamUserOccurrence: Prüfungstermin/-Raum, zu dem der Teilnehmer angemeldet ist
+CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb erreicht hat
+CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Klausurtermin erreichen hätte können
+CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat
+CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können

src/Handler/Exam.hs

@@ -832,9 +832,9 @@ data ExamUserTableCsv = ExamUserTableCsv
   , csvEUserDegree :: Maybe Text
   , csvEUserSemester :: Maybe Int
   , csvEUserOccurrence :: Maybe (CI Text)
-  , csvEUserExercisePoints, csvEUserExercisePassPoints :: Maybe Points
+  , csvEUserExercisePoints :: Maybe Points
   , csvEUserExercisePasses :: Maybe Int
-  , csvEUserExercisePointsMax, csvEUserExercisePassPointsMax :: Maybe Points
+  , csvEUserExercisePointsMax :: Maybe Points
   , csvEUserExercisePassesMax :: Maybe Int
   }
   deriving (Generic)
@@ -851,6 +851,21 @@ instance FromNamedRecord ExamUserTableCsv where
 instance DefaultOrdered ExamUserTableCsv where
   headerOrder = Csv.genericHeaderOrder examUserTableCsvOptions
 
+instance CsvColumnsExplained ExamUserTableCsv where
+  csvColumnsExplanations = genericCsvColumnsExplanations examUserTableCsvOptions $ Map.fromList
+    [ ('csvEUserSurname          , MsgCsvColumnExamUserSurname           )
+    , ('csvEUserName             , MsgCsvColumnExamUserName              )
+    , ('csvEUserMatriculation    , MsgCsvColumnExamUserMatriculation     )
+    , ('csvEUserField            , MsgCsvColumnExamUserField             )
+    , ('csvEUserDegree           , MsgCsvColumnExamUserDegree            )
+    , ('csvEUserSemester         , MsgCsvColumnExamUserSemester          )
+    , ('csvEUserOccurrence       , MsgCsvColumnExamUserOccurrence        )
+    , ('csvEUserExercisePoints   , MsgCsvColumnExamUserExercisePoints    ) 
+    , ('csvEUserExercisePasses   , MsgCsvColumnExamUserExercisePasses    ) 
+    , ('csvEUserExercisePointsMax, MsgCsvColumnExamUserExercisePointsMax ) 
+    , ('csvEUserExercisePassesMax, MsgCsvColumnExamUserExercisePassesMax ) 
+    ]
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -861,8 +876,7 @@ postEUsersR tid ssh csh examn = do
     let
       allBoni = (mappend <$> normalSummary <*> bonusSummary) $ fold bonus
       showPasses     = numSheetsPasses allBoni /= 0
-      showPoints     = getSum (numSheetsPoints allBoni) - getSum (numSheetsPassPoints allBoni) /= 0
-      showPassPoints = numSheetsPassPoints allBoni /= 0
+      showPoints     = getSum (numSheetsPoints allBoni) /= 0
 
     let
       examUsersDBTable = DBTable{..}
@@ -891,14 +905,10 @@ postEUsersR tid ssh csh examn = do
                 SheetGradeSummary{achievedPasses} <- examBonusAchieved uid bonus
                 SheetGradeSummary{numSheetsPasses} <- examBonusPossible uid bonus
                 return $ propCell (getSum achievedPasses) (getSum numSheetsPasses)
-            , guardOn showPassPoints $ sortable Nothing (i18nCell MsgAchievedPassPoints) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
-                SheetGradeSummary{achievedPassPoints} <- examBonusAchieved uid bonus
-                SheetGradeSummary{sumSheetsPassPoints} <- examBonusPossible uid bonus
-                return $ propCell (getSum achievedPassPoints) (getSum sumSheetsPassPoints)
             , guardOn showPoints $ sortable Nothing (i18nCell MsgAchievedPoints) $ \(view $ resultUser . _entityKey -> uid) -> fromMaybe mempty $ do
-                SheetGradeSummary{achievedPoints, achievedPassPoints} <- examBonusAchieved uid bonus
-                SheetGradeSummary{sumSheetsPoints, sumSheetsPassPoints} <- examBonusPossible uid bonus
-                return $ propCell (getSum achievedPoints - getSum achievedPassPoints) (getSum sumSheetsPoints - getSum sumSheetsPassPoints)
+                SheetGradeSummary{achievedPoints} <- examBonusAchieved uid bonus
+                SheetGradeSummary{sumSheetsPoints} <- examBonusPossible uid bonus
+                return $ propCell (getSum achievedPoints) (getSum sumSheetsPoints)
             ] 
           dbtSorting = Map.fromList
             [ sortUserNameLink     queryUser
@@ -940,10 +950,8 @@ postEUsersR tid ssh csh examn = do
             <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
             <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
             <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPoints . _Wrapped)
-            <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPassPoints . _Wrapped)
             <*> 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 . _sumSheetsPassPoints . _Wrapped)
             <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
           dbtCsvDecode = Nothing
 

src/Handler/Utils/Table/Pagination.hs

@@ -6,6 +6,7 @@ module Handler.Utils.Table.Pagination
   , FilterColumn(..), IsFilterColumn
   , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount
   , DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..)
+  , module Handler.Utils.Table.Pagination.CsvColumnExplanations
   , DBTCsvEncode, DBTCsvDecode
   , DBTable(..), noCsvEncode, IsDBTable(..), DBCell(..)
   , singletonFilter
@@ -34,6 +35,7 @@ module Handler.Utils.Table.Pagination
   ) where
 
 import Handler.Utils.Table.Pagination.Types
+import Handler.Utils.Table.Pagination.CsvColumnExplanations
 import Handler.Utils.Form
 import Handler.Utils.Csv
 import Handler.Utils.ContentDisposition
@@ -439,7 +441,7 @@ instance PathPiece x => PathPiece (WithIdent x) where
     WithIdent <$> pure ident <*> fromPathPiece rest
 
 
-type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv) (Conduit r' (YesodDB UniWorX) csv)
+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 DBTable m x = forall a r r' h i t k k' csv.
@@ -462,7 +464,7 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtIdent :: i
   }
 
-noCsvEncode :: DictMaybe (ToNamedRecord Void, DefaultOrdered Void) (Conduit r' (YesodDB UniWorX) Void)
+noCsvEncode :: DictMaybe (ToNamedRecord Void, DefaultOrdered Void, CsvColumnsExplained Void) (Conduit r' (YesodDB UniWorX) Void)
 noCsvEncode = Nothing
 
 class (MonadHandler m, HandlerSite m ~ UniWorX, Monoid' x, Monoid' (DBCell m x), Default (DBParams m x)) => IsDBTable (m :: * -> *) (x :: *) where
@@ -768,7 +770,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       { formMethod = GET
       , formAction = Just $ tblLink id
       , formEncoding = csvExportEnctype
-      , formAttrs = [("target", "_blank")]
+      , formAttrs = [("target", "_blank"), ("class", "form--inline")]
       , formSubmit = FormNoSubmit
       , formAnchor = Nothing :: Maybe Text
       }
@@ -780,6 +782,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , formSubmit = FormSubmit
       , formAnchor = Nothing :: Maybe Text
       }
+    csvColExplanations = case dbtCsvEncode of
+      (Just (Dict, _) :: DBTCsvEncode _ csv) -> assertM' (not . null) . Map.toList . csvColumnsExplanations $ Proxy @csv
+      Nothing -> Nothing
+    csvColExplanations' = case csvColExplanations of
+      Just csvColExplanations'' -> modal [whamlet|_{MsgCsvColumnsExplanationsLabel}|] $ Right $(widgetFile "table/csv-column-explanations")
+      Nothing -> mempty
 
 
   rows' <- E.select . E.from $ \t -> do

src/Handler/Utils/Table/Pagination/CsvColumnExplanations.hs

@@ -0,0 +1,70 @@
+module Handler.Utils.Table.Pagination.CsvColumnExplanations
+  ( CsvColumnsExplained(..)
+  , genericCsvColumnsExplanations
+  ) where
+
+import Import
+
+import qualified Data.Csv as Csv
+import GHC.Generics
+import qualified GHC.Generics as Generics
+
+import Language.Haskell.TH
+-- import Language.Haskell.TH.Datatype
+-- import Language.Haskell.TH.Lib
+
+import qualified Data.Map as Map
+import qualified Data.ByteString.Char8 as B8
+
+
+class CsvColumnsExplained csv where
+  csvColumnsExplanations :: forall p. p csv -> Map Csv.Name Widget
+  csvColumnsExplanations _ = Map.empty
+
+genericCsvColumnsExplanations :: forall msg p csv.
+                                 ( Generic csv
+                                 , GCsvColumnsExplained (Rep csv)
+                                 , RenderMessage UniWorX msg
+                                 )
+                              => Csv.Options
+                              -> Map Name msg
+                              -> p csv
+                              -> Map Csv.Name Widget
+genericCsvColumnsExplanations opts msgMap' _ = Map.mapMaybe (fmap (toWidget <=< ap getMessageRender . pure) . flip Map.lookup msgMap) headerNames
+  where
+    msgMap :: Map String msg
+    msgMap = Map.mapKeys nameBase msgMap'
+    headerNames :: Map Csv.Name String
+    headerNames = gCsvColumnsExplanations opts $ Generics.from (error "proxy" :: csv)
+
+class GCsvColumnsExplained a where
+  gCsvColumnsExplanations :: Csv.Options -> a p -> Map Csv.Name String
+
+instance GCsvColumnsExplained U1 where
+  gCsvColumnsExplanations _ _ = Map.empty
+
+instance (GCsvColumnsExplained a, GCsvColumnsExplained b) => GCsvColumnsExplained (a :*: b) where
+  gCsvColumnsExplanations opts _ = Map.unionWithKey (\h f1 f2 -> error $ "Column header ‘" ++ B8.unpack h ++ "’ is produced by both ‘" ++ f1 ++ "’ and ‘" ++ f2 ++ "’")
+    (gCsvColumnsExplanations opts (error "proxy" :: a p))
+    (gCsvColumnsExplanations opts (error "proxy" :: b p))
+    
+
+instance GCsvColumnsExplained a => GCsvColumnsExplained (M1 D c a) where
+  gCsvColumnsExplanations opts _ = gCsvColumnsExplanations opts (error "proxy" :: a p)
+
+instance GCsvColumnsExplained a => GCsvColumnsExplained (M1 C c a) where
+  gCsvColumnsExplanations opts _ = gCsvColumnsExplanations opts (error "proxy" :: a p)
+
+-- | Instance to ensure that you cannot derive DefaultOrdered for
+-- constructors without selectors.
+instance CsvColumnsExplained (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a ())
+      => GCsvColumnsExplained (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a)
+   where
+     gCsvColumnsExplanations _ _ =
+        error "You cannot derive CsvColumnsExplanations for constructors without selectors."
+
+instance Selector s => GCsvColumnsExplained (M1 S s a) where
+  gCsvColumnsExplanations (Csv.fieldLabelModifier -> f) m
+    | null name = error "Cannot derive CsvColumnsExplanations for constructors without selectors"
+    | otherwise = Map.singleton (B8.pack $ f name) name
+    where name = selName m

templates/default-layout.lucius

@@ -329,7 +329,22 @@ input[type="button"].btn-info:hover,
 .scrolltable {
   overflow: auto;
   box-shadow: 0 0 1px 1px var(--color-grey-light);
-  margin-bottom: 15px;
+}
+
+.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) {
@@ -642,3 +657,8 @@ section {
 .uuid {
   font-family: monospace;
 }
+
+
+.form--inline {
+  display: inline-block;
+}

templates/table/csv-column-explanations.hamlet

@@ -0,0 +1,7 @@
+<h3>_{MsgCsvColumnsExplanationsTip}
+<dl .deflist>
+  $forall (colName, colExplanation) <- csvColExplanations''
+    <dt .deflist__dt>#{decodeUtf8 colName}
+    <dd .deflist__dd>^{colExplanation}
+<div>
+  ^{csvExportWdgt'}

templates/table/csv-transcode.hamlet

@@ -5,3 +5,4 @@ $if is _Just dbtCsvDecode
 $if is _Just dbtCsvEncode
   <div .csv-export>
     ^{csvExportWdgt'}
+    ^{csvColExplanations'}

templates/table/layout.lucius

@@ -3,6 +3,7 @@
   display: flex;
   flex-flow: row-reverse;
   justify-content: space-between;
+  margin-bottom: 15px;
 }
 
 /* TABLE FOOTER */
@@ -10,6 +11,7 @@
   display: flex;
   flex-flow: row-reverse;
   justify-content: space-between;
+  margin-top: 15px;
 }
 
 /* PAGINATION */

templates/widgets/modal/modal.hamlet

@@ -1,5 +1,5 @@
 $newline never
-<div uw-modal data-modal-trigger=#{triggerId'} data-modal-closeable>
+<div .modal uw-modal data-modal-trigger=#{triggerId'} data-modal-closeable>
   $case modalContent
     $of Right content
       <div .modal__content>