feat(exam-office): grade export

messages/uniworx/de.msg

@@ -366,6 +366,7 @@ UnauthorizedSiteAdmin: Sie sind kein System-weiter Administrator.
 UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen.
 UnauthorizedAdminEscalation: Sie sind nicht Administrator für alle Institute, für die dieser Nutzer Administrator oder Veranstalter ist.
 UnauthorizedExamOffice: Sie sind nicht Teil eines Prüfungsamts.
+UnauthorizedExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie Teil eines assoziierten Prüfungsamts sind.
 UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen.
 UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen.
 UnauthorizedAllocationLecturer: Sie sind nicht als Veranstalter für eine Veranstaltung dieser Zentralanmeldung eingetragen.
@@ -1046,6 +1047,7 @@ MenuExamList: Prüfungen
 MenuExamNew: Neue Prüfung anlegen
 MenuExamEdit: Bearbeiten
 MenuExamUsers: Teilnehmer
+MenuExamGrades: Prüfungsleistungen
 MenuExamAddMembers: Prüfungsteilnehmer hinzufügen
 MenuExamOfficeExams: Prüfungen
 MenuExamOfficeFields: Fächer
@@ -1339,6 +1341,8 @@ ExamRoomDescription: Beschreibung
 ExamTimeTip: Nur zur Information der Studierenden, die tatsächliche Zeitangabe erfolgt pro Prüfung
 ExamRoomRegistered: Zugeteilt
 
+ExamOccurrenceStart: Prüfungsbeginn
+
 ExamFormTimes: Zeiten
 ExamFormOccurrences: Prüfungstermine/Räume
 ExamFormAutomaticFunctions: Automatische Funktionen
@@ -1402,6 +1406,18 @@ ExamUserAssignOccurrence: Termin/Raum zuweisen
 ExamUsersDeregistered count@Int64: #{show count} Teilnehmer von der Prüfung abgemeldet
 ExamUsersOccurrenceUpdated count@Int64: Termin/Raum für #{show count} Teilnehmer gesetzt
 
+ExamUserSynchronised: Synchronisiert
+ExamUserSyncOfficeName: Name
+ExamUserSyncTime: Zeitpunkt
+ExamUserSyncSchools: Institute
+ExamUserSyncLastChange: Zuletzt geändert
+ExamUserMarkSynchronised: Prüfungsleistung als synchronisiert markieren
+
+ExamUserMarkSynchronisedCsv: Prüfungsleistungen beim Export als synchronisiert markieren
+ExamUserMarkedSynchronised n@Int: #{n} #{pluralDE n "Prüfungsleistung" "Prüfungsleistungen"} als synchronisiert markiert
+
+ExamOfficeExamUsersHeading: Prüfungsleistungen
+
 CsvFile: CSV-Datei
 CsvModifyExisting: Existierende Einträge angleichen
 CsvAddNew: Neue Einträge einfügen
@@ -1420,6 +1436,9 @@ CsvImportExplanationLabel: Hinweise zum CSV-Import
 
 Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
 
+ExamUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-teilnehmer
+CourseApplicationsTableCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungen
+
 CsvColumnsExplanationsLabel: Spalten
 CsvColumnsExplanationsTip: Bedeutung der in der CSV-Datei enthaltenen Spalten
 CsvColumnExamUserSurname: Nachname(n) des Teilnehmers
@@ -1436,6 +1455,9 @@ CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer
 CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Prüfungstermin bestehen hätte können
 CsvColumnExamUserResult: Erreichte Prüfungsleistung; "passed", "failed", "no-show", "voided", oder eine Note ("1.0", "1.3", "1.7", ..., "4.0", "5.0")
 CsvColumnExamUserCourseNote: Notizen zum Teilnehmer
+
+CsvColumnExamOfficeExamUserOccurrenceStart: Prüfungstermin (ISO 8601)
+
 CsvColumnApplicationsAllocation: Zentralanmeldung über die die Bewerbung eingegangen ist
 CsvColumnApplicationsApplication: Eindeutige Nummer der Bewerbung (zur Zuordnung im ZIP-Archiv aller Bewerbungsdateien)
 CsvColumnApplicationsName: Voller Name des Bewerbers

models/courses

@@ -71,6 +71,12 @@ CourseUserNoteEdit             -- who edited a participants course note when
     time         UTCTime
     note         CourseUserNoteId -- PROBLEM: deleted notes have no modification date any more
 
+CourseUserExamOfficeOptOut
+    course       CourseId
+    user         UserId
+    school       SchoolId
+    UniqueCourseUserExamOfficeOptOut course user school
+
 CourseApplication
     course              CourseId
     user                UserId

models/exam-office

@@ -9,6 +9,6 @@ ExamOfficeUser
     UniqueExamOfficeUser office user
 ExamOfficeResultSynced
     office  UserId
-    result  ExamResult
+    result  ExamResultId
     time    UTCTime
     UniqueExamOfficeResultSynced office result

routes

@@ -168,8 +168,7 @@
     /users/new                  EAddUserR      GET POST
     /users/invite               EInviteR       GET POST
     /register                   ERegisterR         POST        !timeANDcourse-registeredAND¬exam-registered !timeANDexam-registeredAND¬exam-result
-    /grades                     EGradesR       GET             !exam-office
+    /grades                     EGradesR       GET POST        !exam-office
-    /grades/read                EGradesReadR       POST        !exam-office
   /apps                         CApplicationsR GET POST
   !/apps/files                  CAppsFilesR    GET
   /apps/#CryptoFileNameCourseApplication CourseApplicationR:

src/Application.hs

@@ -44,7 +44,6 @@ import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as UUID
 
 import System.Directory
-import System.FilePath
 
 import Jobs
 

src/Data/Time/Clock/Instances.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.Time.Clock.Instances
-  (
+  ( iso8601OutputFormat, iso8601ParseFormat
   ) where
 
 import ClassyPrelude
@@ -17,6 +17,8 @@ import Data.Time.Clock
 import Data.Time.Calendar.Instances ()
 import Web.PathPieces
 
+import qualified Data.Csv as Csv
+
 
 instance Hashable DiffTime where
   hashWithSalt s = hashWithSalt s . toRational
@@ -29,12 +31,23 @@ instance PersistFieldSql NominalDiffTime where
   sqlType _ = sqlType (Proxy @Rational)
 
 
+iso8601OutputFormat, iso8601ParseFormat :: String
+iso8601OutputFormat = "%0Y-%m-%dT%H:%M:%S%Q%z"
+iso8601ParseFormat = "%Y-%m-%dT%H:%M:%S%Q%z"
+
+
 deriving instance Generic UTCTime
 instance Hashable UTCTime
 
 instance PathPiece UTCTime where
-  toPathPiece = pack . formatTime defaultTimeLocale "%0Y-%m-%dT%H:%M:%S%Q%z"
+  toPathPiece = pack . formatTime defaultTimeLocale iso8601OutputFormat
-  fromPathPiece = parseTimeM False defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%z" . unpack
+  fromPathPiece = parseTimeM False defaultTimeLocale iso8601ParseFormat . unpack
+
+instance Csv.ToField UTCTime where
+  toField = Csv.toField . formatTime defaultTimeLocale iso8601OutputFormat
+
+instance Csv.FromField UTCTime where
+  parseField = parseTimeM False defaultTimeLocale iso8601ParseFormat <=< Csv.parseField
 
 
 instance Binary DiffTime where

src/Data/Time/LocalTime/Instances.hs

@@ -12,6 +12,12 @@ import Data.Binary (Binary)
 
 import qualified Language.Haskell.TH.Syntax as TH
 
+import qualified Data.Csv as Csv
+
+import Data.Time.Clock.Instances
+  ( iso8601OutputFormat, iso8601ParseFormat
+  )
+
 
 deriving instance Generic TimeOfDay
 deriving instance Typeable TimeOfDay
@@ -21,3 +27,9 @@ instance Binary TimeOfDay
 
 
 deriving instance TH.Lift TimeZone
+
+instance Csv.ToField ZonedTime where
+  toField = Csv.toField . formatTime defaultTimeLocale iso8601OutputFormat
+
+instance Csv.FromField ZonedTime where
+  parseField = parseTimeM False defaultTimeLocale iso8601ParseFormat <=< Csv.parseField

src/Database/Esqueleto/Utils.hs

@@ -6,7 +6,6 @@ module Database.Esqueleto.Utils
   , isInfixOf, hasInfix
   , or, and
   , any, all
-  , SqlIn(..)
   , mkExactFilter, mkExactFilterWith
   , mkContainsFilter, mkContainsFilterWith
   , mkExistsFilter
@@ -19,6 +18,7 @@ module Database.Esqueleto.Utils
   , sha256
   , maybe
   , SqlProject(..)
+  , module Database.Esqueleto.Utils.TH
   ) where
 
 

src/Foundation.hs

@@ -66,6 +66,7 @@ import qualified Control.Monad.Catch as C
 
 import Handler.Utils.StudyFeatures
 import Handler.Utils.SchoolLdap
+import Handler.Utils.ExamOffice.Exam.Auth
 import Utils.Form
 import Utils.Sheet
 import Utils.SystemMessage
@@ -652,7 +653,22 @@ tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of
     adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin] []
     guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin)
     return Authorized
-tagAccessPredicate AuthExamOffice = APDB $ \mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do
+tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of
+  CExamR tid ssh csh examn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, examn) . exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    hasUsers <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examResult) -> do
+      E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
+      E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
+
+      E.where_ $ course E.^. CourseTerm E.==. E.val tid
+           E.&&. course E.^. CourseSchool E.==. E.val ssh
+           E.&&. course E.^. CourseShorthand E.==. E.val csh
+           E.&&. exam E.^. ExamName E.==. E.val examn
+
+      E.where_ $ examOfficeExamResultAuth (E.val authId) examResult
+    guardMExceptT hasUsers (unauthorizedI MsgUnauthorizedExamExamOffice)
+    return Authorized
+  _other -> $cachedHereBinary mAuthId . exceptT return return $ do
     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
     adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice] []
     guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedExamOffice)
@@ -1836,7 +1852,8 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb (CExamR tid ssh csh examn EShowR) = return (original examn, Just $ CourseR tid ssh csh CExamListR)
   breadcrumb (CExamR tid ssh csh examn EEditR) = return ("Bearbeiten", Just $ CExamR tid ssh csh examn EShowR)
   breadcrumb (CExamR tid ssh csh examn EUsersR) = return ("Teilnehmer", Just $ CExamR tid ssh csh examn EShowR)
-  breadcrumb (CExamR tid ssh csh examn EAddUserR)  = return ("Prüfungsteilnehmer hinzufügen", Just $ CExamR tid ssh csh examn EUsersR)
+  breadcrumb (CExamR tid ssh csh examn EAddUserR) = return ("Prüfungsteilnehmer hinzufügen", Just $ CExamR tid ssh csh examn EUsersR)
+  breadcrumb (CExamR tid ssh csh examn EGradesR) = return ("Prüfungsleistungen", Just $ CExamR tid ssh csh examn EShowR)
 
   breadcrumb (CTutorialR tid ssh csh tutn TUsersR)   = return (original tutn, Just $ CourseR tid ssh csh CTutorialListR)
   breadcrumb (CTutorialR tid ssh csh tutn TEditR)    = return ("Bearbeiten", Just $ CTutorialR tid ssh csh tutn TUsersR)
@@ -2617,6 +2634,14 @@ pageActions (CExamR tid ssh csh examn EShowR) =
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
+  , MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuExamGrades
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EGradesR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
   ]
 pageActions (CExamR tid ssh csh examn EUsersR) =
   [ MenuItem

src/Handler/Admin.hs

@@ -21,7 +21,6 @@ import Database.Persist.Sql (fromSqlKey)
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils (mkExactFilter, mkContainsFilter)
 
-import Handler.Utils.Table.Cells
 import qualified Handler.Utils.TermCandidates as Candidates
 
 -- import Colonnade hiding (fromMaybe)

src/Handler/Corrections.hs

@@ -4,10 +4,9 @@ import Import
 -- import System.FilePath (takeFileName)
 
 import Jobs
-import Handler.Utils
+import Handler.Utils hiding (colSchool)
 import Handler.Utils.Corrections
 import Handler.Utils.Submission
-import Handler.Utils.Table.Cells
 import Handler.Utils.SheetType
 import Handler.Utils.Delete
 -- import Handler.Utils.Zip

src/Handler/Course/Application/List.hs

@@ -7,7 +7,6 @@ module Handler.Course.Application.List
 import Import
 
 import Handler.Utils
-import Handler.Utils.Table.Columns
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
@@ -213,6 +212,7 @@ postCApplicationsR tid ssh csh = do
   table <- runDB $ do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
 
+    csvName <- getMessageRender <*> pure (MsgCourseApplicationsTableCsvName tid ssh csh)
     let
       allocationLink :: Allocation -> SomeRoute UniWorX
       allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
@@ -320,8 +320,7 @@ postCApplicationsR tid ssh csh = do
         }
       dbtParams = def
 
-      dbtCsvEncode :: DBTCsvEncode CourseApplicationsTableData CourseApplicationsTableCsv
+      dbtCsvEncode = simpleCsvEncodeM csvName $ CourseApplicationsTableCsv
-      dbtCsvEncode = DictJust . C.mapM . runReaderT $ CourseApplicationsTableCsv
         <$> preview (resultAllocation . _entityVal . _allocationShorthand)
         <*> (preview (resultCourseApplication . _entityKey) >>= traverse encrypt)
         <*> preview (resultUser . _entityVal . _userDisplayName)

src/Handler/Course/List.hs

@@ -12,8 +12,7 @@ import Data.Maybe (fromJust)
 
 import Utils.Form
 -- import Utils.DB
-import Handler.Utils
+import Handler.Utils hiding (colSchoolShort)
-import Handler.Utils.Table.Cells
 
 import Data.Function ((&))
 

src/Handler/Course/Show.hs

@@ -7,7 +7,6 @@ import Import
 
 import Utils.Form
 import Handler.Utils
-import Handler.Utils.Table.Cells
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 

src/Handler/Course/Users.hs

@@ -11,9 +11,6 @@ import Import
 
 import Utils.Form
 import Handler.Utils
-import Handler.Utils.Database
-import Handler.Utils.Table.Cells
-import Handler.Utils.Table.Columns
 import Database.Persist.Sql (deleteWhereCount)
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH

src/Handler/Exam/List.hs

@@ -5,7 +5,6 @@ module Handler.Exam.List
 import Import
 
 import Handler.Utils
-import Handler.Utils.Table.Cells
   
 import qualified Data.Map as Map
 

src/Handler/Exam/Users.hs

@@ -8,8 +8,6 @@ import Import
 
 import Handler.Utils
 import Handler.Utils.Exam
-import Handler.Utils.Table.Columns
-import Handler.Utils.Table.Cells
 import Handler.Utils.Csv
 
 import qualified Database.Esqueleto as E
@@ -242,6 +240,8 @@ postEUsersR tid ssh csh examn = do
       resultView :: ExamResultGrade -> ExamResultPassedGrade
       resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades
 
+    csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn)
+
     let
       examUsersDBTable = DBTable{..}
         where
@@ -357,8 +357,7 @@ postEUsersR tid ssh csh examn = do
             }
           dbtIdent :: Text
           dbtIdent = "exam-users"
-          dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
+          dbtCsvEncode = simpleCsvEncode csvName $ ExamUserTableCsv
-          dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
             <$> view (resultUser . _entityVal . _userSurname . to Just)
             <*> view (resultUser . _entityVal . _userFirstName . to Just)
             <*> view (resultUser . _entityVal . _userDisplayName . to Just)

src/Handler/ExamOffice/Exam.hs

@@ -1,14 +1,370 @@
 module Handler.ExamOffice.Exam
-  ( getEGradesR
+  ( getEGradesR, postEGradesR
-  , postEGradesReadR
   ) where
 
 import Import
+import Handler.Utils
+import Handler.Utils.Exam
+import Handler.Utils.Csv
+import Handler.Utils.ExamOffice.Exam.Auth
 
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+
+import qualified Data.Csv as Csv
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+
+import qualified Data.Conduit.List as C
+import qualified Colonnade
+
+
+type ExamUserTableExpr = (              E.SqlExpr (Entity ExamResult)
+                          `E.InnerJoin` E.SqlExpr (Entity User)
+                         )
+       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamRegistration))
+       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence))
+       `E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity CourseParticipant))
+         `E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity StudyFeatures))
+               `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
+               `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
+                           )
+                         )
+type ExamUserTableData = DBRow ( Entity ExamResult
+                               , Entity User
+                               , Maybe (Entity ExamOccurrence)
+                               , Maybe (Entity StudyFeatures)
+                               , Maybe (Entity StudyDegree)
+                               , Maybe (Entity StudyTerms)
+                               , Maybe (Entity ExamRegistration)
+                               , [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
+                               )
+
+queryExamRegistration :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity ExamRegistration)))
+queryExamRegistration = to $ $(E.sqlLOJproj 4 2)
+
+queryUser :: Getter ExamUserTableExpr (E.SqlExpr (Entity User))
+queryUser = to $ $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 4 1)
+
+queryExamOccurrence :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity ExamOccurrence)))
+queryExamOccurrence = to $(E.sqlLOJproj 4 3)
+
+queryCourseParticipant :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity CourseParticipant)))
+queryCourseParticipant = to $ $(E.sqlLOJproj 2 1) . $(E.sqlLOJproj 4 4)
+
+queryStudyFeatures :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity StudyFeatures)))
+queryStudyFeatures = to $ $(E.sqlIJproj 3 1) . $(E.sqlLOJproj 2 2) . $(E.sqlLOJproj 4 4)
+
+queryStudyDegree :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity StudyDegree)))
+queryStudyDegree = to $ $(E.sqlIJproj 3 2) . $(E.sqlLOJproj 2 2) . $(E.sqlLOJproj 4 4)
+
+queryStudyField :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity StudyTerms)))
+queryStudyField = to $ $(E.sqlIJproj 3 3) . $(E.sqlLOJproj 2 2) . $(E.sqlLOJproj 4 4)
+
+queryExamResult :: Getter ExamUserTableExpr (E.SqlExpr (Entity ExamResult))
+queryExamResult = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 4 1)
+
+-- resultExamRegistration :: Traversal' ExamUserTableData (Entity ExamRegistration)
+-- resultExamRegistration = _dbrOutput . _7 . _Just
+
+queryIsSynced :: Getter ExamUserTableExpr (E.SqlExpr (E.Value Bool))
+queryIsSynced = to . runReader $ do
+  examResult <- view queryExamResult
+  let
+    lastSync = E.sub_select . E.from $ \examOfficeResultSynced -> do
+      E.where_ $ examOfficeResultSynced E.^. ExamOfficeResultSyncedResult E.==. examResult E.^. ExamResultId
+      return . E.max_ $ examOfficeResultSynced E.^. ExamOfficeResultSyncedTime
+  return $ E.maybe E.false (E.>=. examResult E.^. ExamResultLastChanged) lastSync
+
+resultUser :: Lens' ExamUserTableData (Entity User)
+resultUser = _dbrOutput . _2
+
+resultStudyFeatures :: Traversal' ExamUserTableData (Entity StudyFeatures)
+resultStudyFeatures = _dbrOutput . _4 . _Just
+
+resultStudyDegree :: Traversal' ExamUserTableData (Entity StudyDegree)
+resultStudyDegree = _dbrOutput . _5 . _Just
+
+resultStudyField :: Traversal' ExamUserTableData (Entity StudyTerms)
+resultStudyField = _dbrOutput . _6 . _Just
+
+resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence)
+resultExamOccurrence = _dbrOutput . _3 . _Just
+
+resultExamResult :: Lens' ExamUserTableData (Entity ExamResult)
+resultExamResult = _dbrOutput . _1
+
+resultSynchronised :: Traversal' ExamUserTableData (UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)
+resultSynchronised = _dbrOutput . _8 . traverse
+
+data ExamUserTableCsv = ExamUserTableCsv
+  { csvEUserSurname :: Text
+  , csvEUserFirstName :: Text
+  , csvEUserName :: Text
+  , csvEUserMatriculation :: Maybe Text
+  , csvEUserField :: Maybe Text
+  , csvEUserDegree :: Maybe Text
+  , csvEUserSemester :: Maybe Int
+  , csvEUserOccurrenceStart :: Maybe ZonedTime
+  , csvEUserExamResult :: ExamResultPassedGrade
+  }
+  deriving (Generic)
+makeLenses_ ''ExamUserTableCsv
+
+examUserTableCsvOptions :: Csv.Options
+examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3 }
+
+instance ToNamedRecord ExamUserTableCsv where
+  toNamedRecord = Csv.genericToNamedRecord examUserTableCsvOptions
+
+instance DefaultOrdered ExamUserTableCsv where
+  headerOrder = Csv.genericHeaderOrder examUserTableCsvOptions
+
+instance CsvColumnsExplained ExamUserTableCsv where
+  csvColumnsExplanations = genericCsvColumnsExplanations examUserTableCsvOptions $ Map.fromList
+    [ ('csvEUserSurname             , MsgCsvColumnExamUserSurname                   )
+    , ('csvEUserFirstName           , MsgCsvColumnExamUserFirstName                 )
+    , ('csvEUserName                , MsgCsvColumnExamUserName                      )
+    , ('csvEUserMatriculation       , MsgCsvColumnExamUserMatriculation             )
+    , ('csvEUserField               , MsgCsvColumnExamUserField                     )
+    , ('csvEUserDegree              , MsgCsvColumnExamUserDegree                    )
+    , ('csvEUserSemester            , MsgCsvColumnExamUserSemester                  )
+    , ('csvEUserOccurrenceStart     , MsgCsvColumnExamOfficeExamUserOccurrenceStart )
+    , ('csvEUserExamResult          , MsgCsvColumnExamUserResult                    )
+    ]
+
+data ExamUserAction = ExamUserMarkSynchronised
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+
+instance Universe ExamUserAction
+instance Finite ExamUserAction
+nullaryPathPiece ''ExamUserAction $ camelToPathPiece' 2
+embedRenderMessage ''UniWorX ''ExamUserAction id
+
+data ExamUserActionData = ExamUserMarkSynchronisedData
+
+data ExamUserCsvExportData = ExamUserCsvExportData
+  { csvEUserMarkSynchronised :: Bool
+  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+  
 -- | View a list of all users' grades that the current user has access to
-getEGradesR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
+getEGradesR, postEGradesR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
-getEGradesR = fail "not implemented"
+getEGradesR = postEGradesR
+postEGradesR tid ssh csh examn = do
+  uid <- requireAuthId
+  now <- liftIO getCurrentTime
+  (usersResult, examUsersTable) <- runDB $ do
+    Entity eid Exam{..} <- fetchExam tid ssh csh examn
 
--- | Mark all users' grades that the current user has access to as "read"
+    csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn)
-postEGradesReadR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
+    isLecturer <- hasReadAccessTo $ CExamR tid ssh csh examn EUsersR
-postEGradesReadR = fail "not implemented"
+
+    let
+      participantLink :: MonadCrypto m => UserId -> m (SomeRoute UniWorX)
+      participantLink partId = do
+        cID <- encrypt partId
+        return . SomeRoute . CourseR tid ssh csh $ CUserR cID
+
+      examUsersDBTable = DBTable{..}
+        where
+          dbtSQLQuery = runReaderT $ do
+            examResult <- view queryExamResult
+            user <- view queryUser
+            examRegistration <- view queryExamRegistration
+            occurrence <- view queryExamOccurrence
+            courseParticipant <- view queryCourseParticipant
+            studyFeatures <- view queryStudyFeatures
+            studyDegree <- view queryStudyDegree
+            studyField <- view queryStudyField
+
+            lift $ do
+              E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
+              E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
+              E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
+              E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
+               E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
+              E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
+               E.&&. occurrence E.?. ExamOccurrenceId   E.==. E.joinV (examRegistration E.?. ExamRegistrationOccurrence)
+              E.on $ examRegistration E.?. ExamRegistrationUser E.==. E.just (user E.^. UserId)
+              E.on $ examResult E.^. ExamResultUser E.==. user E.^. UserId
+               E.&&. examResult E.^. ExamResultExam E.==. E.val eid
+
+              E.where_ $ examResult E.^. ExamResultExam E.==. E.val eid
+
+              unless isLecturer $ 
+                E.where_ $ examOfficeExamResultAuth (E.val uid) examResult
+
+            return (examResult, user, occurrence, studyFeatures, studyDegree, studyField, examRegistration)
+          dbtRowKey = views queryExamResult (E.^. ExamResultId)
+
+          dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) ExamUserTableData
+          dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $
+            (,,,,,,,)
+              <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> view _6 <*> view _7
+              <*> getSynchronised
+            where
+              getSynchronised :: ReaderT _ (MaybeT (YesodDB UniWorX)) [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
+              getSynchronised = do
+                resId <- view $ _1 . _entityKey
+                syncs <- lift . lift . E.select . E.from $ \((examOfficeResultSynced `E.InnerJoin` user) `E.LeftOuterJoin` userFunction) -> do
+                  E.on $ userFunction E.?. UserFunctionUser E.==. E.just (user E.^. UserId)
+                   E.&&. userFunction E.?. UserFunctionFunction E.==. E.just (E.val SchoolExamOffice)
+                  E.on $ examOfficeResultSynced E.^. ExamOfficeResultSyncedOffice E.==. user E.^. UserId
+                  E.where_ $ examOfficeResultSynced E.^. ExamOfficeResultSyncedResult E.==. E.val resId
+                  return ( examOfficeResultSynced E.^. ExamOfficeResultSyncedOffice
+                         , ( user E.^. UserDisplayName
+                           , user E.^. UserSurname
+                           , examOfficeResultSynced E.^. ExamOfficeResultSyncedTime
+                           , userFunction E.?. UserFunctionSchool
+                           )
+                         )
+                let syncs' = Map.fromListWith
+                               (\(dn, sn, t, sshs) (_, _, _, sshs') -> (dn, sn, t, Set.union sshs sshs'))
+                               [ (officeId, (dn, sn, t, maybe Set.empty Set.singleton ssh'))
+                               | (E.Value officeId, (E.Value dn, E.Value sn, E.Value t, fmap unSchoolKey . E.unValue -> ssh')) <- syncs
+                               ]
+                return $ Map.elems syncs'
+
+          colSynced = Colonnade.singleton (fromSortable . Sortable (Just "is-synced") $ i18nCell MsgExamUserSynchronised) $ \x -> cell . flip runReaderT x $ do
+            syncs <- asks $ sortOn (Down . view _3) . toListOf resultSynchronised
+            lastChange <- view $ resultExamResult . _entityVal . _examResultLastChanged
+            user <- view $ resultUser . _entityVal
+            let
+              lastSync = maximumOf (folded . _3) syncs
+              hasSyncs = has folded syncs
+
+              syncs' = [ Right sync | sync@(_, _, t, _) <- syncs, t >  lastChange]
+                    ++ [ Left lastChange ]
+                    ++ [ Right sync | sync@(_, _, t, _) <- syncs, t <= lastChange]
+              
+              syncIcon :: Widget
+              syncIcon = case lastSync of
+                Nothing -> mempty
+                Just ts
+                  | ts >= lastChange
+                    -> toWidget iconOK
+                  | otherwise
+                    -> toWidget iconNotOK
+            
+              syncsModal :: Widget
+              syncsModal = $(widgetFile "exam-office/exam-result-synced")
+            lift $ bool id (flip modal $ Right syncsModal) hasSyncs syncIcon
+
+          dbtColonnade :: Colonnade Sortable _ _
+          dbtColonnade = mconcat
+            [ dbSelect (applying _2) id $ return . view (resultExamResult . _entityKey)
+            , colSynced
+            , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
+            , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
+            , emptyOpticColonnade (resultStudyField . _entityVal) colStudyTerms
+            , emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree
+            , emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester
+            , emptyOpticColonnade (resultExamOccurrence . _entityVal . _examOccurrenceStart <> like examStart . _Just) colOccurrenceStart
+            , colExamResult examShowGrades (resultExamResult . _entityVal . _examResultResult)
+            ]
+          dbtSorting = mconcat
+            [ sortUserName' (queryUser . to ((,) <$> (E.^. UserDisplayName) <*> (E.^. UserSurname)))
+            , sortUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
+            , sortStudyTerms queryStudyField
+            , sortStudyDegree queryStudyDegree
+            , sortStudyFeaturesSemester (queryStudyFeatures . to (E.?. StudyFeaturesSemester))
+            , sortOccurrenceStart (queryExamOccurrence . to (E.maybe (E.val examStart) E.just . (E.?. ExamOccurrenceStart)))
+            , maybeOpticSortColumn (sortExamResult examShowGrades) (queryExamResult . to (E.^. ExamResultResult))
+            , singletonMap "is-synced" . SortColumn $ view queryIsSynced
+            ]
+          dbtFilter = mconcat
+            [ fltrUserName' (queryUser . to (E.^. UserDisplayName))
+            , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
+            , fltrStudyTerms queryStudyField
+            , fltrStudyDegree queryStudyDegree
+            , fltrStudyFeaturesSemester (queryStudyFeatures . to (E.?. StudyFeaturesSemester))
+            , fltrExamResultPoints examShowGrades (queryExamResult . to (E.^. ExamResultResult))
+            , singletonMap "is-synced" . FilterColumn $ E.mkExactFilter (view queryIsSynced)
+            ]
+          dbtFilterUI = mconcat
+            [ fltrUserNameUI'
+            , fltrUserMatriculationUI
+            , fltrStudyTermsUI
+            , fltrStudyDegreeUI
+            , fltrStudyFeaturesSemesterUI
+            , fltrExamResultPointsUI examShowGrades
+            , \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgExamUserSynchronised)
+            ]
+          dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
+          dbtParams = DBParamsForm
+            { dbParamsFormMethod = POST
+            , dbParamsFormAction = Just . SomeRoute $ CExamR tid ssh csh examn EGradesR
+            , dbParamsFormAttrs  = []
+            , dbParamsFormSubmit = FormSubmit
+            , dbParamsFormAdditional = \csrf -> do
+                let
+                  actionMap :: Map ExamUserAction (AForm Handler ExamUserActionData)
+                  actionMap = Map.fromList
+                    [ ( ExamUserMarkSynchronised
+                      , pure ExamUserMarkSynchronisedData
+                      )
+                    ]
+                (res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
+                let formRes = (, mempty) . First . Just <$> res
+                return (formRes, formWgt)
+            , dbParamsFormEvaluate = liftHandlerT . runFormPost
+            , dbParamsFormResult   = id
+            , dbParamsFormIdent    = def
+            }
+          dbtIdent :: Text
+          dbtIdent = "exam-results"
+          dbtCsvEncode = Just DBTCsvEncode
+            { dbtCsvExportForm = ExamUserCsvExportData
+              <$> apopt checkBoxField (fslI MsgExamUserMarkSynchronisedCsv) (Just True)
+            , dbtCsvDoEncode = \ExamUserCsvExportData{..} -> C.mapM $ \(E.Value k, row) -> do
+                when csvEUserMarkSynchronised $
+                  void $ upsert ExamOfficeResultSynced
+                    { examOfficeResultSyncedOffice = uid
+                    , examOfficeResultSyncedResult = k
+                    , examOfficeResultSyncedTime   = now
+                    }
+                    [ ExamOfficeResultSyncedTime =. now
+                    ]
+                return $ ExamUserTableCsv
+                  (row ^. resultUser . _entityVal . _userSurname)
+                  (row ^. resultUser . _entityVal . _userFirstName)
+                  (row ^. resultUser . _entityVal . _userDisplayName)
+                  (row ^. resultUser . _entityVal . _userMatrikelnummer)
+                  (row ^? resultStudyField . _entityVal . to (\StudyTerms{..} -> fromMaybe (tshow studyTermsKey) $ studyTermsName <|> studyTermsShorthand))
+                  (row ^? resultStudyDegree . _entityVal . to (\StudyDegree{..} -> fromMaybe (tshow studyDegreeKey) $ studyDegreeName <|> studyDegreeShorthand))
+                  (row ^? resultStudyFeatures . _entityVal . _studyFeaturesSemester)
+                  (row ^? (resultExamOccurrence . _entityVal . _examOccurrenceStart <> like examStart . _Just) . to utcToZonedTime)
+                  (row ^. resultExamResult . _entityVal . _examResultResult . to (fmap $ bool (Left . view passingGrade) Right examShowGrades))
+            , dbtCsvName = unpack csvName
+            , dbtCsvNoExportData = Nothing
+            }
+          dbtCsvDecode = Nothing
+
+      examUsersDBTableValidator = def & defaultSorting [SortAscBy "is-synced", SortAscBy "user-name"]
+                                      & defaultPagesize PagesizeAll
+
+      postprocess :: FormResult (First ExamUserActionData, DBFormResult ExamResultId Bool ExamUserTableData) -> FormResult (ExamUserActionData, Set ExamResultId)
+      postprocess inp = do
+        (First (Just act), regMap) <- inp
+        let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap
+        return (act, regSet)
+    over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
+
+  formResult usersResult $ \case
+    (ExamUserMarkSynchronisedData, selectedResults) -> do
+      runDB . forM_ selectedResults $ \resId ->
+        void $ upsert ExamOfficeResultSynced
+          { examOfficeResultSyncedOffice = uid
+          , examOfficeResultSyncedResult = resId
+          , examOfficeResultSyncedTime   = now
+          }
+          [ ExamOfficeResultSyncedTime =. now
+          ]
+      addMessageI Success $ MsgExamUserMarkedSynchronised (length selectedResults)
+      redirect $ CExamR tid ssh csh examn EGradesR
+
+  siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamOfficeExamUsersHeading) $ do
+    setTitleI $ prependCourseTitle tid ssh csh MsgExamOfficeExamUsersHeading
+    $(widgetFile "exam-office/exam-results")

src/Handler/Home.hs

@@ -3,8 +3,6 @@ module Handler.Home where
 import Import
 
 import Handler.Utils
-import Handler.Utils.Table.Cells
-
 
 import qualified Data.Map as Map
 import Database.Esqueleto.Utils.TH

src/Handler/Material.hs

@@ -17,8 +17,6 @@ import Database.Esqueleto.Utils.TH
 import Utils.Form
 import Handler.Utils
 import Handler.Utils.Delete
-import Handler.Utils.Table.Cells
-import Handler.Utils.Table.Columns
 
 import Control.Monad.Writer (MonadWriter(..), execWriterT)
 

src/Handler/Profile.hs

@@ -3,7 +3,6 @@ module Handler.Profile where
 import Import
 
 import Handler.Utils
-import Handler.Utils.Table.Cells
 
 -- import Colonnade hiding (fromMaybe, singleton)
 -- import Yesod.Colonnade

src/Handler/School.hs

@@ -2,7 +2,6 @@ module Handler.School where
 
 import Import
 import Handler.Utils
-import Handler.Utils.Table.Columns
 
 import qualified Database.Esqueleto as E
 

src/Handler/Sheet.hs

@@ -10,8 +10,6 @@ import Jobs.Queue
 import Utils.Sheet
 import Handler.Utils
 -- import Handler.Utils.Zip
-import Handler.Utils.Table.Cells
--- import Handler.Utils.Table.Columns
 import Handler.Utils.SheetType
 import Handler.Utils.Delete
 import Handler.Utils.Invitations

src/Handler/Submission.hs

@@ -11,7 +11,6 @@ import Jobs
 import Handler.Utils
 import Handler.Utils.Delete
 import Handler.Utils.Submission
-import Handler.Utils.Table.Cells
 import Handler.Utils.Invitations
 
 -- import Control.Monad.Trans.Maybe

src/Handler/SystemMessage.hs

@@ -9,7 +9,6 @@ import qualified Data.Set as Set
 import qualified Data.List.NonEmpty as NonEmpty
 
 import Handler.Utils
-import Handler.Utils.Table.Cells
 
 import qualified Database.Esqueleto as E
 

src/Handler/Term.hs

@@ -2,7 +2,6 @@ module Handler.Term where
 
 import Import
 import Handler.Utils
-import Handler.Utils.Table.Cells
 import qualified Data.Map as Map
 
 import qualified Database.Esqueleto as E

src/Handler/Tutorial.hs

@@ -7,7 +7,6 @@ module Handler.Tutorial
 import Import
 import Handler.Utils
 import Handler.Utils.Tutorial
-import Handler.Utils.Table.Cells
 import Handler.Utils.Delete
 import Handler.Utils.Communication
 import Handler.Utils.Form.Occurrences

src/Handler/Tutorial/Users.hs

@@ -8,7 +8,6 @@ import Utils.Form
 -- import Utils.DB
 import Handler.Utils
 import Handler.Utils.Tutorial
-import Handler.Utils.Table.Columns
 import Database.Persist.Sql (deleteWhereCount)
 
 import qualified Data.CaseInsensitive as CI

src/Handler/Users.hs

@@ -10,7 +10,6 @@ import Handler.Utils
 import Handler.Utils.Tokens
 import Handler.Utils.Users
 import Handler.Utils.Invitations
-import Handler.Utils.Table.Cells
 
 import qualified Auth.LDAP as Auth
 

src/Handler/Utils.hs

@@ -4,21 +4,15 @@ module Handler.Utils
 
 import Import
 
-import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Data.Map ((!))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Data.CaseInsensitive (original)
--- import qualified Data.CaseInsensitive as CI
 import qualified Data.Conduit.List as Conduit
 
-import Text.Hamlet (shamletFile)
-
 import Handler.Utils.DateTime as Handler.Utils
 import Handler.Utils.Form as Handler.Utils
 import Handler.Utils.Table as Handler.Utils
-import Handler.Utils.Table.Pagination as Handler.Utils
 
 import Handler.Utils.Zip        as Handler.Utils
 import Handler.Utils.Rating     as Handler.Utils hiding (extractRatings)
@@ -27,6 +21,8 @@ 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 Handler.Utils.Widgets    as Handler.Utils
+import Handler.Utils.Database   as Handler.Utils
 
 import System.FilePath.Posix (takeFileName)
 
@@ -88,91 +84,6 @@ serveZipArchive archiveName source = do
         source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
 
 
-
----------
--- Simple utilities for consistent display
--- Please use these throughout, to ensure that users have a consistent experience
-
-tidFromText :: Text -> Maybe TermId
-tidFromText = fmap TermKey . maybeRight . termFromText
-
--- | Display given UTCTime and maybe an invisible icon if it is in the future
---
---   Also see `Handler.Utils.Table.Cells.dateTimeCellVisible` for a similar function (in case of refactoring)
-visibleUTCTime :: SelDateTimeFormat -> UTCTime -> Widget
-visibleUTCTime dtf t = do
-    let timeStampWgt = formatTimeW dtf t
-    now <- liftIO getCurrentTime
-    if now >= t
-      then timeStampWgt
-      else $(widgetFile "widgets/date-time/yet-invisible")
-
-
--- | Simple link to a known route
-simpleLink :: Widget -> Route UniWorX -> Widget
-simpleLink lbl url = [whamlet|<a href=@{url}>^{lbl}|]
-
-simpleLinkI :: SomeMessage UniWorX -> Route UniWorX -> Widget
-simpleLinkI lbl url = [whamlet|<a href=@{url}>_{lbl}|]
-
--- | toWidget-Version of @nameHtml@, for convenience
-nameWidget :: Text    -- ^ userDisplayName
-           -> Text    -- ^ userSurname
-           -> Widget
-nameWidget displayName surname = toWidget $ nameHtml displayName surname
-
--- | toWidget-Version of @nameEmailHtml@, for convenience
-nameEmailWidget :: UserEmail -- ^ userEmail
-                -> Text    -- ^ userDisplayName
-                -> Text    -- ^ userSurname
-                -> Widget
-nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname
-
--- | uncurried Version for @nameEmailWidget@ needed in hamlet, where TH cannot be used
-nameEmailWidget' :: (UserEmail, Text, Text)-> Widget
-nameEmailWidget' = $(uncurryN 3) nameEmailWidget
-
--- | Show user's displayName, highlighting the surname if possible.
---   Otherwise appends the surname in parenthesis
-nameHtml :: Text -> Text -> Html
-nameHtml displayName surname
-  | null surname = toHtml displayName
-  | otherwise = case reverse $ T.splitOn surname displayName of
-      [_notContained] -> [shamlet|$newline never
-                            #{displayName} (
-                            <b .surname>#{surname}
-                            )|]
-      (suffix:prefixes) ->
-        let prefix = T.intercalate surname $ reverse prefixes
-        in [shamlet|$newline never
-              #{prefix}
-              <b .surname>#{surname}
-              #{suffix}
-            |]
-      [] -> error "Data.Text.splitOn returned empty list in violation of specification."
-
--- | Like nameHtml just show a users displayname with hightlighted surname,
---   but also wrap the name with a mailto-link
-nameEmailHtml :: UserEmail -> Text -> Text -> Html
-nameEmailHtml email displayName surname =
-  wrapMailto email $ nameHtml displayName surname
-
--- | Wrap mailto around given Html using single hamlet-file for consistency
-wrapMailto :: UserEmail -> Html -> Html
-wrapMailto (original -> email) linkText
-  | null email = linkText
-  | otherwise  = $(shamletFile "templates/widgets/link-email.hamlet")
-
--- | Just show an email address in a standard way, for convenience inside hamlet files.
-mailtoHtml :: UserEmail -> Html
-mailtoHtml email = wrapMailto email $(shamletFile "templates/widgets/email.hamlet")
-
--- | Generic i18n text for "edited at sometime by someone"
-editedByW :: SelDateTimeFormat -> UTCTime -> Text -> Widget
-editedByW fmt tm usr  = do
-  ft <- handlerToWidget $ formatTime fmt tm
-  [whamlet|_{MsgEditedBy usr ft}|]
-
 -- | Prefix a message with a short course id,
 --   eg. for window title bars, etc.
 --   This function should help to make this consistent everywhere

src/Handler/Utils/DateTime.hs

@@ -1,5 +1,5 @@
 module Handler.Utils.DateTime
-  ( utcToLocalTime
+  ( utcToLocalTime, utcToZonedTime
   , localTimeToUTC, TZ.LocalToUTCResult(..)
   , toMidnight, beforeMidnight, toMidday, toMorning
   , formatDiffDays
@@ -20,7 +20,7 @@ import Import
 import Data.Time.Zones
 import qualified Data.Time.Zones as TZ
 
-import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime)
+import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime, utcToZonedTime)
 -- import Data.Time.Clock (addUTCTime,nominalDay)
 import qualified Data.Time.Format as Time
 
@@ -37,6 +37,9 @@ import Data.Time.Clock.System (systemEpochDay)
 utcToLocalTime :: UTCTime -> LocalTime
 utcToLocalTime = TZ.utcToLocalTimeTZ appTZ
 
+utcToZonedTime :: UTCTime -> ZonedTime
+utcToZonedTime = ZonedTime <$> TZ.utcToLocalTimeTZ appTZ <*> TZ.timeZoneForUTCTime appTZ
+
 localTimeToUTC :: LocalTime -> LocalToUTCResult
 localTimeToUTC = TZ.localTimeToUTCFull appTZ
 

src/Handler/Utils/ExamOffice/Exam/Auth.hs

@@ -0,0 +1,34 @@
+module Handler.Utils.ExamOffice.Exam.Auth
+  ( examOfficeExamResultAuth
+  ) where
+
+import Import.NoFoundation
+
+import qualified Database.Esqueleto as E
+
+
+examOfficeExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office
+                         -> E.SqlExpr (Entity ExamResult)
+                         -> E.SqlExpr (E.Value Bool)
+examOfficeExamResultAuth authId examResult = authByUser E.||. authByField
+  where
+    authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do
+      E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField
+      E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. examResult E.^. ExamResultUser
+           E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId
+           E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField
+      E.where_ $ examOfficeField E.^. ExamOfficeFieldForced
+           E.||. E.exists (E.from $ \userFunction ->
+                             E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
+                                  E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
+                                  E.&&. E.not_ (E.exists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` courseUserExamOfficeOptOut) -> do
+                                                  E.on $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutCourse E.==. course E.^. CourseId
+                                                  E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
+                                                  E.where_ $ exam E.^. ExamId E.==. examResult E.^. ExamResultExam
+                                                  E.where_ $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutUser E.==. examResult E.^. ExamResultUser
+                                                    E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutSchool E.==. userFunction E.^. UserFunctionSchool
+                                               )
+                          )
+    authByUser = E.exists . E.from $ \examOfficeUser ->
+      E.where_ $ examOfficeUser E.^. ExamOfficeUserOffice E.==. authId
+           E.&&. examOfficeUser E.^. ExamOfficeUserUser E.==. examResult E.^. ExamResultUser

src/Handler/Utils/Rating.hs

@@ -32,7 +32,6 @@ import qualified Data.ByteString.Lazy as Lazy.ByteString
 
 import Text.Read (readEither)
 
-import System.FilePath
 import qualified System.FilePath.Cryptographic as FilePath (decrypt)
 
 import qualified Database.Esqueleto as E

src/Handler/Utils/Table.hs

@@ -1,4 +1,6 @@
-module Handler.Utils.Table where
+module Handler.Utils.Table
+  ( module Handler.Utils.Table
+  ) where
 -- General Utilities for Tables
 
 import Import
@@ -8,13 +10,18 @@ import Control.Monad.Except
 import Text.Blaze as B
 
 import Colonnade
-import Yesod.Colonnade
+import Yesod.Colonnade as Yesod
 
 import Data.List ((!!))
 import Data.Either
+  
+import Handler.Utils.Table.Pagination as Handler.Utils.Table
+import Handler.Utils.Table.Columns as Handler.Utils.Table
+import Handler.Utils.Table.Cells as Handler.Utils.Table
 
 
 -- Table design
+{-# DEPRECATED tableDefault, tableSortable "Use dbTable" #-}
 tableDefault :: Attribute
 tableDefault = customAttribute "class" "table table-striped table-hover"
 
@@ -22,6 +29,7 @@ tableSortable :: Attribute
 tableSortable = customAttribute "class" "js-sortable"
 
 -- Colonnade Tools
+{-# DEPRECATED numberColonnade, pairColonnade "Use dbTable" #-}
 numberColonnade :: (IsString c) => Colonnade Headed Int c
 numberColonnade = headed "Nr" (fromString.show)
 
@@ -30,6 +38,7 @@ pairColonnade a b = mconcat [ lmap fst a, lmap snd b]
 
 
 -- Table Modification
+{-# DEPRECATED encodeHeadedWidgetTableNumbered, headedRowSelector "Use dbTable" #-}
 encodeHeadedWidgetTableNumbered :: Attribute -> Colonnade Headed a (WidgetT site IO ()) -> [a] -> WidgetT site IO ()
 encodeHeadedWidgetTableNumbered attrs colo tdata =
     encodeWidgetTable attrs (mconcat [numberCol, lmap snd colo]) (zip [1..] tdata)
@@ -76,7 +85,7 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do
 
   let
     selColonnade :: Colonnade Headed Int (Cell UniWorX)
-    selColonnade = headed "Markiert" $ cell . fvInput . (selectionBoxes !!)
+    selColonnade = headed "Markiert" $ Yesod.cell . fvInput . (selectionBoxes !!)
 
     collectResult :: [FormResult a] -> FormResult [a]
     collectResult [] = FormSuccess []

src/Handler/Utils/Table/Cells.hs

@@ -13,7 +13,9 @@ import Control.Monad.Trans.Writer (WriterT)
 
 import Text.Blaze (ToMarkup(..))
 
-import Handler.Utils
+import Handler.Utils.Table.Pagination
+import Handler.Utils.DateTime
+import Handler.Utils.Widgets
 
 import Utils.Occurrences
 

src/Handler/Utils/Table/Columns.hs

@@ -15,8 +15,10 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, anyFilter)
 
-import Handler.Utils
 import Handler.Utils.Table.Cells
+import Handler.Utils.Table.Pagination
+import Handler.Utils.Form
+import Handler.Utils.Widgets
 
 import qualified Data.CaseInsensitive as CI
 
@@ -25,6 +27,8 @@ import Colonnade.Encode (Colonnade(..), OneColonnade(..))
 
 import Text.Blaze (toMarkup)
 
+import qualified Data.Set as Set
+
 
 --------------------------------
 -- Generic Columns
@@ -199,6 +203,57 @@ fltrAllocationActiveUI :: DBFilterUI
 fltrAllocationActiveUI mPrev = prismAForm (singletonFilter "active" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgAllocationActive)
 
 
+---------------------
+-- Exam occurences --
+---------------------
+
+colOccurrenceStart :: OpticColonnade UTCTime
+colOccurrenceStart resultStart = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "occurrence-start") (i18nCell MsgExamOccurrenceStart)
+    body = views resultStart dateTimeCell
+
+sortOccurrenceStart :: PersistField utctime => OpticSortColumn utctime
+sortOccurrenceStart queryStart = singletonMap "occurrence-start" . SortColumn $ view queryStart
+
+------------------
+-- Exam results --
+------------------
+
+colExamResult :: Bool -- ^ Show grades?
+              -> OpticColonnade ExamResultGrade
+colExamResult showGrades resultResult = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "exam-result") (i18nCell MsgExamResult)
+    body = views resultResult $ bool (i18nCell . fmap (view passingGrade)) i18nCell showGrades
+
+sortExamResult :: Bool -- ^ Show grades?
+               -> OpticSortColumn (Maybe ExamResultGrade)
+sortExamResult showGrades queryResult = singletonMap "exam-result" $ if
+  | showGrades -> SortColumn $ view  queryResult
+  | otherwise  -> SortColumn . views queryResult $ E.orderByList [Just ExamVoided, Just ExamNoShow, Just $ ExamAttended Grade50]
+
+fltrExamResultPoints :: Bool -- ^ Show grades?
+                     -> OpticFilterColumn t ExamResultGrade
+fltrExamResultPoints showGrades queryExamResult = singletonMap "exam-result" . FilterColumn $ \row criteria -> if
+  | Set.null criteria -> E.true
+  | otherwise -> let matches :: [ExamResultGrade]
+                     matches = filter (\res -> oany (((==) `on` viewResult) res) criteria) universeF
+
+                     viewResult
+                       | showGrades = id
+                       | otherwise  = fmap (view $ passingGrade . from passingGrade)
+                  in view queryExamResult row `E.in_` E.valList matches
+
+
+fltrExamResultPointsUI :: Bool -- ^ Show grades?
+                       -> DBFilterUI
+fltrExamResultPointsUI showGrades mPrev = prismAForm (singletonFilter "exam-result" . maybePrism _PathPiece) mPrev $ aopt field (fslI MsgExamResult)
+  where
+    field
+      | showGrades = examResultField examGradeField
+      | otherwise  = convertField (over _examResult $ review passingGrade) (over _examResult $ view passingGrade) $ examResultField examPassedField
+  
 -------------------------
 -- Course Applications --
 -------------------------
@@ -709,12 +764,16 @@ anchorColonnadeM mkUrl = imapColonnade anchorColonnade'
 emptyOpticColonnade :: forall h r' focus c.
                        ( Monoid c
                        )
-                    => Fold r' focus -- ^ View on @focus@ within @r'@ that may produce any number of results
+                    => Getting (Endo [focus]) r' focus -- ^ View on @focus@ within @r'@ that may produce any number of results
                     -> ((forall focus'. Getting focus' r' focus) -> Colonnade h r' c) -- ^ `OpticColonnade focus`
                     -> Colonnade h r' c
--- ^ Generalize an `OpticColonnade` from `Getter` to `Fold` by defaulting results of zero or more than one values to `mempty`
+-- ^ Generalize an `OpticColonnade` from `Getter` to `Fold` by defaulting results of zero values to `mempty`
-emptyOpticColonnade l c = Colonnade $ oldColonnade <&> \column -> column { oneColonnadeEncode = \s -> defaultColumn s $ oneColonnadeEncode column }
+emptyOpticColonnade l' c
+  = Colonnade $ oldColonnade <&> \column -> column { oneColonnadeEncode = \s -> defaultColumn s $ oneColonnadeEncode column }
   where
+    l :: Fold r' focus
+    l = folding (toListOf l')
+    
     Colonnade oldColonnade = c $ singular l
     -- This is safe (as long as we don't evaluate the `oneColonnadeEncode`s)
     -- because `Getter s a` is of kind @k -> *@ and can thus only be inspected
@@ -722,7 +781,9 @@ emptyOpticColonnade l c = Colonnade $ oldColonnade <&> \column -> column { oneCo
     -- and the definition of `OneColonnade`
 
     defaultColumn :: r' -> (r' -> c) -> c
-    defaultColumn x f = case x ^.. l of
+    defaultColumn x f 
-      [_] -> f x
+      | has l x    = f x
-      _   -> mempty
+      | otherwise  = mempty
 
+maybeOpticSortColumn :: OpticSortColumn (Maybe val) -> OpticSortColumn val
+maybeOpticSortColumn sortColumn = \queryFocus -> sortColumn $ queryFocus . to E.just

src/Handler/Utils/Table/Pagination.hs

@@ -11,8 +11,9 @@ module Handler.Utils.Table.Pagination
   , module Handler.Utils.Table.Pagination.CsvColumnExplanations
   , DBCsvActionMode(..)
   , DBCsvDiff(..), _DBCsvDiffNew, _DBCsvDiffExisting, _DBCsvDiffMissing, _dbCsvOldKey, _dbCsvOld, _dbCsvNewKey, _dbCsvNew
-  , DBTCsvEncode, DBTCsvDecode(..)
+  , DBTCsvEncode(..), DBTCsvDecode(..)
-  , DBTable(..), DBFilterUI, noCsvEncode, IsDBTable(..), DBCell(..)
+  , DBTable(..), DBFilterUI, IsDBTable(..), DBCell(..)
+  , noCsvEncode, simpleCsvEncode, simpleCsvEncodeM
   , singletonFilter
   , DBParams(..)
   , cellAttrs, cellContents
@@ -108,6 +109,8 @@ import qualified Data.Conduit.List as C
 import Handler.Utils.DateTime (formatTimeRangeW)
 import qualified Control.Monad.Catch as Catch
 
+import Data.Dynamic
+
 
 #if MIN_VERSION_base(4,11,0)
 type Monoid' = Monoid
@@ -337,6 +340,8 @@ instance Button UniWorX ButtonCsvMode where
 data DBCsvMode
   = DBCsvNormal
   | DBCsvExport
+    { dbCsvExportData :: Dynamic
+    }
   | DBCsvImport
     { dbCsvFiles :: [FileInfo]
     }
@@ -507,7 +512,16 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)
       fromOuter = Map.lookup key >=> listToMaybe
 
 
-type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv)
+data DBTCsvEncode r' k' csv = forall exportData.
+  ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
+  , DBTableKey k'
+  , Typeable exportData
+  ) => DBTCsvEncode
+  { dbtCsvExportForm   :: AForm (YesodDB UniWorX) exportData
+  , dbtCsvDoEncode     :: exportData -> Conduit (k', r') (YesodDB UniWorX) csv
+  , dbtCsvName         :: FilePath
+  , dbtCsvNoExportData :: Maybe (AnIso' exportData ())
+  }
 data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException.
   ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
   , DBTableKey k'
@@ -542,16 +556,41 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtFilterUI :: DBFilterUI
   , dbtStyle :: DBStyle r'
   , dbtParams :: DBParams m x
-  , dbtCsvEncode :: DBTCsvEncode r' csv
+  , dbtCsvEncode :: Maybe (DBTCsvEncode r' k' csv)
   , dbtCsvDecode :: Maybe (DBTCsvDecode r' k' csv)
   , dbtIdent :: i
   }
 
 type DBFilterUI = Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
 
-noCsvEncode :: DictMaybe (ToNamedRecord Void, DefaultOrdered Void, CsvColumnsExplained Void) (Conduit r' (YesodDB UniWorX) Void)
+noCsvEncode :: Maybe (DBTCsvEncode r' k' Void)
 noCsvEncode = Nothing
 
+simpleCsvEncode :: ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
+                   , DBTableKey k'
+                   , Textual fp
+                   )
+                => fp -> (r' -> csv) -> Maybe (DBTCsvEncode r' k' csv)
+simpleCsvEncode fName f = Just DBTCsvEncode
+  { dbtCsvExportForm   = pure ()
+  , dbtCsvDoEncode     = \() -> C.map (f . view _2)
+  , dbtCsvName         = unpack fName
+  , dbtCsvNoExportData = Just id
+  }
+
+simpleCsvEncodeM :: ( ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv
+                    , DBTableKey k'
+                    , Textual fp
+                    )
+                 => fp -> ReaderT r' (YesodDB UniWorX) csv -> Maybe (DBTCsvEncode r' k' csv)
+simpleCsvEncodeM fName f = Just DBTCsvEncode
+  { dbtCsvExportForm   = pure ()
+  , dbtCsvDoEncode     = \() -> C.mapM (runReaderT f . view _2)
+  , dbtCsvName         = unpack fName
+  , dbtCsvNoExportData = Just id
+  }
+
+
 class (MonadHandler m, HandlerSite m ~ UniWorX, Monoid' x, Monoid' (DBCell m x), Default (DBParams m x)) => IsDBTable (m :: * -> *) (x :: *) where
   data DBParams m x :: *
   type DBResult m x :: *
@@ -752,6 +791,7 @@ instance Monoid' x => Monoid (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang
 instance IsDBTable m a => IsString (DBCell m a) where
   fromString = cell . fromString
 
+
 -- | DB-backed tables with pagination, may short-circuit a handler if the frontend only asks for the table content, i.e. handler actions after calls to dbTable may not happen at all.
 dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DBResult m x)
 dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do
@@ -838,7 +878,20 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     tblLink' :: (QueryText -> QueryText) -> Widget
     tblLink' = toWidget <=< toTextUrl . tblLink
 
-  ((csvExportRes, csvExportWdgt), csvExportEnctype) <- lift . runFormGet . identifyForm FIDDBTableCsvExport . set (mapped . mapped . _1 . mapped) DBCsvExport $ buttonForm' [BtnCsvExport]
+  let noExportData
+        | Just DBTCsvEncode{..} <- dbtCsvEncode
+        = is _Just dbtCsvNoExportData
+        | otherwise
+        = True
+
+  ((csvExportRes, csvExportWdgt), csvExportEnctype) <- bool runFormPost runFormGet noExportData . identifyForm FIDDBTableCsvExport . renderAForm FormDBTableCsvExport . fmap DBCsvExport $ case dbtCsvEncode of
+    Just DBTCsvEncode{..}
+      | Just (cloneIso -> noExportData') <- dbtCsvNoExportData
+        -> toDyn . view (noExportData' . from noExportData') <$> dbtCsvExportForm
+      | otherwise
+        -> toDyn <$> dbtCsvExportForm
+    Nothing
+        -> pure $ toDyn ()
   ((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport
     <$> areq fileFieldMultiple (fslI MsgCsvFile) Nothing
 
@@ -848,13 +901,13 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , csvImportRes <* guard (is _Just dbtCsvDecode)
       , FormSuccess DBCsvNormal
       ]
-    csvExportWdgt' = wrapForm csvExportWdgt FormSettings
+    csvExportWdgt' = wrapForm' BtnCsvExport csvExportWdgt FormSettings
-      { formMethod = GET
+      { formMethod = bool POST GET noExportData
       , formAction = Just $ tblLink id
       , formEncoding = csvExportEnctype
-      , formAttrs = [("target", "_blank"), ("class", "form--inline")]
+      , formAttrs = []
-      , formSubmit = FormNoSubmit
+      , formSubmit = FormSubmit
-      , formAnchor = Nothing :: Maybe Text
+      , formAnchor = Just $ wIdent "csv-export"
       }
     csvImportWdgt' = wrapForm' BtnCsvImport csvImportWdgt FormSettings
       { formMethod = POST
@@ -862,11 +915,11 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , formEncoding = csvImportEnctype
       , formAttrs = []
       , formSubmit = FormSubmit
-      , formAnchor = Nothing :: Maybe Text
+      , formAnchor = Just $ wIdent "csv-import"
       }
     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
+      Just (DBTCsvEncode{} :: DBTCsvEncode r' k' 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")
@@ -877,7 +930,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     res <- dbtSQLQuery t
     E.orderBy $ concatMap (sqlSortDirection t) psSorting'
     case csvMode of
-      FormSuccess DBCsvExport -> return ()
+      FormSuccess DBCsvExport{} -> return ()
       FormSuccess DBCsvImport{} -> return ()
       _other -> do
         case previousKeys of
@@ -908,10 +961,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
 
   formResult csvMode $ \case
-    DBCsvExport
+    DBCsvExport{..}
-      | Just (Dict, dbtCsvEncode') <- dbtCsvEncode -> do
+      | Just DBTCsvEncode{..} <- dbtCsvEncode
-        setContentDisposition' . Just $ unpack dbtIdent <.> unpack extensionCsv
+      , Just exportData <- fromDynamic dbCsvExportData -> do
-        sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList rows .| dbtCsvEncode'
+        let ensureExtension ext fName = bool (addExtension ext) id (ext `isExtensionOf` fName) fName
+        setContentDisposition' . Just $ ensureExtension (unpack extensionCsv) dbtCsvName
+        sendResponse <=< liftHandlerT . respondCsvDB $ C.sourceList (zip currentKeys rows) .| dbtCsvDoEncode exportData >> lift E.transactionSave
     DBCsvImport{..}
       | Just (DBTCsvDecode{ dbtCsvClassifyAction = dbtCsvClassifyAction :: csvAction -> csvActionClass
                           , ..

src/Handler/Utils/Widgets.hs

@@ -0,0 +1,94 @@
+module Handler.Utils.Widgets where
+
+import Import
+import qualified Data.Text as T
+import qualified Data.CaseInsensitive as CI
+
+import Text.Hamlet (shamletFile)
+
+import Handler.Utils.DateTime
+
+
+---------
+-- Simple utilities for consistent display
+-- Please use these throughout, to ensure that users have a consistent experience
+
+tidFromText :: Text -> Maybe TermId
+tidFromText = fmap TermKey . maybeRight . termFromText
+
+-- | Display given UTCTime and maybe an invisible icon if it is in the future
+--
+--   Also see `Handler.Utils.Table.Cells.dateTimeCellVisible` for a similar function (in case of refactoring)
+visibleUTCTime :: SelDateTimeFormat -> UTCTime -> Widget
+visibleUTCTime dtf t = do
+    let timeStampWgt = formatTimeW dtf t
+    now <- liftIO getCurrentTime
+    if now >= t
+      then timeStampWgt
+      else $(widgetFile "widgets/date-time/yet-invisible")
+
+
+-- | Simple link to a known route
+simpleLink :: Widget -> Route UniWorX -> Widget
+simpleLink lbl url = [whamlet|<a href=@{url}>^{lbl}|]
+
+simpleLinkI :: SomeMessage UniWorX -> Route UniWorX -> Widget
+simpleLinkI lbl url = [whamlet|<a href=@{url}>_{lbl}|]
+
+-- | toWidget-Version of @nameHtml@, for convenience
+nameWidget :: Text    -- ^ userDisplayName
+           -> Text    -- ^ userSurname
+           -> Widget
+nameWidget displayName surname = toWidget $ nameHtml displayName surname
+
+-- | toWidget-Version of @nameEmailHtml@, for convenience
+nameEmailWidget :: UserEmail -- ^ userEmail
+                -> Text    -- ^ userDisplayName
+                -> Text    -- ^ userSurname
+                -> Widget
+nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname
+
+-- | uncurried Version for @nameEmailWidget@ needed in hamlet, where TH cannot be used
+nameEmailWidget' :: (UserEmail, Text, Text)-> Widget
+nameEmailWidget' = $(uncurryN 3) nameEmailWidget
+
+-- | Show user's displayName, highlighting the surname if possible.
+--   Otherwise appends the surname in parenthesis
+nameHtml :: Text -> Text -> Html
+nameHtml displayName surname
+  | null surname = toHtml displayName
+  | otherwise = case reverse $ T.splitOn surname displayName of
+      [_notContained] -> [shamlet|$newline never
+                            #{displayName} (
+                            <b .surname>#{surname}
+                            )|]
+      (suffix:prefixes) ->
+        let prefix = T.intercalate surname $ reverse prefixes
+        in [shamlet|$newline never
+              #{prefix}
+              <b .surname>#{surname}
+              #{suffix}
+            |]
+      [] -> error "Data.Text.splitOn returned empty list in violation of specification."
+
+-- | Like nameHtml just show a users displayname with hightlighted surname,
+--   but also wrap the name with a mailto-link
+nameEmailHtml :: UserEmail -> Text -> Text -> Html
+nameEmailHtml email displayName surname =
+  wrapMailto email $ nameHtml displayName surname
+
+-- | Wrap mailto around given Html using single hamlet-file for consistency
+wrapMailto :: UserEmail -> Html -> Html
+wrapMailto (CI.original -> email) linkText
+  | null email = linkText
+  | otherwise  = $(shamletFile "templates/widgets/link-email.hamlet")
+
+-- | Just show an email address in a standard way, for convenience inside hamlet files.
+mailtoHtml :: UserEmail -> Html
+mailtoHtml email = wrapMailto email $(shamletFile "templates/widgets/email.hamlet")
+
+-- | Generic i18n text for "edited at sometime by someone"
+editedByW :: SelDateTimeFormat -> UTCTime -> Text -> Widget
+editedByW fmt tm usr  = do
+  ft <- handlerToWidget $ formatTime fmt tm
+  [whamlet|_{MsgEditedBy usr ft}|]

src/Import/NoModel.hs

@@ -60,6 +60,8 @@ import Data.Semigroup         as Import (Semigroup, Min(..), Max(..))
 import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..), Alt(..))
 import Data.Binary            as Import (Binary)
 
+import System.FilePath        as Import hiding (joinPath, normalise, isValid, makeValid)
+
 import Numeric.Natural        as Import (Natural)
 import Data.Ratio             as Import ((%))
 
@@ -74,12 +76,16 @@ import Control.Monad.Random.Class as Import (MonadRandom(..))
 
 import Control.Monad.Morph as Import
 import Control.Monad.Trans.Resource as Import (ReleaseKey)
+import Control.Monad.Trans.Reader as Import
+  ( reader, Reader, runReader, mapReader, withReader
+  , ReaderT(..), mapReaderT, withReaderT
+  )
 
 import Jose.Jwt as Import (Jwt)
 
 import Data.Time.Calendar as Import
 import Data.Time.Clock as Import
-import Data.Time.LocalTime as Import hiding (utcToLocalTime, localTimeToUTC)
+import Data.Time.LocalTime as Import hiding (utcToLocalTime, utcToZonedTime, localTimeToUTC)
 import Time.Types as Import (WeekDay(..))
 
 import Network.Mime as Import

src/Utils.hs

@@ -286,7 +286,7 @@ cutOffPercent :: Double -> Double -> Double -> Double
 cutOffPercent offset full achieved
   | full <= achieved = 0
   | full <= 0        = 0
-  | otherwise        = offset + (1-offset) * (1 - percent)
+  | otherwise        = offset + (1-offset) * (1 - percent)
   where
     percent = achieved / full
 
@@ -300,6 +300,9 @@ cutOffPercent offset full achieved
 notUsed :: Monoid m => a -> m
 notUsed = const mempty
 
+guardMonoid :: Monoid m => Bool -> m -> m
+guardMonoid False _ = mempty
+guardMonoid True  x = x
 
 ------------
 -- Tuples --

src/Utils/Form.hs

@@ -676,6 +676,9 @@ cfStrip = guardField (not . T.null . repack) . convertField (repack . T.strip .
 cfCI :: (Functor m, CI.FoldCase s) => Field m s -> Field m (CI s)
 cfCI = convertField CI.mk CI.original
 
+isoField :: Functor m => AnIso' a b -> Field m a -> Field m b
+isoField (cloneIso -> fieldIso) = convertField (view fieldIso) (review fieldIso)
+
 
 selectField' :: ( Eq a
                 , RenderMessage (HandlerSite m) FormMessage
@@ -761,7 +764,7 @@ wrapForm' btn formWidget FormSettings{..} = do
 -------------------
 
 -- | Use this type to pass information to the form template
-data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize | FormDBTableCsvImport
+data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize | FormDBTableCsvImport | FormDBTableCsvExport
 
 data AFormMessage = MsgAFormFieldRequiredTip
 

templates/exam-office/exam-result-synced.hamlet

@@ -0,0 +1,32 @@
+$newline never
+<h1>
+  ^{nameWidget (userDisplayName user) (userSurname user)}
+
+<table .table .table--striped .table--hover>
+  <thead>
+    <tr .table__row .table__row--head>
+      <td>
+      <td .table__th>_{MsgExamUserSyncOfficeName}
+      <td .table__th>_{MsgExamUserSyncTime}
+      <td .table__th>_{MsgExamUserSyncSchools}
+    $forall sync <- syncs'
+      $case sync
+        $of Right (officeDisplayName, officeSurname, time, sshs)
+          <tr .table__row>
+            <td>
+            <td .table__td>
+              ^{nameWidget officeDisplayName officeSurname}
+            <td .table__td>
+              ^{formatTimeW SelFormatDateTime time}
+            <td .table__td>
+              <ul .list--inline .list--comma-separated>
+                $forall ssh' <- sshs
+                  #{ssh'}
+        $of Left lastChange
+          <tr .table__row>
+            <td .table__td style="text-align: right">
+              _{MsgExamUserSyncLastChange}
+            <td .table__td>
+            <td .table__td>
+              ^{formatTimeW SelFormatDateTime lastChange}
+            <td .table__td>

templates/exam-office/exam-results.hamlet

@@ -0,0 +1,2 @@
+$newline never
+^{examUsersTable}

templates/table/csv-column-explanations.hamlet

@@ -3,5 +3,3 @@
   $forall (colName, colExplanation) <- csvColExplanations''
     <dt .deflist__dt>#{decodeUtf8 colName}
     <dd .deflist__dd>^{colExplanation}
-<div>
-  ^{csvExportWdgt'}