From 3c4172cbc2abb8b692241cc7fe73b62384c92a94 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Aug 2019 14:10:09 +0200 Subject: [PATCH 01/15] fix(exam import): inactive registered features may be selected --- src/Handler/Exam/Users.hs | 31 ++++++++++++++++++------------- stack.yaml.lock | 12 ++++++------ 2 files changed, 24 insertions(+), 19 deletions(-) diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 35a8842a4..42ec778b0 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -16,18 +16,18 @@ import Handler.Utils.Csv import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH - + import qualified Data.Csv as Csv - + 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 qualified Data.Conduit.List as C - + import qualified Data.CaseInsensitive as CI import Numeric.Lens (integral) @@ -320,7 +320,7 @@ postEUsersR tid ssh csh examn = do criteria'' | ExamAttended (ExamPassed True) `Set.member` criteria = criteria' `Set.union` Set.fromList passed - | otherwise + | otherwise = criteria' in queryExamResult row E.?. ExamResultResult `E.in_` E.valList (Just <$> Set.toList criteria'') ) @@ -431,7 +431,7 @@ postEUsersR tid ssh csh examn = do ExamUserCsvCourseRegister -> DBCsvActionNew ExamUserCsvRegister -> DBCsvActionNew ExamUserCsvDeregister -> DBCsvActionMissing - _other -> DBCsvActionExisting + _other -> DBCsvActionExisting , dbtCsvExecuteActions = do C.mapM_ $ \case ExamUserCsvCourseRegisterData{..} -> do @@ -496,7 +496,7 @@ postEUsersR tid ssh csh examn = do ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Just note, .. } -> do now <- liftIO getCurrentTime uid <- liftHandlerT requireAuthId - Entity nid _ <- upsert (CourseUserNote examCourse examUserCsvActUser note) [ CourseUserNoteNote =. note ] + Entity nid _ <- upsert (CourseUserNote examCourse examUserCsvActUser note) [ CourseUserNoteNote =. note ] insert_ $ CourseUserNoteEdit uid now nid return $ CExamR tid ssh csh examn EUsersR , dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case @@ -579,12 +579,12 @@ postEUsersR tid ssh csh examn = do $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 @@ -620,7 +620,7 @@ postEUsersR tid ssh csh examn = do 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 + E.where_ . E.and $ catMaybes [ do field <- csvEUserField return . E.or $ catMaybes @@ -638,8 +638,13 @@ postEUsersR tid ssh csh examn = do , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester ] E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid - E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True - E.limit 2 + let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do + E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse + E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid + E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) + E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) + E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course + E.limit 2 -- we just need to know whether there is a unique one, none, or more than one return $ studyFeatures E.^. StudyFeaturesId case studyFeatures of [E.Value fid] -> return $ Just fid diff --git a/stack.yaml.lock b/stack.yaml.lock index cb8c9d974..45c694d00 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -10,13 +10,13 @@ packages: sha256: 2cab90bba4d15bf6a17e3cb8e50bc8708c1091de503dd4e91d3954240e89f37b name: zip-stream version: 0.1.0.1 - git: https://github.com/pngwjpgh/zip-stream.git + git: https://github.com/uni2work/zip-stream.git pantry-tree: size: 657 sha256: d1626bbc3fb88a48ce9c5c37199f8cbf426be6410740891d76a8343de4f3c109 commit: 9272bbed000928d500febad1cdc98d1da29d399e original: - git: https://github.com/pngwjpgh/zip-stream.git + git: https://github.com/uni2work/zip-stream.git commit: 9272bbed000928d500febad1cdc98d1da29d399e - completed: cabal-file: @@ -24,13 +24,13 @@ packages: sha256: 88537113b855381b8d70da2442ae644dc979ad6b32aaaec2ebf55306764c8f1a name: encoding version: 0.8.2 - git: https://github.com/pngwjpgh/encoding.git + git: https://github.com/uni2work/encoding.git pantry-tree: size: 5668 sha256: 57160d758802aba6a0d2cc88c53f2f0bb60df7d5e6822938351618b7eca0beab commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84 original: - git: https://github.com/pngwjpgh/encoding.git + git: https://github.com/uni2work/encoding.git commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84 - completed: cabal-file: @@ -38,13 +38,13 @@ packages: sha256: 7b25a0ef819e8a01b485d6d0865baa3445faa826ffb3876c94109dd2469ffbd3 name: memcached-binary version: 0.2.0 - git: https://github.com/pngwjpgh/memcached-binary.git + git: https://github.com/uni2work/memcached-binary.git pantry-tree: size: 1170 sha256: c466f91129410bae1f53e25aec4026f6984ce2dff0ada4516e2548048aba549a commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad original: - git: https://github.com/pngwjpgh/memcached-binary.git + git: https://github.com/uni2work/memcached-binary.git commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad - completed: hackage: colonnade-1.2.0@sha256:5620e999a68a394abfe157da6302dd6d8ce8a89b527ea9c294519efd7c4edb2c,2092 From 6d0a4c156bd8c792a9a01f05f6a41fe631da5517 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Aug 2019 15:02:23 +0200 Subject: [PATCH 02/15] feat(csv import): add explanation text --- messages/uniworx/de.msg | 5 ++- src/Handler/Utils.hs | 41 +----------------- src/Handler/Utils/I18n.hs | 43 +++++++++++++++++++ src/Handler/Utils/Table/Pagination.hs | 12 +++--- .../table/csv-import-explanation/de.hamlet | 21 +++++++++ templates/table/csv-transcode.hamlet | 1 + templates/table/csv-transcode.lucius | 2 +- 7 files changed, 78 insertions(+), 47 deletions(-) create mode 100644 src/Handler/Utils/I18n.hs create mode 100644 templates/i18n/table/csv-import-explanation/de.hamlet diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index c4862d134..7a0d62459 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -181,7 +181,7 @@ CourseApplicationRated: Bewertung erfolgreich angepasst CourseApplicationRatingDeleted: Bewertung erfolgreich entfernt CourseApplicationDeleted csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich zurückgezogen -CourseApplicationTitle displayName@Text csh@CourseShorthand: Bewerbung für #{csh}: #{displayName} +CourseApplicationTitle displayName@Text csh@CourseShorthand: Bewerbung für #{csh}: #{displayName} CourseApplicationText: Text-Bewerbung CourseApplicationFollowInstructions: Beachten Sie die Anweisungen zur Bewerbung! @@ -190,7 +190,7 @@ CourseRegistrationFollowInstructions: Beachten Sie die Anweisungen zur Anmeldung CourseApplicationFile: Bewerbung CourseApplicationFiles: Bewerbungsdatei(en) -CourseApplicationArchive: Zip-Archiv der Bewerbungsdatei(en) +CourseApplicationArchive: Zip-Archiv der Bewerbungsdatei(en) CourseRegistrationFile: Datei zur Anmeldung CourseRegistrationFiles: Datei(en) zur Anmeldung CourseRegistrationArchive: Zip-Archiv der Datei(en) zur Anmeldung @@ -1378,6 +1378,7 @@ CsvImportConfirmationTip: Durch den CSV-Import würden die unten aufgeführten 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 +CsvImportExplanationLabel: Hinweise zum CSV-Import Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%) diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 65e701eed..c0d067554 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -15,10 +15,6 @@ import Data.CaseInsensitive (original) -- import qualified Data.CaseInsensitive as CI import qualified Data.Conduit.List as Conduit -import Language.Haskell.TH -import Language.Haskell.TH.Syntax (qRunIO) --- import Language.Haskell.TH.Datatype - import Text.Hamlet (shamletFile) import Handler.Utils.DateTime as Handler.Utils @@ -32,12 +28,9 @@ import Handler.Utils.Rating as Handler.Utils hiding (extractRatings) import Handler.Utils.Sheet as Handler.Utils import Handler.Utils.Mail as Handler.Utils import Handler.Utils.ContentDisposition as Handler.Utils +import Handler.Utils.I18n as Handler.Utils -import System.Directory (listDirectory) -import System.FilePath.Posix (takeBaseName, takeFileName) - -import qualified Data.List as List -import qualified Data.List.NonEmpty as NonEmpty +import System.FilePath.Posix (takeFileName) import Control.Monad.Logger @@ -218,36 +211,6 @@ warnTermDays tid timeNames = do forM_ outoflecture $ warnI MsgDayIsOutOfLecture forM_ outoftermdays $ warnI MsgDayIsOutOfTerm --- | Add language dependent template files --- --- For large files which are translated as a whole. --- --- Argument musst be a directory under @/templates@, --- which contains a file for each language, --- eg. @imprint@ for choosing between --- @/templates/imprint/de.hamlet@, @/templates/imprint/de-at.hamlet@, --- and @/templates/imprint/en.hamlet@ --- --- Dependency detection cannot work properly (no `addDependentFile`-equivalent --- for directories) --- @$ stack clean@ is required so new translations show up -i18nWidgetFile :: FilePath -> Q Exp -i18nWidgetFile basename = do - -- Construct list of available translations (@de@, @en@, ...) at compile time - let i18nDirectory = "templates" "i18n" basename - availableFiles <- qRunIO $ listDirectory i18nDirectory - let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . List.nub $ pack . takeBaseName <$> availableFiles - availableTranslations' <- maybe (fail $ "‘" <> i18nDirectory <> "’ is empty") return $ NonEmpty.nonEmpty availableTranslations - - -- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time - ws <- newName "ws" -- Name for dispatch function - letE - [ funD ws $ [ clause [litP $ stringL l] (normalB . widgetFile $ "i18n" basename l) [] - | l <- unpack <$> NonEmpty.toList availableTranslations' -- One function definition for every available language - ] ++ [ clause [wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match - ] [e|selectLanguage availableTranslations' >>= $(varE ws)|] - - -- | return a value only if the current user ist authorized for a given route guardAuthorizedFor :: ( HandlerSite h ~ UniWorX, MonadHandler h, MonadLogger h diff --git a/src/Handler/Utils/I18n.hs b/src/Handler/Utils/I18n.hs new file mode 100644 index 000000000..1119191d2 --- /dev/null +++ b/src/Handler/Utils/I18n.hs @@ -0,0 +1,43 @@ +module Handler.Utils.I18n + where + +import Import + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax (qRunIO) + +import qualified Data.List as List +import qualified Data.List.NonEmpty as NonEmpty + +import System.Directory (listDirectory) +import System.FilePath.Posix (takeBaseName) + + +-- | Add language dependent template files +-- +-- For large files which are translated as a whole. +-- +-- Argument musst be a directory under @/templates@, +-- which contains a file for each language, +-- eg. @imprint@ for choosing between +-- @/templates/imprint/de.hamlet@, @/templates/imprint/de-at.hamlet@, +-- and @/templates/imprint/en.hamlet@ +-- +-- Dependency detection cannot work properly (no `addDependentFile`-equivalent +-- for directories) +-- @$ stack clean@ is required so new translations show up +i18nWidgetFile :: FilePath -> Q Exp +i18nWidgetFile basename = do + -- Construct list of available translations (@de@, @en@, ...) at compile time + let i18nDirectory = "templates" "i18n" basename + availableFiles <- qRunIO $ listDirectory i18nDirectory + let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . List.nub $ pack . takeBaseName <$> availableFiles + availableTranslations' <- maybe (fail $ "‘" <> i18nDirectory <> "’ is empty") return $ NonEmpty.nonEmpty availableTranslations + + -- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time + ws <- newName "ws" -- Name for dispatch function + letE + [ funD ws $ [ clause [litP $ stringL l] (normalB . widgetFile $ "i18n" basename l) [] + | l <- unpack <$> NonEmpty.toList availableTranslations' -- One function definition for every available language + ] ++ [ clause [wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match + ] [e|selectLanguage availableTranslations' >>= $(varE ws)|] \ No newline at end of file diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index e4560d8eb..ff5e907f3 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -42,6 +42,7 @@ import Handler.Utils.Table.Pagination.CsvColumnExplanations import Handler.Utils.Form import Handler.Utils.Csv import Handler.Utils.ContentDisposition +import Handler.Utils.I18n import Utils import Utils.Lens @@ -281,7 +282,7 @@ piIsUnset PaginationInput{..} = and , isNothing piPage ] - + data DBCsvActionMode = DBCsvActionNew | DBCsvActionExisting | DBCsvActionMissing deriving (Read, Show, Eq, Ord, Enum, Bounded, Generic, Typeable) instance Universe DBCsvActionMode @@ -851,6 +852,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db , formSubmit = FormSubmit , formAnchor = Nothing :: Maybe Text } + csvImportExplanation = modal [whamlet|_{MsgCsvImportExplanationLabel}|] $ Right $(i18nWidgetFile "table/csv-import-explanation") csvColExplanations = case dbtCsvEncode of (Just (Dict, _) :: DBTCsvEncode _ csv) -> assertM' (not . null) . Map.toList . csvColumnsExplanations $ Proxy @csv Nothing -> Nothing @@ -921,7 +923,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db | 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 () @@ -938,7 +940,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db -> let doHandle | Just inpCsv <- x ^? _dbCsvNew = handle $ throwM . (DBCsvException (toNamedRecord inpCsv) :: Text -> DBCsvException k') <=< dbtCsvRenderException - | otherwise + | otherwise = id in C.sourceList <=< lift . doHandle . runConduit $ dbtCsvComputeActions x .| C.foldMap pure innerAct .| C.fold accActionMap Map.empty @@ -954,7 +956,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db 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") + 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 @@ -980,7 +982,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db , formSubmit = FormSubmit , formAnchor = Nothing :: Maybe Text } - + $(widgetFile "csv-import-confirmation-wrapper") let defaultHeaderOrder = headerOrder (error "not to be forced" :: csv) diff --git a/templates/i18n/table/csv-import-explanation/de.hamlet b/templates/i18n/table/csv-import-explanation/de.hamlet new file mode 100644 index 000000000..0baade290 --- /dev/null +++ b/templates/i18n/table/csv-import-explanation/de.hamlet @@ -0,0 +1,21 @@ +

Hinweise zum Import von CSV-Dateien +
+
Änderungen +
+ Alle Werte können durch den Import verändert werden, + auch bereits Beim Export bereits vorhandene Werte. +
Vorschau +
+ Bevor Werte geändert werden, wird eine Vorschau der Änderungen angezeigt. +
Leere Zellen +
+ Löschbare Zellen werden durch leere Zellen gelöscht oder auf eindeutige Werte gesetzt. +
Konsistenz +
+

+ Es werden nur konsistente Änderungen akzeptiert! +

+ Daraus folgt, dass es sinnvoll sein kann, gewisse Zellen frei zu lassen; + z.B. ändert man ein Studienfachzuordnung eines Teilnehmers ab, + dann müsste man auch Abschluss und Semesterzahl passend ändern. + Da diese jedoch eindeutig sind, kann man diese Zellen einfach frei lassen. diff --git a/templates/table/csv-transcode.hamlet b/templates/table/csv-transcode.hamlet index 11586a227..00f76287b 100644 --- a/templates/table/csv-transcode.hamlet +++ b/templates/table/csv-transcode.hamlet @@ -4,6 +4,7 @@ $if is _Just dbtCsvDecode

_{MsgTableHeadingCsvImport}
+ ^{csvImportExplanation} ^{csvImportWdgt'} $if is _Just dbtCsvEncode
diff --git a/templates/table/csv-transcode.lucius b/templates/table/csv-transcode.lucius index 7c6de1c2a..dbf6b124e 100644 --- a/templates/table/csv-transcode.lucius +++ b/templates/table/csv-transcode.lucius @@ -1,6 +1,6 @@ .csv-export { margin-bottom: 13px; - + .csv-export__content { display: flex; align-content: space-between; From 2c57a77316e41bdac940747111009fa2f9b7d43d Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Aug 2019 15:25:34 +0200 Subject: [PATCH 03/15] fix(csv import): fix spelling and expand help text --- .../table/csv-import-explanation/de.hamlet | 22 ++++++++++++++++--- templates/table/csv-transcode.hamlet | 7 ++++-- templates/table/csv-transcode.lucius | 13 ----------- 3 files changed, 24 insertions(+), 18 deletions(-) diff --git a/templates/i18n/table/csv-import-explanation/de.hamlet b/templates/i18n/table/csv-import-explanation/de.hamlet index 0baade290..ba415fd30 100644 --- a/templates/i18n/table/csv-import-explanation/de.hamlet +++ b/templates/i18n/table/csv-import-explanation/de.hamlet @@ -2,11 +2,12 @@
Änderungen
- Alle Werte können durch den Import verändert werden, - auch bereits Beim Export bereits vorhandene Werte. + Einige Zellen können durch den Import verändert werden. + Nicht-änderbare Zellen werden ignoriert, falls diese verändert wurden.
Vorschau
- Bevor Werte geändert werden, wird eine Vorschau der Änderungen angezeigt. + Es wird eine Vorschau angezeigt, bevor irgendetwas tatsächlich geändert wird. + In der Vorschau können dann auch nur teilweise Änderungen ausgewählt werden.
Leere Zellen
Löschbare Zellen werden durch leere Zellen gelöscht oder auf eindeutige Werte gesetzt. @@ -19,3 +20,18 @@ z.B. ändert man ein Studienfachzuordnung eines Teilnehmers ab, dann müsste man auch Abschluss und Semesterzahl passend ändern. Da diese jedoch eindeutig sind, kann man diese Zellen einfach frei lassen. +
Zeilen Identifikation +
+ Mehrere Spalten werden zur Identifikation der Zeile verwendet. + Es muss nicht in jeder Spalte der Zeile ein Wert vorhanden sein, + so lange die Identifikation noch eindeutig ist. + Sind mehrere Werte vorhanden, so müssen diese natürlich zueinander passen. +
Zeilen hinzufügen +
+ Es können auch neue Zeilen hinzugefügt werden, so fern ausreichend + eindeutige Informationen vorhanden sind; + z.B. können so Prüfungsteilnehmer nachgemeldet werden. +
Zeilen löschen +
+ Fehlende Zeilen werden in der Vorschau zur Löschung angeboten + und dann ggf. gelöscht. diff --git a/templates/table/csv-transcode.hamlet b/templates/table/csv-transcode.hamlet index 00f76287b..92e1ea95a 100644 --- a/templates/table/csv-transcode.hamlet +++ b/templates/table/csv-transcode.hamlet @@ -4,12 +4,15 @@ $if is _Just dbtCsvDecode

_{MsgTableHeadingCsvImport}
- ^{csvImportExplanation} +

+ ^{csvImportExplanation} ^{csvImportWdgt'} $if is _Just dbtCsvEncode

_{MsgTableHeadingCsvExport}
+

+ ^{csvColExplanations'} ^{csvExportWdgt'} - ^{csvColExplanations'} + diff --git a/templates/table/csv-transcode.lucius b/templates/table/csv-transcode.lucius index dbf6b124e..bcf12df47 100644 --- a/templates/table/csv-transcode.lucius +++ b/templates/table/csv-transcode.lucius @@ -1,19 +1,6 @@ .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 { From b7321dfbc54eb58e405ceebd9150683aa23095de Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Aug 2019 15:38:30 +0200 Subject: [PATCH 04/15] fix(csv import): csv import preview help text adjusted --- messages/uniworx/de.msg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 7a0d62459..b68d834c4 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1373,8 +1373,8 @@ 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. +CsvImportConfirmationHeading: CSV-Import Vorschau (noch keine Änderungen importiert) +CsvImportConfirmationTip: Es wurden noch keine Änderungen übernommen! Durch den CSV-Import könnten die unten aufgeführten Änderungen vorgenommen werden. Bitte wählen Sie die gewünschten Änderungen aus, bevor Sie den CSV-Import abschließen. 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 From 9d9ead95d847a96927b3c8d66d1adff9f31af2f4 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Aug 2019 16:50:59 +0200 Subject: [PATCH 05/15] fix(routes): change ex to sheet avoids confusion with exams and is more intuitive either --- messages/uniworx/de.msg | 2 +- routes | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index b68d834c4..4df1b31f1 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1374,7 +1374,7 @@ BtnCsvImportConfirm: CSV-Import abschließen CsvImportNotConfigured: CSV-Import nicht vorgesehen CsvImportConfirmationHeading: CSV-Import Vorschau (noch keine Änderungen importiert) -CsvImportConfirmationTip: Es wurden noch keine Änderungen übernommen! Durch den CSV-Import könnten die unten aufgeführten Änderungen vorgenommen werden. Bitte wählen Sie die gewünschten Änderungen aus, bevor Sie den CSV-Import abschließen. +CsvImportConfirmationTip: Es wurden noch keine Änderungen übernommen! Durch den CSV-Import könnten die unten aufgeführten Änderungen vorgenommen werden. Wählen Sie jetzt die gewünschten Änderungen aus, bevor Sie den CSV-Import abschließen. 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 diff --git a/routes b/routes index cec9b58f7..4e2e5317c 100644 --- a/routes +++ b/routes @@ -106,11 +106,11 @@ /notes CNotesR GET POST !corrector -- THIS route is used to check for overall course corrector access! /subs CCorrectionsR GET POST /subs/assigned CAssignR GET POST - /ex SheetListR GET !course-registered !materials !corrector - /ex/new SheetNewR GET POST - /ex/current SheetCurrentR GET !course-registered !materials !corrector - /ex/unassigned SheetOldUnassignedR GET - /ex/#SheetName SheetR: + /sheet SheetListR GET !course-registered !materials !corrector + /sheet/new SheetNewR GET POST + /sheet/current SheetCurrentR GET !course-registered !materials !corrector + /sheet/unassigned SheetOldUnassignedR GET + /sheet/#SheetName SheetR: /show SShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor /show/download SArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor /edit SEditR GET POST From 0bb9a0fa60d83e91c91bb97833126a23a6f03989 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Aug 2019 17:50:12 +0200 Subject: [PATCH 06/15] fix(sheet list): do not show icons for inaccessible items Closes #421 --- src/Handler/Sheet.hs | 8 ++++---- templates/default-layout.lucius | 7 ++++++- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index f1bf685b8..cecc6a3db 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -186,7 +186,7 @@ getSheetListR tid ssh csh = do let hasSFT :: (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool) -> [SheetFileType] hasSFT (E.Value hasExercise, E.Value hasHint, E.Value hasSolution, E.Value hasMarking) - = [ sft | sft <- [minBound..maxBound] + = [ sft | sft <- universeF , sft /= SheetExercise || hasExercise , sft /= SheetHint || hasHint , sft /= SheetSolution || hasSolution @@ -204,7 +204,7 @@ getSheetListR tid ssh csh = do E.where_ $ sheet E.^. SheetCourse E.==. E.val cid sheetFilter :: SheetName -> DB Bool - sheetFilter sheetName = (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False + sheetFilter sheetName = hasReadAccessTo $ CSheetR tid ssh csh sheetName SShowR sheetCol = widgetColonnade . mconcat $ [ -- dbRow , @@ -220,9 +220,9 @@ getSheetListR tid ssh csh = do | let existingSFTs = hasSFT existFiles , sft <- [minBound..maxBound] , let link = CSheetR tid ssh csh sheetName $ SZipR sft - , let icn = toWidget $ sheetFile2markup sft + , let icn = toWgt $ sheetFile2markup sft , let icnCell = if sft `elem` existingSFTs - then linkEmptyCell link icn + then linkEitherCell link (icn, [whamlet| |]) else spacerCell ] id & cellAttrs <>~ [("class","list--inline list--space-separated")] , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius index f929425ec..577e95c01 100644 --- a/templates/default-layout.lucius +++ b/templates/default-layout.lucius @@ -482,6 +482,11 @@ ul.list--inline { } } +.list--icon-width li { + width: 1rem; + height: 1rem; +} + /* DEFINITION LIST */ .deflist { display: grid; @@ -626,7 +631,7 @@ section { grid-column: 1; max-width: none; - + padding-left: 40px; &::before { From 6384ead0f973c6a9599aa0b6ffac8a2b56b4b696 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 21 Aug 2019 16:15:11 +0200 Subject: [PATCH 07/15] chore(release): 5.2.0 --- CHANGELOG.md | 18 ++++++++++++++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 21 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index dadeb24b1..573f38aba 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,24 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [5.2.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.1.0...v5.2.0) (2019-08-21) + + +### Bug Fixes + +* **csv import:** csv import preview help text adjusted ([b7321df](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/b7321df)) +* **csv import:** fix spelling and expand help text ([2c57a77](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/2c57a77)) +* **exam import:** inactive registered features may be selected ([3c4172c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/3c4172c)) +* **routes:** change ex to sheet ([9d9ead9](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/9d9ead9)) +* **sheet list:** do not show icons for inaccessible items ([0bb9a0f](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/0bb9a0f)), closes [#421](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/421) + + +### Features + +* **csv import:** add explanation text ([6d0a4c1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/6d0a4c1)) + + + ## [5.1.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.0.2...v5.1.0) (2019-08-19) diff --git a/package-lock.json b/package-lock.json index c0d813997..d15a2d144 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.1.0", + "version": "5.2.0", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 6795c3884..769b9e0c9 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.1.0", + "version": "5.2.0", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 1d62936ac..2b1cf1b20 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 5.1.0 +version: 5.2.0 dependencies: # Due to a bug in GHC 8.0.1, we block its usage From 7d2937c71df50e2fdd1346629d2fc1ca0016cf57 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 21 Aug 2019 17:45:12 +0200 Subject: [PATCH 08/15] fix(csv upload exams): allow ambiguous harmless study fields --- src/Handler/Exam/Users.hs | 68 ++++++++++++++++++++++----------------- src/Model/Types/Misc.hs | 2 ++ 2 files changed, 41 insertions(+), 29 deletions(-) diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 42ec778b0..8347e26ef 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -617,35 +617,40 @@ postEUsersR tid ssh csh examn = do 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 - let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do - E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse - E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid - E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) - E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) - E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course - E.limit 2 -- we just need to know whether there is a unique one, none, or more than one - return $ studyFeatures E.^. StudyFeaturesId + oldFeatures <- getBy $ UniqueParticipant uid examCourse + studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> + E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField) + , E.asc (studyFeatures E.^. StudyFeaturesDegree) + , E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ 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 + let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do + E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse + E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid + E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) + E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) + E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course + E.orderBy [E.desc isCourseParticipantFeature, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)] + E.limit 2 -- we just need to know whether there is a unique one, none, or more than one + return $ studyFeatures E.^. StudyFeaturesId case studyFeatures of [E.Value fid] -> return $ Just fid _other @@ -653,6 +658,11 @@ postEUsersR tid ssh csh examn = do , is _Nothing csvEUserDegree , is _Nothing csvEUserSemester -> return Nothing + _other + | Just (Entity _ CourseParticipant{..}) <- oldFeatures + , Just sfid <- courseParticipantField + , E.Value sfid `elem` studyFeatures + -> return Nothing _other -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"] diff --git a/src/Model/Types/Misc.hs b/src/Model/Types/Misc.hs index 510b21251..1c8d676ae 100644 --- a/src/Model/Types/Misc.hs +++ b/src/Model/Types/Misc.hs @@ -19,6 +19,8 @@ import qualified Data.Text.Lens as Text data StudyFieldType = FieldPrimary | FieldSecondary deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic) derivePersistField "StudyFieldType" +instance Universe StudyFieldType +instance Finite StudyFieldType data Theme From b4cf112e48eb63c75a6c9b131148e28f354de240 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 21 Aug 2019 17:47:32 +0200 Subject: [PATCH 09/15] chore(vscode): configure release action --- .vscode/tasks.json | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 4c18542ba..36c10837e 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -69,6 +69,11 @@ "type": "npm", "script": "lint", "problemMatcher": [] + }, + { + "type": "npm", + "script": "release", + "problemMatcher": [] } ] } \ No newline at end of file From f38a6ea2f801ff316dffa52bbf073e804da56434 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 21 Aug 2019 17:53:09 +0200 Subject: [PATCH 10/15] chore(release): 5.2.1 --- CHANGELOG.md | 9 +++++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 12 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 573f38aba..923cd4573 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,15 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +### [5.2.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.0...v5.2.1) (2019-08-21) + + +### Bug Fixes + +* **csv upload exams:** allow ambiguous harmless study fields ([7d2937c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/7d2937c)) + + + ## [5.2.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.1.0...v5.2.0) (2019-08-21) diff --git a/package-lock.json b/package-lock.json index d15a2d144..9fc32de11 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.2.0", + "version": "5.2.1", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 769b9e0c9..36374aadc 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.2.0", + "version": "5.2.1", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 2b1cf1b20..7bea01659 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 5.2.0 +version: 5.2.1 dependencies: # Due to a bug in GHC 8.0.1, we block its usage From ee92429c30bccc4195d10addd4300ace4de99326 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 22 Aug 2019 07:42:34 +0200 Subject: [PATCH 11/15] refactor(exam csv import): remove unnecessary esqueleto exists --- src/Handler/Exam/Users.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 8347e26ef..7a5107c2b 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -642,13 +642,15 @@ postEUsersR tid ssh csh examn = do , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester ] E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid - let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do - E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse - E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid - E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) - E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) - E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course - E.orderBy [E.desc isCourseParticipantFeature, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)] + let isActive = studyFeatures E.^. StudyFeaturesValid E.==. E.val True + -- isActiveOrPrevious = maybe isActive (\Entity sfid _ -> isActive E.||. (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- one line, but obfuscates the `or else` structure + -- isActiveOrPrevious = isActive E.||. $ maybe (E.val False) (\Entity sfid _ -> (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- meh + isActiveOrPrevious = case oldFeatures of + Just (Entity _ CourseParticipant{courseParticipantField = Just sfid}) + -> isActive E.||. (E.val sfid E.==. studyFeatures E.^. StudyFeaturesId) + _ -> isActive + E.where_ $ isActiveOrPrevious -- either active studyFeature or the one previously associated with this course + E.orderBy [E.desc isActiveOrPrevious, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)] E.limit 2 -- we just need to know whether there is a unique one, none, or more than one return $ studyFeatures E.^. StudyFeaturesId case studyFeatures of From 1cc94fdb537dc8237fd11aacb9571a7da1dbb003 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 22 Aug 2019 07:42:34 +0200 Subject: [PATCH 12/15] refactor(exam csv import): remove unnecessary esqueleto exists --- src/Handler/Exam/Users.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 8347e26ef..19168a7eb 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -642,13 +642,15 @@ postEUsersR tid ssh csh examn = do , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester ] E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid - let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do - E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse - E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid - E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) - E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) - E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course - E.orderBy [E.desc isCourseParticipantFeature, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)] + let isActive = studyFeatures E.^. StudyFeaturesValid E.==. E.val True + -- isActiveOrPrevious = maybe isActive (\Entity sfid _ -> isActive E.||. (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- one line, but obfuscates the `or else` structure + -- isActiveOrPrevious = isActive E.||. $ maybe (E.val False) (\Entity sfid _ -> (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- meh + isActiveOrPrevious = case oldFeatures of + Just (Entity _ CourseParticipant{courseParticipantField = Just sfid}) + -> isActive E.||. (E.val sfid E.==. studyFeatures E.^. StudyFeaturesId) + _ -> isActive + E.where_ isActiveOrPrevious -- either active studyFeature or the one previously associated with this course + E.orderBy [E.desc isActiveOrPrevious, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)] E.limit 2 -- we just need to know whether there is a unique one, none, or more than one return $ studyFeatures E.^. StudyFeaturesId case studyFeatures of From 3881f3a71d61a99ff1485dcaa8b98754dac98446 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 22 Aug 2019 07:50:50 +0200 Subject: [PATCH 13/15] chore(release): 5.2.2 --- CHANGELOG.md | 4 ++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 7 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 923cd4573..48698300b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +### [5.2.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.1...v5.2.2) (2019-08-22) + + + ### [5.2.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.0...v5.2.1) (2019-08-21) diff --git a/package-lock.json b/package-lock.json index 9fc32de11..418334eac 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.2.1", + "version": "5.2.2", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 36374aadc..7714026df 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.2.1", + "version": "5.2.2", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 7bea01659..3f904555c 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 5.2.1 +version: 5.2.2 dependencies: # Due to a bug in GHC 8.0.1, we block its usage From a3465240731423e3ea5d7f85f8f8c73935166b76 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 22 Aug 2019 10:29:49 +0200 Subject: [PATCH 14/15] fix(csv exam import): ignore unchanged noshow and voided noshow and voided are now independent of whether the exam is graded or pass and fail only --- src/Foundation.hs | 11 ++++++++--- src/Handler/Exam/Users.hs | 18 ++++++------------ src/Model/Types/Exam.hs | 10 ++++++---- 3 files changed, 20 insertions(+), 19 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index a80f277d6..3ccd28aae 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -369,6 +369,11 @@ instance RenderMessage UniWorX a => RenderMessage UniWorX (ExamResult' a) where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls +instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where + renderMessage foundation ls = either mr mr + where + mr :: RenderMessage UniWorX msg => msg -> Text + mr = renderMessage foundation ls -- ToMessage instances for converting raw numbers to Text (no internationalization) @@ -759,7 +764,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo return Authorized - + CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn @@ -872,7 +877,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do -- Checks `registerFrom` and `registerTo`, override as further routes become available now <- liftIO getCurrentTime - Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash + Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash guard $ NTop allocationRegisterFrom <= NTop (Just now) guard $ NTop (Just now) <= NTop allocationRegisterTo return Authorized @@ -890,7 +895,7 @@ tagAccessPredicate AuthStaffTime = APDB $ \_ route _ -> case route of AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do -- Checks `registerFrom` and `registerTo`, override as further routes become available now <- liftIO getCurrentTime - Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash + Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash guard $ NTop allocationStaffAllocationFrom <= NTop (Just now) guard $ NTop (Just now) <= NTop allocationStaffAllocationTo return Authorized diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 19168a7eb..2a5f9fbe9 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -109,7 +109,7 @@ data ExamUserTableCsv = ExamUserTableCsv , csvEUserExerciseNumPasses :: Maybe Int , csvEUserExercisePointsMax :: Maybe Points , csvEUserExerciseNumPassesMax :: Maybe Int - , csvEUserExamResult :: Maybe (Either ExamResultPassed ExamResultGrade) + , csvEUserExamResult :: Maybe ExamResultPassedGrade , csvEUserCourseNote :: Maybe Html } deriving (Generic) @@ -209,7 +209,7 @@ data ExamUserCsvAction } | ExamUserCsvSetResultData { examUserCsvActUser :: UserId - , examUserCsvActExamResult :: Maybe (Either ExamResultPassed ExamResultGrade) + , examUserCsvActExamResult :: Maybe ExamResultPassedGrade } | ExamUserCsvSetCourseNoteData { examUserCsvActUser :: UserId @@ -244,8 +244,8 @@ postEUsersR tid ssh csh examn = do showPasses = numSheetsPasses allBoni /= 0 showPoints = getSum (numSheetsPoints allBoni) /= 0 - resultView :: ExamResultGrade -> Either ExamResultPassed ExamResultGrade - resultView = bool (Left . over _examResult (view passingGrade)) Right examShowGrades + resultView :: ExamResultGrade -> ExamResultPassedGrade + resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades let examUsersDBTable = DBTable{..} @@ -471,7 +471,7 @@ postEUsersR tid ssh csh examn = do deleteBy $ UniqueExamResult eid examUserCsvActUser audit $ TransactionExamResultDeleted eid examUserCsvActUser Just res -> do - let res' = either (over _examResult $ review passingGrade) id res + let res' = either (review passingGrade) id <$> res now <- liftIO getCurrentTime void $ upsertBy (UniqueExamResult eid examUserCsvActUser) @@ -550,11 +550,7 @@ postEUsersR tid ssh csh examn = do $newline never ^{nameWidget userDisplayName userSurname} $maybe newResult <- examUserCsvActExamResult - $case newResult - $of Left pResult - , _{pResult} - $of Right gResult - , _{gResult} + , _{newResult} $nothing , _{MsgExamResultNone} |] @@ -643,8 +639,6 @@ postEUsersR tid ssh csh examn = do ] E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid let isActive = studyFeatures E.^. StudyFeaturesValid E.==. E.val True - -- isActiveOrPrevious = maybe isActive (\Entity sfid _ -> isActive E.||. (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- one line, but obfuscates the `or else` structure - -- isActiveOrPrevious = isActive E.||. $ maybe (E.val False) (\Entity sfid _ -> (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- meh isActiveOrPrevious = case oldFeatures of Just (Entity _ CourseParticipant{courseParticipantField = Just sfid}) -> isActive E.||. (E.val sfid E.==. studyFeatures E.^. StudyFeaturesId) diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs index ef5a8f1f9..8dcf8f844 100644 --- a/src/Model/Types/Exam.hs +++ b/src/Model/Types/Exam.hs @@ -20,7 +20,7 @@ import Utils.Lens.TH import qualified Data.Csv as Csv import Database.Persist.Sql - + data ExamResult' res = ExamAttended { examResult :: res } | ExamNoShow @@ -211,14 +211,16 @@ pathPieceJSONKey ''ExamPassed passingGrade :: Iso' ExamGrade ExamPassed -- ^ Improper isomorphism; maps @ExamPassed True@ to `Grade10` passingGrade = iso (ExamPassed . (>= Grade40)) (bool Grade50 Grade10 . examPassed) - + type ExamResultPoints = ExamResult' Points type ExamResultGrade = ExamResult' ExamGrade type ExamResultPassed = ExamResult' ExamPassed -instance Csv.ToField (Either ExamResultPassed ExamResultGrade) where +type ExamResultPassedGrade = ExamResult' (Either ExamPassed ExamGrade) + +instance Csv.ToField (Either ExamPassed ExamGrade) where toField = either Csv.toField Csv.toField -instance Csv.FromField (Either ExamResultPassed ExamResultGrade) where +instance Csv.FromField (Either ExamPassed ExamGrade) where parseField x = (Left <$> Csv.parseField x) <|> (Right <$> Csv.parseField x) -- encodings are disjoint From 9bc5885dbb9ed1c7a6af1b6aac57c79b96a2fbc1 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 22 Aug 2019 10:33:46 +0200 Subject: [PATCH 15/15] chore(release): 5.2.3 --- CHANGELOG.md | 9 +++++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 12 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 48698300b..755e68cbb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,15 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +### [5.2.3](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.2...v5.2.3) (2019-08-22) + + +### Bug Fixes + +* **csv exam import:** ignore unchanged noshow and voided ([a346524](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a346524)) + + + ### [5.2.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.1...v5.2.2) (2019-08-22) diff --git a/package-lock.json b/package-lock.json index 418334eac..502adc269 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.2.2", + "version": "5.2.3", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 7714026df..47227e837 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "5.2.2", + "version": "5.2.3", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 3f904555c..193b3f64c 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 5.2.2 +version: 5.2.3 dependencies: # Due to a bug in GHC 8.0.1, we block its usage