diff --git a/frontend/src/utils/modal/modal.scss b/frontend/src/utils/modal/modal.scss index 2cecac941..50054aaaf 100644 --- a/frontend/src/utils/modal/modal.scss +++ b/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; diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index eed2e6f17..2deccb636 100644 --- a/messages/uniworx/de.msg +++ b/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)}%) \ No newline at end of file +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 \ No newline at end of file diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs index 0d70440b0..b3ad24767 100644 --- a/src/Handler/Exam.hs +++ b/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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 272c9ffaa..4f6676899 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/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 diff --git a/src/Handler/Utils/Table/Pagination/CsvColumnExplanations.hs b/src/Handler/Utils/Table/Pagination/CsvColumnExplanations.hs new file mode 100644 index 000000000..460a9414b --- /dev/null +++ b/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 diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius index 57d417402..720407eff 100644 --- a/templates/default-layout.lucius +++ b/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; +} diff --git a/templates/table/csv-column-explanations.hamlet b/templates/table/csv-column-explanations.hamlet new file mode 100644 index 000000000..c39403fe7 --- /dev/null +++ b/templates/table/csv-column-explanations.hamlet @@ -0,0 +1,7 @@ +

_{MsgCsvColumnsExplanationsTip} +
+ $forall (colName, colExplanation) <- csvColExplanations'' +
#{decodeUtf8 colName} +
^{colExplanation} +
+ ^{csvExportWdgt'} diff --git a/templates/table/csv-transcode.hamlet b/templates/table/csv-transcode.hamlet index dd4576e25..10eedfc63 100644 --- a/templates/table/csv-transcode.hamlet +++ b/templates/table/csv-transcode.hamlet @@ -5,3 +5,4 @@ $if is _Just dbtCsvDecode $if is _Just dbtCsvEncode
^{csvExportWdgt'} + ^{csvColExplanations'} diff --git a/templates/table/layout.lucius b/templates/table/layout.lucius index 0c402442b..943edbc15 100644 --- a/templates/table/layout.lucius +++ b/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 */ diff --git a/templates/widgets/modal/modal.hamlet b/templates/widgets/modal/modal.hamlet index b801967f6..c24010078 100644 --- a/templates/widgets/modal/modal.hamlet +++ b/templates/widgets/modal/modal.hamlet @@ -1,5 +1,5 @@ $newline never -
+
$case modalContent $of Right content