feat(submissions): display authorship statements

frontend/src/app.sass

@@ -1732,3 +1732,8 @@ video
 .authorship-statement-accept__accept-label
   grid-area: label
   font-weight: 600
+
+.authorship-statement__id
+  font-size: .5em
+  font-family: var(--font-monospace)
+  color: var(--color-fontsec)

messages/uniworx/categories/courses/submission/de-de-formal.msg

@@ -210,6 +210,19 @@ SubmissionUserMatriculation: Matrikelnummer
 SubmissionUserEmail: E-Mail
 SubmissionUserAuthorshipStatementState: Eigenständigkeitserklärung
 
-SubmissionAuthorshipStatementStateOkay: In Ordnung
+SubmissionAuthorshipStatementStateExists: Vorhanden
 SubmissionAuthorshipStatementStateOldStatement: Unpassender Wortlaut
 SubmissionAuthorshipStatementStateMissing: Fehlt
+
+SubmissionTitle tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission !ident-ok: #{tid}-#{ssh}-#{csh} #{shn}: #{toPathPiece cID}
+SubmissionHeadingEdit tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe #{toPathPiece cID} editieren
+SubmissionHeadingShow tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe #{toPathPiece cID}
+SubmissionTitleNew tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe anlegen
+SubmissionHeadingNew tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe anlegen
+
+SubmissionAuthorshipStatementsHeading tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Eigenständigkeitserklärungen #{toPathPiece cID}
+SubmissionAuthorshipStatementsTitle tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Eigenständigkeitserklärungen #{toPathPiece cID}
+
+SubmissionColumnAuthorshipStatementTime: Zeitstempel
+SubmissionColumnAuthorshipStatementWording: Wortlaut
+SubmissionFilterAuthorshipStatementCurrent: Aktueller Wortlaut

messages/uniworx/categories/courses/submission/en-eu.msg

@@ -209,6 +209,19 @@ SubmissionUserMatriculation: Matriculation
 SubmissionUserEmail: Email
 SubmissionUserAuthorshipStatementState: Statement of Authorship
 
-SubmissionAuthorshipStatementStateOkay: Okay
+SubmissionAuthorshipStatementStateExists: Exists
 SubmissionAuthorshipStatementStateOldStatement: Wrong wording
 SubmissionAuthorshipStatementStateMissing: Missing
+
+SubmissionTitle tid ssh csh shn cID !ident-ok: #{tid}-#{ssh}-#{csh} #{shn}: #{toPathPiece cID}
+SubmissionHeadingEdit tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Edit Submission #{toPathPiece cID}
+SubmissionHeadingShow tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Submission #{toPathPiece cID}
+SubmissionTitleNew tid ssh csh shn: #{tid}-#{ssh}-#{csh} #{shn}: Create Submission
+SubmissionHeadingNew tid ssh csh shn: #{tid}-#{ssh}-#{csh} #{shn}: Create Submission
+
+SubmissionAuthorshipStatementsHeading tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Authorship Statements #{toPathPiece cID}
+SubmissionAuthorshipStatementsTitle tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Authorship Statements #{toPathPiece cID}
+
+SubmissionColumnAuthorshipStatementTime: Timestamp
+SubmissionColumnAuthorshipStatementWording: Wording
+SubmissionFilterAuthorshipStatementCurrent: Current wording

messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg

@@ -187,3 +187,4 @@ BreadcrumbMessageList: Systemnachrichten
 BreadcrumbGlossary: Begriffsverzeichnis
 BreadcrumbLogin !ident-ok: Login
 BreadcrumbNews: Aktuell
+BreadcrumbSubmissionAuthorshipStatements: Eigenständigkeitserklärungen

messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg

@@ -187,3 +187,4 @@ BreadcrumbSheetCurrent: Current exercise sheet
 BreadcrumbSheetOldUnassigned: Submissions without corrector
 BreadcrumbLogin: Login
 BreadcrumbNews: News
+BreadcrumbSubmissionAuthorshipStatements: Statements of Authorship

routes

@@ -218,6 +218,7 @@
       /assign                   SubAssignR     GET POST        !lecturerANDtime
       /correction               CorrectionR    GET POST        !corrector !ownerANDreadANDratedANDexam-time
       /invite                   SInviteR       GET POST        !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registeredANDpersonalised-sheet-files
+      /authorship-statements    SubAuthorshipStatementsR GET   !corrector
       !/#SubmissionFileType     SubArchiveR    GET             !owner !corrector
       !/#SubmissionFileType/*FilePath SubDownloadR  GET        !owner !corrector
     /iscorrector                SIsCorrR       GET             !corrector -- Route is used to check for corrector access to this sheet

src/Auth/LDAP.hs

@@ -204,7 +204,7 @@ campusLogin pool mode = AuthPlugin{..}
           searchResults <- findUser conf ldap campusIdent [ldapUserPrincipalName]
           case searchResults of
             [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs]
-              | [principalName] <- nub $ fold [ v | (k, v) <- userAttrs, k == ldapUserPrincipalName ]
+              | [principalName] <- nubOrd $ fold [ v | (k, v) <- userAttrs, k == ldapUserPrincipalName ]
               , Right credsIdent <- Text.decodeUtf8' principalName
               -> handleIf isInvalidCredentials (return . Left) $ do
                    Ldap.bind ldap (Ldap.Dn credsIdent) . Ldap.Password $ Text.encodeUtf8 campusPassword

src/Data/Universe/TH.hs

@@ -14,7 +14,8 @@ import Data.Universe.Helpers (interleave)
 
 import Control.Monad (unless)
 
-import Data.List (elemIndex, nub)
+import Data.List (elemIndex)
+import Data.Containers.ListUtils
   
 import Control.Lens hiding (universe)
 import Data.Generics.Product.Types
@@ -81,7 +82,7 @@ deriveUniverse' interleaveExp universeExp mkCxt tName = do
               usesVar ConstructorInfo{..} n
                 | n `elem` map getTVBName constructorVars = False
                 | otherwise = any (elemOf types n) constructorFields
-              fieldTypes = nub $ concatMap constructorFields datatypeCons
+              fieldTypes = nubOrd $ concatMap constructorFields datatypeCons
 
   iCxt' <- cxt iCxt
 

src/Foundation/I18n.hs

@@ -509,18 +509,18 @@ instance RenderMessage UniWorX RouteWorkflowScope where
       mr = renderMessage foundation ls
 
 
-unRenderMessage' :: (Eq a, Finite a, RenderMessage master a) => (Text -> Text -> Bool) -> master -> Text -> [a]
+unRenderMessage' :: (Ord a, Finite a, RenderMessage master a) => (Text -> Text -> Bool) -> master -> Text -> [a]
-unRenderMessage' cmp foundation inp = nub $ do
+unRenderMessage' cmp foundation inp = nubOrd $ do
   l <- appLanguages'
   x <- universeF
   guard $ renderMessage foundation (l : filter (/= l) appLanguages') x `cmp` inp
   return x
   where appLanguages' = toList appLanguages
 
-unRenderMessage :: (Eq a, Finite a, RenderMessage master a) => master -> Text -> [a]
+unRenderMessage :: (Ord a, Finite a, RenderMessage master a) => master -> Text -> [a]
 unRenderMessage = unRenderMessage' (==)
 
-unRenderMessageLenient :: forall a master. (Eq a, Finite a, RenderMessage master a) => master -> Text -> [a]
+unRenderMessageLenient :: forall a master. (Ord a, Finite a, RenderMessage master a) => master -> Text -> [a]
 unRenderMessageLenient = unRenderMessage' cmp
   where cmp = (==) `on` mk . under packed (filter Char.isAlphaNum . concatMap unidecode)
 

src/Foundation/Navigation.hs

@@ -325,17 +325,16 @@ breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
   SubmissionR cid sRoute' -> case sRoute' of
     SubShowR -> useRunDB $ do
       mayList <- hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
-      if
+      return ( toPathPiece cid
-        | mayList
+             , Just . CSheetR tid ssh csh shn $ bool SShowR SSubsR mayList
-          -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SSubsR
+             )
-        | otherwise
-          -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SShowR
     CorrectionR -> i18nCrumb MsgMenuCorrection . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubDelR -> i18nCrumb MsgMenuSubmissionDelete . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubAssignR -> i18nCrumb MsgCorrectorAssignTitle . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SInviteR -> i18nCrumb MsgBreadcrumbSubmissionUserInvite . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubArchiveR sft -> i18nCrumb sft . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubDownloadR _ _ -> i18nCrumb MsgBreadcrumbSubmissionFile . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+    SubAuthorshipStatementsR -> i18nCrumb MsgBreadcrumbSubmissionAuthorshipStatements . Just $ CSubmissionR tid ssh csh shn cid SubShowR
   SArchiveR -> i18nCrumb MsgBreadcrumbSheetArchive . Just $ CSheetR tid ssh csh shn SShowR
   SIsCorrR -> i18nCrumb MsgBreadcrumbSheetIsCorrector . Just $ CSheetR tid ssh csh shn SShowR
   SPseudonymR -> i18nCrumb MsgBreadcrumbSheetPseudonym . Just $ CSheetR tid ssh csh shn SShowR

src/Foundation/Yesod/Auth.hs

@@ -296,7 +296,7 @@ upsertCampusUser upsertMode ldapData = do
       Right str <- return $ Text.decodeUtf8' v'
       return str
 
-    termNames = nubBy ((==) `on` CI.mk) $ do
+    termNames = nubOrdOn CI.mk $ do
       (k, v) <- ldapData
       guard $ k == ldapUserFieldName
       v' <- v
@@ -505,7 +505,7 @@ updateUserLanguage (Just lang) = do
   muid <- maybeAuthId
   for_ muid $ \uid -> do
     langs <- languages
-    update uid [ UserLanguages =. Just (Languages $ lang : nub (filter ((&&) <$> (`elem` appLanguages) <*> (/= lang)) langs)) ]
+    update uid [ UserLanguages =. Just (Languages $ lang : nubOrd (filter ((&&) <$> (`elem` appLanguages) <*> (/= lang)) langs)) ]
   setRegisteredCookie CookieLang lang
   return $ Just lang
 updateUserLanguage Nothing = runMaybeT $ do

src/Handler/Allocation/Accept.hs

@@ -109,12 +109,12 @@ allocationAcceptForm aId = runMaybeT $ do
 
     let
       showTerms
-        | [_] <- nubOn (view $ _1 . _2 . _entityVal . _courseTerm) allocationCourses'
+        | [_] <- nubOrdOn (view $ _1 . _2 . _entityVal . _courseTerm) allocationCourses'
         = False
         | otherwise
         = True
       showSchools
-        | [_] <- nubOn (view $ _1 . _2 . _entityVal . _courseSchool) allocationCourses'
+        | [_] <- nubOrdOn (view $ _1 . _2 . _entityVal . _courseSchool) allocationCourses'
         = False
         | otherwise
         = True

src/Handler/Allocation/Show.hs

@@ -118,7 +118,7 @@ postAShowR tid ssh ash = do
 
     wouldNotifyNewCourse <- fmap (maybe False E.unValue . join) . for muid $ E.selectMaybe . pure . allocationNotifyNewCourses (E.val aId) . E.val
 
-    return (alloc, school, isAnyLecturer, isAdmin, nubOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
+    return (alloc, school, isAnyLecturer, isAdmin, nubOrdOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
 
   let nextSubstitutesDeadline = minimumOf (folded . resultAllocationCourse . _allocationCourseAcceptSubstitutes . _Just . filtered (>= now)) courses
       freeCapacity = fmap getSum . getAp . flip foldMap courses $ \cEntry -> Ap . fmap (Sum . max 0) $ subtract (cEntry ^. resultParticipantCount) <$> preview (resultCourse . _entityVal . _courseCapacity . _Just) cEntry

src/Handler/Course/Application/List.hs

@@ -612,7 +612,7 @@ postCApplicationsR tid ssh csh = do
         sortedApplications <- unstableSortBy cmp applications
 
         let applicants = sortedApplications
-                       & nubOn (view $ _1 . _entityKey)
+                       & nubOrdOn (view $ _1 . _entityKey)
                        & maybe id take openCapacity
                        & setOf (case invMode of
                                   AcceptApplicationsDirect -> folded . _1 . _entityKey . to Right

src/Handler/Course/Edit.hs

@@ -121,7 +121,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
       adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
       oldSchool <- forM (cfCourseId =<< template) $ fmap courseSchool . getJust
       return (lecturerSchools, adminSchools, oldSchool)
-    let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
+    let userSchools = nubOrd . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
 
     (termsField, userTerms) <- liftHandler $ case template of
       -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin

src/Handler/Course/Users.hs

@@ -623,7 +623,7 @@ postCUsersR tid ssh csh = do
                 , E.desc $ sheet E.^. SheetActiveFrom
                 ]
       return $ sheet E.^. SheetName
-    let exams = nubOn entityKey $ examOccurrencesPerExam ^.. folded . _1
+    let exams = nubOrdOn entityKey $ examOccurrencesPerExam ^.. folded . _1
     let colChoices  = mconcat $ catMaybes
           [ pure . cap' $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
           , pure . cap' $ colUserNameLink (CourseR tid ssh csh . CUserR)

src/Handler/Exam/Form.hs

@@ -160,7 +160,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do
                                  (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementContentForcedTip)
           contentField ttipReq
             | not schoolSheetExamAuthorshipStatementAllowOther
-            = traverse forcedContentField $ authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement
+            = fmap (fmap authorshipStatementDefinitionContent) . traverse forcedContentField $ entityVal <$> mSchoolAuthorshipStatement
             | otherwise
             = Just <$> reqContentField ttipReq
         in case schoolSheetExamAuthorshipStatementMode of

src/Handler/ExamOffice/Users.hs

@@ -101,7 +101,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do
           | null newUsers
             -> pure oldUsers
           | otherwise
-            -> pure . nub $ oldUsers ++ Set.toList newUsers
+            -> pure . nubOrd $ oldUsers ++ Set.toList newUsers
       return (res', $(widgetFile "widgets/massinput/examOfficeUsers/add"))
     miCell' :: Either UserEmail UserId -> Widget
     miCell' (Left email) = do

src/Handler/ExternalExam/Form.hs

@@ -46,7 +46,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
       adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
       let oldSchool = eefSchool <$> template
       return (lecturerSchools, adminSchools, oldSchool)
-  let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
+  let userSchools = nubOrd . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
       templateSchool = eefSchool <$> template <|> case userSchools of
         [ssh] -> pure ssh
         _     -> mzero

src/Handler/Metrics.hs

@@ -44,7 +44,7 @@ getMetricsR = selectRep $ do
              -> suffix
       | otherwise
       = sName
-    getLabels = nub . concatMap (\(Sample _ lPairs _) -> lPairs ^.. folded . _1)
+    getLabels = nubOrd . concatMap (\(Sample _ lPairs _) -> lPairs ^.. folded . _1)
     singleSample base [Sample sName lPairs sValue]
       | sName == base = Just (lPairs, sValue)
     singleSample _ _ = Nothing

src/Handler/Sheet/Form.hs

@@ -139,7 +139,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
 
                        if | not schoolSheetAuthorshipStatementAllowOther
                             -> (pure SheetAuthorshipStatementModeEnabled, pure sfAuthorshipStatementExam', )
-                               <$> fmap sequenceA (traverse forcedContentField $ authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
+                               <$> fmap sequenceA (fmap (fmap $ fmap authorshipStatementDefinitionContent) . traverse forcedContentField $ entityVal <$> mSchoolAuthorshipStatement)
                           | otherwise -> do
                               examOpts <-
                                 let examFieldQuery = E.from $ \exam -> do

src/Handler/Sheet/PersonalisedFiles.hs

@@ -171,7 +171,7 @@ sinkPersonalisedSheetFiles cid sid keep
            Right nSink -> State.modify . Map.insert redResidual $ Map.insert residual nSink sinks
      openSinks <- State.get
      lift . lift . mapM_ closeResumableSink $ openSinks ^.. folded . folded
-     let (nub -> sinkSheets, nub -> sinkUsers) = unzip $ Map.keys openSinks
+     let (nubOrd -> sinkSheets, nubOrd -> sinkUsers) = unzip $ Map.keys openSinks
      unless keep $
        lift . lift $ deleteWhere [ PersonalisedSheetFileSheet  <-. sinkSheets
                                  , PersonalisedSheetFileUser  /<-. sinkUsers
@@ -227,7 +227,7 @@ sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do
           E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cId
           E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
           return $ submissionGroup E.^. SubmissionGroupName
-        return . nub . sort $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) subGroups
+        return . Set.toList . Set.fromList $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) subGroups
       otherAnon
         | Just f <- userFeature otherAnon -> do
             features <- E.select . E.from $ \user -> do

src/Handler/Submission.hs

@@ -11,6 +11,7 @@ module Handler.Submission
   , module Handler.Submission.Create
   , module Handler.Submission.Grade
   , module Handler.Submission.Upload
+  , module Handler.Submission.AuthorshipStatements
   ) where
 
 import Handler.Submission.New
@@ -24,6 +25,7 @@ import Handler.Submission.Correction
 import Handler.Submission.Create
 import Handler.Submission.Grade
 import Handler.Submission.Upload
+import Handler.Submission.AuthorshipStatements
 
 import Handler.Utils
 

src/Handler/Submission/AuthorshipStatements.hs

@@ -0,0 +1,142 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
+module Handler.Submission.AuthorshipStatements
+  ( getSubAuthorshipStatementsR
+  ) where
+
+import Import
+import Handler.Utils
+import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
+
+
+type AuthorshipStatementsExpr = E.SqlExpr (Entity AuthorshipStatementSubmission)
+                  `E.InnerJoin` E.SqlExpr (Entity User)
+                  `E.InnerJoin` E.SqlExpr (Entity AuthorshipStatementDefinition)
+
+queryAuthorshipStatement :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity AuthorshipStatementSubmission))
+queryAuthorshipStatement = to $(E.sqlIJproj 3 1)
+
+queryUser :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity User))
+queryUser = to $(E.sqlIJproj 3 2)
+  
+queryDefinition :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity AuthorshipStatementDefinition))
+queryDefinition = to $(E.sqlIJproj 3 3)
+
+
+type AuthorshipStatementsData = DBRow ( Entity AuthorshipStatementSubmission
+                                      , Entity User
+                                      , Entity AuthorshipStatementDefinition
+                                      )
+
+resultAuthorshipStatement :: Lens' AuthorshipStatementsData (Entity AuthorshipStatementSubmission)
+resultAuthorshipStatement = _dbrOutput . _1
+
+resultUser :: Lens' AuthorshipStatementsData (Entity User)
+resultUser = _dbrOutput . _2
+  
+resultDefinition :: Lens' AuthorshipStatementsData (Entity AuthorshipStatementDefinition)
+resultDefinition = _dbrOutput . _3
+  
+
+getSubAuthorshipStatementsR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
+getSubAuthorshipStatementsR tid ssh csh shn cID = do
+  authorshipStatementTable <- runDB $ do
+    subId <- decrypt cID
+    Submission{..} <- get404 subId
+    isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True
+    mASDefinition <- getSheetAuthorshipStatement =<< getEntity404 submissionSheet
+    
+    let dbtIdent :: Text
+        dbtIdent = "authorship-statements"
+
+        dbtSQLQuery = runReaderT $ do
+          authorshipStatement <- view queryAuthorshipStatement
+          user <- view queryUser
+          definition <- view queryDefinition
+
+          lift $ do
+            E.on $ definition E.^. AuthorshipStatementDefinitionId E.==. authorshipStatement E.^. AuthorshipStatementSubmissionStatement
+            E.on $ user E.^. UserId E.==. authorshipStatement E.^. AuthorshipStatementSubmissionUser
+
+            E.where_ $ authorshipStatement E.^. AuthorshipStatementSubmissionSubmission E.==. E.val subId
+
+          return (authorshipStatement, user, definition)
+        dbtRowKey = views queryAuthorshipStatement (E.^. AuthorshipStatementSubmissionId)
+
+        dbtProj = dbtProjId
+
+        dbtColonnade :: Colonnade Sortable AuthorshipStatementsData (DBCell (HandlerFor UniWorX) ())
+        dbtColonnade = mconcat $ catMaybes
+          [ pure . sortable (Just "authorship-statement-time") (i18nCell MsgSubmissionColumnAuthorshipStatementTime) $ views (resultAuthorshipStatement . _entityVal . _authorshipStatementSubmissionTime) dateTimeCell
+          , pure $ colUserDisplayName (resultUser . _entityVal . $(multifocusG 2) _userDisplayName _userSurname)
+          , guardOn isLecturer $ colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
+          , pure $ lmap (view $ resultUser . _entityVal) colUserEmail
+          , pure . sortable Nothing (i18nCell MsgSubmissionColumnAuthorshipStatementWording) $ views resultDefinition definitionCell
+          ]
+          where
+            definitionCell (Entity asdId asd)
+                = withColor . (cellAttrs %~ addAttrsClass "table__td--center") . modalCell $ authorshipStatementWidget asd
+              where
+                withColor c
+                  | Just (Entity currASDId _) <- mASDefinition
+                  = c
+                  & cellAttrs %~ addAttrsClass "heated"
+                  & cellAttrs <>~ pure ("style", [st|--hotness: #{tshow (boolHeat (asdId /= currASDId))}|])
+                  | otherwise
+                  = c
+
+        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
+
+        dbtSorting = mconcat
+          [ singletonMap "authorship-statement-time" . SortColumn $ views queryAuthorshipStatement (E.^. AuthorshipStatementSubmissionTime)
+          , sortUserName' (queryUser . $(multifocusG 2) (to (E.^. UserDisplayName)) (to (E.^. UserSurname)))
+          , sortUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
+          , uncurry singletonMap $ sortUserEmail (view queryUser)
+          ]
+        dbtFilter = mconcat
+          [ fltrUserName' (queryUser . to (E.^. UserDisplayName))
+          , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
+          , uncurry singletonMap $ fltrUserEmail (view queryUser)
+          , singletonMap "authorship-statement-current" . FilterColumn $ \(view queryAuthorshipStatement -> subStmt) (Last isCurrent)
+              -> let isCurrent'
+                       | Just (Entity asdId _) <- mASDefinition
+                       = subStmt E.^. AuthorshipStatementSubmissionStatement E.==. E.val asdId
+                       | otherwise
+                       = E.false
+                  in maybe E.true ((E.==. isCurrent') . E.val) isCurrent
+          ]
+
+        dbtFilterUI = mconcat $ catMaybes
+          [ pure fltrUserNameUI'
+          , guardOn isLecturer fltrUserMatriculationUI
+          , pure fltrUserEmailUI
+          , pure . flip (prismAForm $ singletonFilter "authorship-statement-current" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgSubmissionFilterAuthorshipStatementCurrent)
+          ]
+
+        dbtParams = def
+
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+        dbtExtraReps = []
+
+        asPSValidator = def
+          & defaultSorting [SortDescBy "authorship-statement-time"]
+          & restrictFilter lecturerFilter & restrictSorting lecturerSorting
+          where
+            lecturerFilter fk _
+              | isLecturer = True
+              | otherwise  = fk /= "user-matriculation"
+            lecturerSorting sk _
+              | isLecturer = True
+              | otherwise  = sk /= "user-matriculation"
+     in dbTableWidget' asPSValidator DBTable{..}
+
+  let (heading, title) = ( MsgSubmissionAuthorshipStatementsHeading tid ssh csh shn cID
+                         , MsgSubmissionAuthorshipStatementsTitle tid ssh csh shn cID
+                         )
+
+  siteLayoutMsg heading $ do
+    setTitleI title
+
+    authorshipStatementTable

src/Handler/Submission/Grade.hs

@@ -49,13 +49,13 @@ postCorrectionsGradeR = do
         ]
       courseOptions = runDB $ do
         courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . courseShorthand . entityVal) courses
       termOptions = runDB $ do
         courses <- selectList [] [Asc CourseTerm]      >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (termToText . unTermKey . courseTerm . entityVal) courses
       schoolOptions = runDB $ do
         courses <- selectList [] [Asc CourseSchool]    >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
       psValidator = def
         & restrictAnonymous
         & restrictCorrector

src/Handler/Submission/Helper.hs

@@ -32,7 +32,7 @@ import qualified Data.Conduit.Combinators as C
 
 
 data AuthorshipStatementSubmissionState
-  = ASOkay
+  = ASExists
   | ASOldStatement
   | ASMissing
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
@@ -570,7 +570,7 @@ submissionHelper tid ssh csh shn mcid = do
         , formEncoding = formEnctype
         }
 
-  ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector, _), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, doAuthorshipStatements) <- runDB $ do
+  ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector, _), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, isOwner, doAuthorshipStatements) <- runDB $ do
     sheetInfo@(Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- getSheetInfo
 
     (showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> do
@@ -621,7 +621,7 @@ submissionHelper tid ssh csh shn mcid = do
             toPoint (Entity _ AuthorshipStatementSubmission{..}) = Just . Any $ fmap entityKey mASDefinition == Just authorshipStatementSubmissionStatement
             toRes :: Maybe Any -> AuthorshipStatementSubmissionState
             toRes = \case
-              Just (Any True) -> ASOkay
+              Just (Any True) -> ASExists
               Just (Any False) -> ASOldStatement
               Nothing -> ASMissing
       lift $ buddies
@@ -630,12 +630,17 @@ submissionHelper tid ssh csh shn mcid = do
         & mapMOf (traverse . _Right) (\uid -> (,,) <$> (encrypt uid :: DB CryptoUUIDUser) <*> getJust uid <*> getUserAuthorshipStatement uid)
         & fmap (sortOn . over _Right $ (,,,) <$> views _2 userSurname <*> views _2 userDisplayName <*> views _2 userEmail <*> view _1)
 
-    return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, is _Just mASDefinition)
+    return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, isOwner, is _Just mASDefinition)
 
   -- TODO(AuthorshipStatements): discuss whether to display prompt for user to update their authorship statement, if lecturer changed it
 
-  defaultLayout $ do
+  let (title, heading)
-    setTitleI $ MsgHeadingSubmissionEditHead tid ssh csh shn
+        | Just cID <- mcid, maySubmit, not isLecturer || isOwner = (MsgSubmissionTitle tid ssh csh shn cID, MsgSubmissionHeadingEdit tid ssh csh shn cID)
+        | Just cID <- mcid = (MsgSubmissionTitle tid ssh csh shn cID, MsgSubmissionHeadingShow tid ssh csh shn cID)
+        | otherwise = (MsgSubmissionTitleNew tid ssh csh shn, MsgSubmissionHeadingNew tid ssh csh shn)
+  
+  siteLayoutMsg heading $ do
+    setTitleI title
     (urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID
       -> let mkUrl sft = toTextUrl . CSubmissionR tid ssh csh shn cID $ SubArchiveR sft
           in liftHandler . runDB $ (,) <$> mkUrl SubmissionCorrected <*> mkUrl SubmissionOriginal
@@ -650,7 +655,8 @@ submissionHelper tid ssh csh shn mcid = do
         correctionVisibleWarnWidget = guardOnM (is _Just msubmission && is _Just mcid && showCorrection) correctionInvisible
         asStatusExplain = $(i18nWidgetFiles "authorship-statement-submission-explanation")
         asStatuses = setOf (folded . _Right . _3) subUsers
-          & Set.union (Set.fromList [ASOkay, ASMissing])
+          & Set.union (Set.fromList [ASExists, ASMissing])
           & Set.toList
           & mapMaybe (\stmt -> (stmt, ) <$> asStatusExplain Map.!? toPathPiece stmt)
+        asStatusExplainWdgt = $(widgetFile "widgets/authorship-statement-submission-explanation")
     $(widgetFile "submission")

src/Handler/Submission/List.hs

@@ -154,7 +154,7 @@ colSMatrikel = sortable (Just "submittors-matriculation") (i18nCell MsgTableMatr
 
 colSGroups :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSGroups = sortable (Just "submittors-group") (i18nCell MsgTableSubmissionGroup) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, _, _, _, users, _, hasAccess) } ->
-  let protoCell = listCell (nubOn (view _2) . Map.toList $ Map.mapMaybe (view _3) users) $ \(_, sGroup) -> cell $ toWidget sGroup
+  let protoCell = listCell (nubOrdOn (view _2) . Map.toList $ Map.mapMaybe (view _3) users) $ \(_, sGroup) -> cell $ toWidget sGroup
   in if | hasAccess
         , is _RegisteredGroups sheetGrouping
           -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
@@ -680,13 +680,13 @@ postCorrectionsR = do
         ]
       courseOptions = runDB $ do
         courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . courseShorthand . entityVal) courses
       termOptions = runDB $ do
         courses <- selectList [] [Desc CourseTerm]      >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (termToText . unTermKey . courseTerm . entityVal) courses
       schoolOptions = runDB $ do
         courses <- selectList [] [Asc CourseSchool]    >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
 
       psValidator = def
         & restrictCorrector

src/Handler/Utils/AuthorshipStatement.hs

@@ -16,6 +16,9 @@ import Handler.Utils.Form (i18nLangMap, I18nLang(..))
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 
+import qualified Data.ByteString.Base64.URL as Base64
+import qualified Data.ByteArray as BA
+
 
 insertAuthorshipStatement :: MonadIO m
                           => I18nStoredMarkup -> SqlWriteT m AuthorshipStatementDefinitionId
@@ -26,7 +29,7 @@ insertAuthorshipStatement authorshipStatementDefinitionContent = withCompatibleB
   return $ AuthorshipStatementDefinitionKey authorshipStatementDefinitionHash
 
 forcedAuthorshipStatementField :: (MonadHandler handler, HandlerSite handler ~ UniWorX)
-                               => Field handler I18nStoredMarkup
+                               => Field handler AuthorshipStatementDefinition
 forcedAuthorshipStatementField = Field{..}
   where
     fieldParse _ _ = pure . Left $ SomeMessage ("Result of forcedAuthorshipStatementField inspected" :: Text)
@@ -38,23 +41,27 @@ forcedAuthorshipStatementField = Field{..}
             ^{maybe mempty authorshipStatementWidget mVal}
         |]
 
-authorshipStatementWidget :: I18nStoredMarkup -> Widget
+authorshipStatementWidget :: AuthorshipStatementDefinition -> Widget
-authorshipStatementWidget stmt
+authorshipStatementWidget AuthorshipStatementDefinition{..}
   = [whamlet|
       $newline never
       <dl .authorship-statement>
-        $forall (I18nLang l, t) <- Map.toList (review i18nLangMap stmt)
+        $forall (I18nLang l, t) <- Map.toList (review i18nLangMap authorshipStatementDefinitionContent)
           <dt>
             _{MsgLanguageEndonym l}
           <dd>
             #{markupOutput t}
+
+      <p .authorship-statement__id>
+        #{hashText}
     |]
+  where hashText = decodeUtf8 . Base64.encodeUnpadded $ BA.convert authorshipStatementDefinitionHash
 
 acceptAuthorshipStatementField :: forall m.
                                   (MonadHandler m, HandlerSite m ~ UniWorX)
                                => Entity AuthorshipStatementDefinition
                                -> Field m AuthorshipStatementDefinitionId
-acceptAuthorshipStatementField (Entity asdId AuthorshipStatementDefinition{..})
+acceptAuthorshipStatementField (Entity asdId asd)
     = checkBoxField
     & _fieldView %~ adjFieldView
     & checkMap (bool (Left MsgAuthorshipStatementStatementIsRequired) (Right asdId)) (== asdId)

src/Handler/Utils/I18n.hs

@@ -30,7 +30,7 @@ i18nFile includeFile 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
+  let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . nubOrd $ 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

src/Handler/Utils/Invitations.hs

@@ -323,7 +323,7 @@ deleteInvitationsF :: forall junction m mono backend.
                    -> ReaderT backend m ()
 -- | Non-conduit version of `deleteInvitations`
 deleteInvitationsF invitationFor (otoList -> emailList)
-  = deleteWhere [InvitationEmail <-. nub emailList, InvitationFor ==. invRef @junction invitationFor]
+  = deleteWhere [InvitationEmail <-. nubOrd emailList, InvitationFor ==. invRef @junction invitationFor]
 
 deleteInvitation :: forall junction m backend.
                     ( IsInvitableJunction junction

src/Handler/Utils/Submission.hs

@@ -362,7 +362,7 @@ submissionMultiArchive anonymous sft (Set.toList -> ids) = do
                     E.where_ $ submission E.^. SubmissionId E.==. E.val submissionID
                     E.where_ $ sheet E.^. SheetCourse E.==. submissionGroup E.^. SubmissionGroupCourse
                   return $ submissionGroup E.^. SubmissionGroupName
-                let asciiGroups = nub . sort $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) groups
+                let asciiGroups = Set.toList . Set.fromList $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) groups
                 return . intercalate "_" $ asciiGroups `snoc` fp
             | Just feature <- userFeature anonymous
             = do

src/Handler/Utils/TermCandidates.hs

@@ -18,7 +18,6 @@ import Import
 -- import Control.Monad.Trans.Writer (mapWriterT)
 -- import Database.Persist.Sql (fromSqlKey)
 import qualified Data.Set as Set
-import qualified Data.List as List
 import qualified Data.Map as Map
 
 
@@ -112,7 +111,7 @@ removeAmbiguousNames = do
               )
     E.having $ E.countRows E.!=. E.val (1 :: Int64)
     return $ candidate E.^. StudyTermNameCandidateIncidence
-  let ambiSet = E.unValue <$> List.nub ambiList
+  let ambiSet = E.unValue <$> nubOrd ambiList
   -- Most SQL dialects won't allow deletion and queries on the same table at once, hence we delete in two steps.
   deleteWhere [StudyTermNameCandidateIncidence <-. ambiSet]
   return ambiSet

src/Handler/Utils/Widgets.hs

@@ -104,6 +104,10 @@ editedByW fmt tm usr  = do
   ft <- handlerToWidget $ formatTime fmt tm
   [whamlet|_{MsgUtilEditedBy usr ft}|]
 
+boolHeat :: Bool -- ^ @isHot@
+         -> Milli
+boolHeat = bool 0 1
+
 heat :: ( Real a, Real b )
      => a -> b -> Milli
 -- ^ Distinguishes @full@, zero is mapped to 1, @full@ is mapped to 0

src/Handler/Utils/Workflow/Workflow.hs

@@ -70,7 +70,7 @@ followAutomaticEdges WorkflowGraph{..} = go []
       | otherwise = throwM . WorkflowAutomaticEdgeAmbiguity $ Set.fromList automaticEdgeOptions
       where
         cState = wpTo $ last history
-        automaticEdgeOptions = nub $ do
+        automaticEdgeOptions = nubOrd $ do
           (nodeLbl, WGN{..}) <- Map.toList wgNodes
           (edgeLbl, WorkflowGraphEdgeAutomatic{..}) <- Map.toList wgnEdges
           guard $ wgeSource == cState

src/Jobs/Handler/QueueNotification.hs

@@ -116,7 +116,7 @@ determineNotificationCandidates = awaitForever $ \notif -> do
              E.where_ $ admin E.^. UserFunctionSchool `E.in_` E.valList (Set.toList newAdminSchools)
                   E.&&. admin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
              return user
-           withNotif . yieldMany . nub $ affectedUser <> affectedAdmins
+           withNotif . yieldMany . nubOrd $ affectedUser <> affectedAdmins
     NotificationUserSystemFunctionsUpdate{..}
       -> withNotif $ selectSource [UserId ==. nUser] []
     NotificationUserAuthModeUpdate{..}

src/Jobs/Handler/SendNotification/Allocation.hs

@@ -56,7 +56,7 @@ dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = us
 
 dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Handler ()
 dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = do
-  courses <- fmap (nubOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
+  courses <- fmap (nubOrdOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
     E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
     E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
     E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
@@ -73,7 +73,7 @@ dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient =
 
     return (allocation, course)
 
-  let allocations = nubOn entityKey $ courses ^.. folded . _1
+  let allocations = nubOrdOn entityKey $ courses ^.. folded . _1
 
   unless (null courses) . userMailT jRecipient $ do
     now <- liftIO getCurrentTime
@@ -95,7 +95,7 @@ dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient =
 
 dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Handler ()
 dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRecipient = do
-  courses <- fmap (nubOn (views _2 entityKey) . over (traverse . _3) (fromIntegral . E.unValue)) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
+  courses <- fmap (nubOrdOn (views _2 entityKey) . over (traverse . _3) (fromIntegral . E.unValue)) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
     E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
     E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
     E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
@@ -121,7 +121,7 @@ dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRec
 
     return (allocation, course, unratedAppCount)
 
-  let allocations = nubOn entityKey $ courses ^.. folded . _1
+  let allocations = nubOrdOn entityKey $ courses ^.. folded . _1
 
   unless (null courses) . userMailT jRecipient $ do
     replaceMailHeader "Auto-Submitted" $ Just "auto-generated"

src/Settings/StaticFiles/Webpack.hs

@@ -23,12 +23,13 @@ import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Trans.Writer.Lazy (execWriterT)
 import Control.Monad.Catch (MonadThrow(..))
 
-import Utils (nubOn)
-
 import System.FilePath (makeRelative)
 
 import Text.Shakespeare.Text (st)
 
+import Utils ()
+import Data.Containers.ListUtils
+
 
 mkWebpackEntrypoints :: FilePath -- ^ Path to YAML-manifest
                      -> [FilePath -> Generator]
@@ -62,7 +63,7 @@ mkWebpackEntrypoints manifest mkGen stDir = do
     sequence
       [ sigD entryName [t|[(Route EmbeddedStatic, MimeType)]|]
       , funD entryName
-          [ clause [] (normalB . listE . map (\(n, mime) -> tupE [varE n, TH.lift mime]) $ nubOn fst entries) []
+          [ clause [] (normalB . listE . map (\(n, mime) -> tupE [varE n, TH.lift mime]) $ nubOrdOn fst entries) []
           ]
       , sigD widgetName [t|forall m. (MonadLogger m, MonadWidget m) => (Route EmbeddedStatic -> Route (HandlerSite m)) -> m ()|]
       , funD widgetName

src/Utils.hs

@@ -1,6 +1,6 @@
 module Utils
   ( module Utils
-  , List.nub, List.nubBy
+  , module Data.Containers.ListUtils
   ) where
 
 import ClassyPrelude.Yesod hiding (foldlM, Proxy, handle, catch, bracket)
@@ -50,7 +50,6 @@ import Data.Text (dropWhileEnd, takeWhileEnd, justifyRight)
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
-import qualified Data.List as List
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Vector as V
 
@@ -149,6 +148,8 @@ import Data.Ratio ((%))
 import Data.UUID (UUID)
 import qualified Data.UUID as UUID
 
+import Data.Containers.ListUtils
+
 {-# ANN module ("HLint: ignore Use asum" :: String) #-}
 
 
@@ -253,6 +254,12 @@ selectRep' cMap' needle = asum
 
     noSpaces = CBS.filter (/= ' ')
 
+addAttrsClass :: Text -> [(Text, Text)] -> [(Text, Text)]
+addAttrsClass cl attrs = ("class", cl') : noClAttrs
+  where
+    (clAttrs, noClAttrs) = partition (views _1 $ (== "class") . CI.mk) attrs
+    cl' = Text.intercalate " " . nubOrd . filter (not . null) $ cl : (views _2 (Text.splitOn " ") =<< clAttrs)
+  
 ---------------------
 -- Text and String --
 ---------------------
@@ -538,9 +545,6 @@ partitionWith f (x:xs) = case f x of
 nonEmpty' :: Alternative f => [a] -> f (NonEmpty a)
 nonEmpty' = maybe empty pure . nonEmpty
 
-nubOn :: Eq b => (a -> b) -> [a] -> [a]
-nubOn = List.nubBy . ((==) `on`)
-
 dropWhileM :: (IsSequence seq, Monad m) => (Element seq -> m Bool) -> seq -> m seq
 dropWhileM p xs'
   | Just (x, xs) <- uncons xs'

src/Utils/Lang.hs

@@ -23,6 +23,8 @@ import Control.Monad.Reader.Class (local)
 
 import qualified Data.HashMap.Strict as HashMap
 
+import Data.Containers.ListUtils
+
 
 selectLanguage :: MonadHandler m
                => NonEmpty Lang -- ^ Available translations, first is default
@@ -39,7 +41,7 @@ selectLanguages (defL :| _) [] = defL :| []
 selectLanguages avL (l:ls)
   | not $ null l
   , Just lParts <- nonEmpty $ matchesFor l
-  , found <- List.nub
+  , found <- nubOrd
       [ l'' | lParts' <- NonEmpty.toList lParts
             , l' <- NonEmpty.toList avL
             , l'' <- matchesFor l'
@@ -69,7 +71,7 @@ lowPrioRequestedLangs = maybe [] (mapMaybe (either (const Nothing) Just . Text.d
 
 languagesMiddleware :: forall site a. NonEmpty Lang -> HandlerFor site a -> HandlerFor site a
 languagesMiddleware avL act = do
-  pLangs <- fmap List.nub $ (<>) <$> highPrioRequestedLangs <*> lowPrioRequestedLangs
+  pLangs <- fmap nubOrd $ (<>) <$> highPrioRequestedLangs <*> lowPrioRequestedLangs
   let langs = toList $ selectLanguages avL pLangs
       setLangs hData = hData{ handlerRequest = (handlerRequest hData){ reqLangs = langs } }
   local setLangs $ ($logDebugS "languages" . tshow . (pLangs,langs,) =<< languages) *> act

src/Utils/Lens.hs

@@ -281,6 +281,9 @@ makeLenses_ ''RoomReference
 makePrisms ''SchoolAuthorshipStatementMode
 makePrisms ''SheetAuthorshipStatementMode
 
+makeLenses_ ''AuthorshipStatementSubmission
+makeLenses_ ''AuthorshipStatementDefinition
+
 --------------------------
 -- Fields for `UniWorX` --
 --------------------------

src/Utils/PathPiece.hs

@@ -29,7 +29,7 @@ import qualified Data.HashMap.Strict as HashMap
 
 import Numeric.Natural
 
-import Data.List (nub, foldl)
+import Data.List (foldl)
 
 import Data.Aeson.Types
 import qualified Data.Aeson.Types as Aeson
@@ -47,6 +47,8 @@ import Web.HttpApiData
 import Data.ByteString.Lazy.Base32
 import qualified Data.CaseInsensitive as CI
 
+import Data.Containers.ListUtils
+
 
 mkFiniteFromPathPiece :: Name -> Q ([Dec], Exp)
 mkFiniteFromPathPiece finiteType = do
@@ -178,7 +180,7 @@ derivePathPiece adt mangle joinPP = do
             usesVar ConstructorInfo{..} n
               | n `elem` map tvarName constructorVars = False
               | otherwise = any (elemOf types n) constructorFields
-            fieldTypes = nub $ concatMap constructorFields datatypeCons
+            fieldTypes = nubOrd $ concatMap constructorFields datatypeCons
     tvarName (PlainTV n) = n
     tvarName (KindedTV n _) = n
   sequence . (finDecs ++ ) . pure $

templates/submission.hamlet

@@ -1,5 +1,5 @@
 $newline never
-$if is _Just mcid
+$maybe subCId <- mcid
   $maybe wdgt <- correctionWdgt
     <section>
       <h2>_{MsgTableRating}
@@ -30,10 +30,11 @@ $if is _Just mcid
               <th .table__th>
                 <div .table__td-content>
                   _{MsgSubmissionUserEmail}
-              $if isLecturer && doAuthorshipStatements
+              $if doAuthorshipStatements
                 <th .table__th>
                   <div .table__td-content>
-                    _{MsgSubmissionUserAuthorshipStatementState}
+                    ^{simpleLinkI MsgSubmissionUserAuthorshipStatementState (CSubmissionR tid ssh csh shn subCId SubAuthorshipStatementsR)}
+                    ^{iconTooltip asStatusExplainWdgt Nothing True}
           <tbody>
             $forall subUser <- subUsers
               $case subUser
@@ -63,24 +64,10 @@ $if is _Just mcid
                         <a href="mailto:#{userEmail}">
                           #{userEmail}
                     $# TODO(AuthorshipStatements): show authorship statements to submittors?
-                    $if isLecturer && doAuthorshipStatements
+                    $if doAuthorshipStatements
-                      <td .table__td>
+                      <td .table__td .heated style="--hotness: #{boolHeat (stmt /= ASExists)}">
                         <div .table__td-content>
                           _{stmt}
-          $if isLecturer && doAuthorshipStatements
-            <tfoot>
-              <tr .table__row .table__row--foot .no-stripe .no-hover>
-                <td>
-                <td>
-                <td>
-                <td .table__td>
-                  <div .table__td-content .explanation>
-                    <dl .deflist>
-                      $forall (stmt, explanation) <- asStatuses
-                        <dt .deflist__dt>
-                          _{stmt}
-                        <dd .deflist__dd>
-                          ^{explanation}
 
   <section>
     $case sheetSubmissionMode
@@ -121,5 +108,5 @@ $if is _Just mcid
     <section>
       <h2>_{MsgSubmissionReplace}
       ^{formWidget}
-$else
+$nothing
   ^{formWidget}

templates/widgets/authorship-statement-accept.hamlet

@@ -1,7 +1,7 @@
 $newline never
 <div *{attrs} .authorship-statement-accept__container>
   <div .authorship-statement-accept__statement>
-    ^{authorshipStatementWidget authorshipStatementDefinitionContent}
+    ^{authorshipStatementWidget asd}
 
   <label for=#{checkboxId} .authorship-statement-accept__accept>
     <div .authorship-statement-accept__accept-checkbox>

templates/widgets/authorship-statement-submission-explanation.hamlet

@@ -0,0 +1,8 @@
+$newline never
+<div .explanation>
+   <dl .deflist>
+     $forall (stmt, explanation) <- asStatuses
+       <dt .deflist__dt>
+         _{stmt}
+       <dd .deflist__dd>
+         ^{explanation}

test/Database/Fill.hs

@@ -1320,7 +1320,7 @@ fillDb = do
   bigAllocShorthands <-
     let go xs = let (csh, xs') = List.splitAt 3 xs
                  in pack csh : go xs'
-     in take 40 . nub . go <$> getRandomRs ('A', 'Z')
+     in take 40 . nubOrd . go <$> getRandomRs ('A', 'Z')
   bigAllocCourses <- forM (zip [1..] bigAllocShorthands) $ \(n :: Natural, csh) -> do
     cap <- getRandomR (10,50)
 

translate.hs

@@ -58,6 +58,8 @@ import Data.Ord (Down(..))
 
 import Control.Monad.Catch
 
+import Data.Containers.ListUtils
+
 
 data Translate
   = TranslateMsgs
@@ -131,7 +133,7 @@ main = main' =<< run
     main' m@TranslateMsgs{..}
       | null msgRequiredLangs = main' m{ msgRequiredLangs = ["de-de-formal", "en-eu"] }
       | otherwise = do
-          msgFiles' <- nub . (msgFiles ++) <$> getMissingFiles m
+          msgFiles' <- nubOrd . (msgFiles ++) <$> getMissingFiles m
 
           let
             filePairs :: [(FilePath, FilePath)]