Merge branch 'master' into 155-zentralanmeldungen

.vscode/tasks.json

@@ -69,6 +69,11 @@
       "type": "npm",
       "script": "lint",
       "problemMatcher": []
+    },
+    {
+      "type": "npm",
+      "script": "release",
+      "problemMatcher": []
     }
   ]
 }

CHANGELOG.md

@@ -2,6 +2,46 @@
 
 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)
+
+
+
+### [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)
+
+
+### 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)
 
 

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
@@ -1377,11 +1377,12 @@ BtnCsvImport: CSV-Datei importieren
 BtnCsvImportConfirm: CSV-Import abschließen
 
 CsvImportNotConfigured: CSV-Import nicht vorgesehen
-CsvImportConfirmationHeading: CSV-Import abschließen
+CsvImportConfirmationHeading: CSV-Import Vorschau (noch keine Änderungen importiert)
-CsvImportConfirmationTip: Durch den CSV-Import würden die unten aufgeführten Änderungen vorgenommen. Bitte überprüfen Sie diese zunächst sorgfältig.
+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
+CsvImportExplanationLabel: Hinweise zum CSV-Import
 
 Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
 

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "5.1.0",
+  "version": "5.2.3",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "5.1.0",
+  "version": "5.2.3",
   "description": "",
   "keywords": [],
   "author": "",

package.yaml

@@ -1,5 +1,5 @@
 name:    uniworx
-version: 5.1.0
+version: 5.2.3
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage

routes

@@ -107,11 +107,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
+  /sheet                      SheetListR       GET             !course-registered !materials !corrector
-  /ex/new                     SheetNewR        GET POST
+  /sheet/new                  SheetNewR        GET POST
-  /ex/current                 SheetCurrentR    GET             !course-registered !materials !corrector
+  /sheet/current              SheetCurrentR    GET             !course-registered !materials !corrector
-  /ex/unassigned              SheetOldUnassignedR  GET
+  /sheet/unassigned           SheetOldUnassignedR  GET
-  /ex/#SheetName SheetR:
+  /sheet/#SheetName SheetR:
     /show                       SShowR         GET             !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
     /show/download              SArchiveR      GET             !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
     /edit                       SEditR         GET POST

src/Foundation.hs

@@ -368,6 +368,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)
 
@@ -758,7 +763,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
@@ -871,7 +876,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
@@ -889,7 +894,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

src/Handler/Exam/Users.hs

@@ -15,18 +15,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)
@@ -108,7 +108,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)
@@ -208,7 +208,7 @@ data ExamUserCsvAction
     }
   | ExamUserCsvSetResultData
     { examUserCsvActUser :: UserId
-    , examUserCsvActExamResult :: Maybe (Either ExamResultPassed ExamResultGrade)
+    , examUserCsvActExamResult :: Maybe ExamResultPassedGrade
     }
   | ExamUserCsvSetCourseNoteData
     { examUserCsvActUser :: UserId
@@ -243,8 +243,8 @@ postEUsersR tid ssh csh examn = do
       showPasses     = numSheetsPasses allBoni /= 0
       showPoints     = getSum (numSheetsPoints allBoni) /= 0
 
-      resultView :: ExamResultGrade -> Either ExamResultPassed ExamResultGrade
+      resultView :: ExamResultGrade -> ExamResultPassedGrade
-      resultView = bool (Left . over _examResult (view passingGrade)) Right examShowGrades
+      resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades
 
     let
       examUsersDBTable = DBTable{..}
@@ -319,7 +319,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'')
               )
@@ -430,7 +430,7 @@ postEUsersR tid ssh csh examn = do
                 ExamUserCsvCourseRegister -> DBCsvActionNew
                 ExamUserCsvRegister       -> DBCsvActionNew
                 ExamUserCsvDeregister     -> DBCsvActionMissing
-                _other                    -> DBCsvActionExisting 
+                _other                    -> DBCsvActionExisting
             , dbtCsvExecuteActions = do
                 C.mapM_ $ \case
                   ExamUserCsvCourseRegisterData{..} -> do
@@ -470,7 +470,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)
@@ -495,7 +495,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
@@ -549,11 +549,7 @@ postEUsersR tid ssh csh examn = do
                     $newline never
                     ^{nameWidget userDisplayName userSurname}
                     $maybe newResult <- examUserCsvActExamResult
-                      $case newResult
+                      , _{newResult}
-                        $of Left pResult
-                          , _{pResult}
-                        $of Right gResult
-                          , _{gResult}
                     $nothing
                       , _{MsgExamResultNone}
                   |]
@@ -578,12 +574,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
@@ -616,30 +612,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
+                oldFeatures <- getBy $ UniqueParticipant uid examCourse
-                  E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
+                studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) ->
-                  E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
+                  E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField)
-                  E.where_ . E.and $ catMaybes 
+                                      , E.asc (studyFeatures E.^. StudyFeaturesDegree)
-                    [ do
+                                      , E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ do
-                        field <- csvEUserField
+                    E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
-                        return . E.or $ catMaybes
+                    E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
-                          [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
+                    E.where_ . E.and $ catMaybes
-                          , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
+                      [ do
-                          , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
+                          field <- csvEUserField
-                          ]
+                          return . E.or $ catMaybes
-                    , do
+                            [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
-                        degree <- csvEUserDegree
+                            , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
-                        return . E.or $ catMaybes
+                            , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
-                          [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
+                            ]
-                          , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
+                      , do
-                          , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
+                          degree <- csvEUserDegree
-                          ]
+                          return . E.or $ catMaybes
-                    , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
+                            [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
-                    ]
+                            , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
-                  E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
+                            , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
-                       E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True
+                            ]
-                  E.limit 2
+                      , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
-                  return $ studyFeatures E.^. StudyFeaturesId
+                      ]
+                    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
+                    let isActive = studyFeatures E.^. StudyFeaturesValid  E.==.  E.val True
+                        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
                   [E.Value fid] -> return $ Just fid
                   _other
@@ -647,6 +653,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"]

src/Handler/Sheet.hs

@@ -181,7 +181,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
@@ -199,7 +199,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 ,
@@ -215,9 +215,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|&emsp;|])
                               else spacerCell
               ] id & cellAttrs <>~ [("class","list--inline list--space-separated")]
       , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)

src/Handler/Utils.hs

@@ -13,10 +13,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
@@ -30,12 +26,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 (takeFileName)
-import System.FilePath.Posix (takeBaseName, takeFileName)
-
-import qualified Data.List as List
-import qualified Data.List.NonEmpty as NonEmpty
 
 import Control.Monad.Logger
 
@@ -216,36 +209,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

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)|]

src/Handler/Utils/Table/Pagination.hs

@@ -44,6 +44,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
 
@@ -302,7 +303,7 @@ piIsUnset PaginationInput{..} = and
   , isNothing piPage
   ]
 
-  
+
 data DBCsvActionMode = DBCsvActionNew | DBCsvActionExisting | DBCsvActionMissing
   deriving (Read, Show, Eq, Ord, Enum, Bounded, Generic, Typeable)
 instance Universe DBCsvActionMode
@@ -863,6 +864,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
@@ -933,7 +935,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 ()
@@ -950,7 +952,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
@@ -966,7 +968,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
 
@@ -992,7 +994,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)

src/Model/Types/Exam.hs

@@ -19,7 +19,7 @@ import Utils.Lens.TH
 import qualified Data.Csv as Csv
 
 import Database.Persist.Sql
-  
+
 
 data ExamResult' res = ExamAttended { examResult :: res }
                      | ExamNoShow
@@ -210,14 +210,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

src/Model/Types/Misc.hs

@@ -18,6 +18,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

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

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 {

templates/i18n/table/csv-import-explanation/de.hamlet

@@ -0,0 +1,37 @@
+<h3>Hinweise zum Import von CSV-Dateien
+<dl .deflist>
+    <dt .deflist__dt>Änderungen
+    <dd .deflist__dd>
+      Einige Zellen können durch den Import verändert werden.
+      Nicht-änderbare Zellen werden ignoriert, falls diese verändert wurden.
+    <dt .deflist__dt>Vorschau
+    <dd .deflist__dd>
+      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.
+    <dt .deflist__dt>Leere Zellen
+    <dd .deflist__dd>
+      Löschbare Zellen werden durch leere Zellen gelöscht oder auf eindeutige Werte gesetzt.
+    <dt .deflist__dt>Konsistenz
+    <dd .deflist__dd>
+      <p>
+        Es werden nur konsistente Änderungen akzeptiert!
+      <p>
+        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.
+    <dt .deflist__dt>Zeilen Identifikation
+    <dd .deflist__dd>
+        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.
+    <dt .deflist__dt>Zeilen hinzufügen
+    <dd .deflist__dd>
+        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.
+    <dt .deflist__dt>Zeilen löschen
+    <dd .deflist__dd>
+        Fehlende Zeilen werden in der Vorschau zur Löschung angeboten
+        und dann ggf. gelöscht.

templates/table/csv-transcode.hamlet

@@ -4,11 +4,15 @@ $if is _Just dbtCsvDecode
     <h3 .csv-import__toggle uw-show-hide data-show-hide-id=table-csv-import data-show-hide-collapsed>
       _{MsgTableHeadingCsvImport}
     <div .csv-import__content>
+      <p>
+        ^{csvImportExplanation}
       ^{csvImportWdgt'}
 $if is _Just dbtCsvEncode
   <div .csv-export>
     <h3 .csv-import__toggle uw-show-hide data-show-hide-id=table-csv-export>
       _{MsgTableHeadingCsvExport}
     <div .csv-export__content>
+      <p>
+        ^{csvColExplanations'}
       ^{csvExportWdgt'}
-      ^{csvColExplanations'}
+

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 {