refactor: be more explicit about ARC strictness

models/allocations.model

@@ -31,6 +31,7 @@ AllocationMatching
     fingerprint         AllocationFingerprint
     time                UTCTime
     log                 FileContentReference
+    deriving Generic
 
 AllocationCourse
     allocation          AllocationId
@@ -38,6 +39,7 @@ AllocationCourse
     minCapacity         Int          -- if the course would get assigned fewer than this many applicants, restart the assignment process without the course
     acceptSubstitutes   UTCTime Maybe
     UniqueAllocationCourse course
+    deriving Generic
 
 AllocationUser
     allocation          AllocationId
@@ -45,17 +47,18 @@ AllocationUser
     totalCourses        Word64           -- number of total allocated courses for this user must be <= than this number
     priority            AllocationPriority Maybe
     UniqueAllocationUser allocation user
-    deriving Eq Ord Show
+    deriving Eq Ord Show Generic
 
 AllocationDeregister -- self-inflicted user-deregistrations from an allocated course
     user                UserId
     course              CourseId Maybe
     time                UTCTime
     reason              Text Maybe -- if this deregistration was done by proxy (e.g. the lecturer pressed the button)
-    deriving Eq Ord Show
+    deriving Eq Ord Show Generic
 
 AllocationNotificationSetting
     user                UserId
     allocation          AllocationId
     isOptOut            Bool
-    UniqueAllocationNotificationSetting user allocation
+    UniqueAllocationNotificationSetting user allocation
+    deriving Generic

models/audit.model

@@ -5,4 +5,4 @@ TransactionLog
   initiator UserId Maybe -- User associated with performing this action
   remote IP Maybe -- Remote party that triggered this action via HTTP
   info Value -- JSON-encoded `Transaction`
-  deriving Eq Read Show Generic Typeable
+  deriving Eq Read Show Generic

models/changelog.model

@@ -2,3 +2,4 @@ ChangelogItemFirstSeen
   item ChangelogItem
   firstSeen Day
   Primary item
+  deriving Generic

models/config.model

@@ -3,4 +3,5 @@
 ClusterConfig
     setting             ClusterSettingsKey -- I.e. Symmetric key for encrypting database-ids for use in URLs, Symmetric key for encrypting user-sessions so they can be saved directly as a browser-cookie, Symmetric key for encrypting error messages which might contain secret information, ...
     value               Value              -- JSON-encoded value
-    Primary setting
+    Primary setting
+    deriving Generic

models/courses.model

@@ -3,6 +3,7 @@ DegreeCourse json   -- for which degree programmes this course is appropriate fo
     degree       StudyDegreeId
     terms        StudyTermsId
     UniqueDegreeCourse course degree terms
+    deriving Generic
 Course    -- Information about a single course; contained info is always visible to all users
     name             (CI Text)
     description      StoredMarkup Maybe    -- user-defined large Html, ought to contain module description
@@ -36,6 +37,7 @@ CourseEvent
     time Occurrences
     note StoredMarkup Maybe
     lastChanged UTCTime default=now()
+    deriving Generic
 
 CourseAppInstructionFile
     course   CourseId
@@ -43,16 +45,19 @@ CourseAppInstructionFile
     content  FileContentReference Maybe
     modified UTCTime
     UniqueCourseAppInstructionFile course title
+    deriving Generic
 
 CourseEdit                -- who edited when a row in table "Course", kept indefinitely (might be replaced by generic Audit Table; like all ...-Edit tables)
     user         UserId
     time         UTCTime
     course       CourseId
+    deriving Generic
 Lecturer                       -- course ownership
     user         UserId
     course       CourseId
     type         LecturerType  default='"lecturer"'::jsonb
     UniqueLecturer user course -- note: multiple lecturers per course are allowed, but no duplicated rows in this table
+    deriving Generic
 CourseParticipant                      -- course enrolement
     course       CourseId
     user         UserId
@@ -61,7 +66,7 @@ CourseParticipant                      -- course enrolement
     allocated    AllocationId Maybe    -- participant was centrally allocated
     state        CourseParticipantState
     UniqueParticipant user course
-    deriving Eq Ord Show
+    deriving Eq Ord Show Generic
 -- Replace the last two by the following, once an audit log is available
 -- CourseUserNote                 -- lecturers of a specific course may share a text note on each enrolled student
 --     course       CourseId
@@ -75,13 +80,16 @@ CourseUserNote                 -- lecturers of a specific course may share a tex
     user         UserId
     note         StoredMarkup  -- arbitrary user-defined text; visible only to lecturer of this course
     UniqueCourseUserNote user course
+    deriving Generic
 CourseUserNoteEdit             -- who edited a participants course note when
     user         UserId
     time         UTCTime
     note         CourseUserNoteId -- PROBLEM: deleted notes have no modification date any more
+    deriving Generic
 
 CourseUserExamOfficeOptOut
     course       CourseId
     user         UserId
     school       SchoolId
     UniqueCourseUserExamOfficeOptOut course user school
+    deriving Generic

models/courses/applications.model

@@ -10,6 +10,7 @@ CourseApplication
     allocationPriority  Word64          Maybe
     time                UTCTime               default=now()
     ratingTime          UTCTime         Maybe
+    deriving Generic
 
 CourseApplicationFile 
     application         CourseApplicationId
@@ -17,3 +18,4 @@ CourseApplicationFile
     content             FileContentReference Maybe
     modified            UTCTime
     UniqueCourseApplicationFile application title
+    deriving Generic

models/courses/favourite.model

@@ -4,7 +4,9 @@ CourseFavourite           -- which user accessed which course when, only display
     reason       FavouriteReason
     lastVisit    UTCTime
     UniqueCourseFavourite user course
+    deriving Generic
 CourseNoFavourite
     user         UserId
     course       CourseId
-    UniqueCourseNoFavourite user course
+    UniqueCourseNoFavourite user course
+    deriving Generic

models/courses/materials.model

@@ -12,4 +12,5 @@ MaterialFile -- a file that is part of a material distribution
   title    FilePath
   content  FileContentReference Maybe
   modified UTCTime
-  UniqueMaterialFile material title
+  UniqueMaterialFile material title
+  deriving Generic

models/courses/news.model

@@ -6,9 +6,11 @@ CourseNews
     content             StoredMarkup
     summary             StoredMarkup Maybe
     lastEdit            UTCTime
+    deriving Generic
 CourseNewsFile
     news     CourseNewsId
     title    FilePath
     content  FileContentReference Maybe
     modified UTCTime
-    UniqueCourseNewsFile news title
+    UniqueCourseNewsFile news title
+    deriving Generic

models/exam-office.model

@@ -3,17 +3,21 @@ ExamOfficeField
     field   StudyTermsId
     forced  Bool
     UniqueExamOfficeField office field
+    deriving Generic
 ExamOfficeUser
     office  UserId
     user    UserId
     UniqueExamOfficeUser office user
+    deriving Generic
 ExamOfficeResultSynced
     school  SchoolId Maybe
     office  UserId
     result  ExamResultId
     time    UTCTime
+    deriving Generic
 ExamOfficeExternalResultSynced
     school  SchoolId Maybe
     office  UserId
     result  ExternalExamResultId
-    time    UTCTime
+    time    UTCTime
+    deriving Generic

models/exams.model

@@ -21,6 +21,7 @@ Exam
   staff Text Maybe
   partsFrom UTCTime Maybe
   UniqueExam course name
+  deriving Generic
 ExamPart
   exam ExamId
   number ExamPartNumber
@@ -29,7 +30,7 @@ ExamPart
   weight Rational
   UniqueExamPartNumber exam number
   UniqueExamPartName exam name !force
-  deriving Read Show Eq Ord Generic Typeable
+  deriving Read Show Eq Ord Generic
 ExamOccurrence
   exam ExamId
   name ExamOccurrenceName
@@ -40,43 +41,47 @@ ExamOccurrence
   end UTCTime Maybe
   description StoredMarkup Maybe
   UniqueExamOccurrence exam name
+  deriving Generic
 ExamRegistration
   exam ExamId
   user UserId
   occurrence ExamOccurrenceId Maybe
   time UTCTime default=now()
   UniqueExamRegistration exam user
-  deriving Eq Ord Show
+  deriving Eq Ord Show Generic
 ExamPartResult
   examPart ExamPartId
   user UserId
   result ExamResultPoints
   lastChanged UTCTime default=now()
   UniqueExamPartResult examPart user
-  deriving Eq Ord Show
+  deriving Eq Ord Show Generic
 ExamBonus
   exam ExamId
   user UserId
   bonus Points
   lastChanged UTCTime default=now()
   UniqueExamBonus exam user
-  deriving Eq Ord Show
+  deriving Eq Ord Show Generic
 ExamResult
   exam ExamId
   user UserId
   result ExamResultPassedGrade
   lastChanged UTCTime default=now()
   UniqueExamResult exam user
-  deriving Eq Ord Show
+  deriving Eq Ord Show Generic
 ExamCorrector
   exam ExamId
   user UserId
   UniqueExamCorrector exam user
+  deriving Generic
 ExamPartCorrector
   part ExamPartId
   corrector ExamCorrectorId
   UniqueExamPartCorrector part corrector
+  deriving Generic
 ExamOfficeSchool
   school SchoolId
   exam ExamId
   UniqueExamOfficeSchool exam school
+  deriving Generic

models/external-exams.model

@@ -6,6 +6,7 @@ ExternalExam
   defaultTime UTCTime Maybe
   gradingMode ExamGradingMode
   UniqueExternalExam term school courseName examName
+  deriving Generic
 ExternalExamResult
   user UserId
   exam ExternalExamId
@@ -13,12 +14,14 @@ ExternalExamResult
   time UTCTime
   lastChanged UTCTime
   UniqueExternalExamResult exam user
-  deriving Eq Ord Show
+  deriving Eq Ord Show Generic
 ExternalExamStaff
   user UserId
   exam ExternalExamId
   UniqueExternalExamStaff exam user
+  deriving Generic
 ExternalExamOfficeSchool
   school SchoolId
   exam ExternalExamId
-  UniqueExternalExamOfficeSchool exam school
+  UniqueExternalExamOfficeSchool exam school
+  deriving Generic

models/files.model

@@ -3,28 +3,34 @@ FileContentEntry
     ix                Word64 
     chunkHash         FileContentChunkId
     UniqueFileContentEntry hash ix
+    deriving Generic
 
 FileContentChunk
     hash              FileContentChunkReference
     content           ByteString
     contentBased      Bool default=false -- For Migration
     Primary           hash
+    deriving Generic
 
 FileContentChunkUnreferenced
     hash              FileContentChunkId
     since             UTCTime
     UniqueFileContentChunkUnreferenced hash
+    deriving Generic
 
 SessionFile
     content         FileContentReference Maybe
     touched         UTCTime
+    deriving Generic
 
 FileLock
     content         FileContentReference
     instance        InstanceId
     time            UTCTime
+    deriving Generic
 
 FileChunkLock
     hash            FileContentChunkReference
     instance        InstanceId
-    time            UTCTime
+    time            UTCTime
+    deriving Generic

models/invitations.model

@@ -3,4 +3,5 @@ Invitation
   for       Value
   data      Value
   expiresAt UTCTime Maybe
-  UniqueInvitation email for
+  UniqueInvitation email for
+  deriving Generic

models/jobs.model

@@ -6,7 +6,7 @@ QueuedJob
     lockInstance        InstanceId Maybe   -- instance that has started to execute this job
     lockTime            UTCTime Maybe      -- time when execution had begun
     writeLastExec       Bool default=false -- record successful execution to CronLastExec
-    deriving Eq Read Show Generic Typeable
+    deriving Eq Read Show Generic
 
 -- Jobs are deleted from @QueuedJob@ after they are executed successfully and recorded in @CronLastExec@
 -- There is a Cron-system that, at set intervals, queries the database for work to be done in the background (i.e. if a lecturer has set a sheet's submissions to be automatically distributed and the submission deadline passed since the last check, then queue a new job to actually do the distribution)
@@ -16,9 +16,11 @@ CronLastExec
     time                UTCTime -- When was the job executed
     instance            InstanceId -- Which uni2work-instance did the work
     UniqueCronLastExec job
+    deriving Generic
 
 TokenBucket
     ident               TokenBucketIdent
     lastValue           Int64
     lastAccess          UTCTime
-    Primary             ident
+    Primary             ident
+    deriving Generic

models/mail.model

@@ -6,8 +6,10 @@ SentMail
     recipient    UserId Maybe
     headers      MailHeaders
     contentRef   SentMailContentId
+    deriving Generic
 
 SentMailContent
     hash    MailContentReference
     content MailContent
-    Primary hash
+    Primary hash
+    deriving Generic

models/schools.model

@@ -16,7 +16,9 @@ SchoolLdap
     school  SchoolId Maybe
     orgUnit (CI Text)
     UniqueOrgUnit orgUnit
+    deriving Generic
 SchoolTerms
     school  SchoolId
     terms   StudyTermsId
-    UniqueSchoolTerms school terms
+    UniqueSchoolTerms school terms
+    deriving Generic

models/sheets.model

@@ -21,6 +21,7 @@ SheetEdit                     -- who edited when a row in table "Course", kept i
     user            UserId
     time            UTCTime
     sheet           SheetId
+    deriving Generic
 
 -- For anonoymous external submissions (i.e. paper submission tracked in uni2work)
 -- Map pseudonyms to users injectively in the context of a single sheet; for the next sheet all-new pseudonyms need to be created
@@ -31,13 +32,14 @@ SheetPseudonym
     user            UserId
     UniqueSheetPseudonym sheet pseudonym
     UniqueSheetPseudonymUser sheet user
+    deriving Generic
 SheetCorrector                -- grant corrector role to user for a sheet
     user            UserId
     sheet           SheetId
     load            Load      -- portion of work that will be assigned to this corrector
     state           CorrectorState default='CorrectorNormal' -- whether a corrector is assigned his load this time (e.g. in case of sickness)
     UniqueSheetCorrector user sheet
-    deriving Show Eq Ord
+    deriving Show Eq Ord Generic
 SheetFile                     -- a file that is part of an exercise sheet
     sheet    SheetId
     type     SheetFileType   -- excercise, marking, hint or solution
@@ -45,6 +47,7 @@ SheetFile                     -- a file that is part of an exercise sheet
     content  FileContentReference Maybe
     modified UTCTime
     UniqueSheetFile sheet type title
+    deriving Generic
 PersonalisedSheetFile
     sheet    SheetId
     user     UserId
@@ -53,11 +56,12 @@ PersonalisedSheetFile
     content  FileContentReference Maybe
     modified UTCTime
     UniquePersonalisedSheetFile sheet user type title
-    deriving Eq Ord Read Show Generic Typeable
+    deriving Eq Ord Read Show Typeable Generic
 
 FallbackPersonalisedSheetFilesKey
     course    CourseId
     index     Word24
     secret    ByteString
     generated UTCTime
-    UniqueFallbackPersonalisedSheetFilesKey course index
+    UniqueFallbackPersonalisedSheetFilesKey course index
+    deriving Generic

models/study-features.model

@@ -10,13 +10,14 @@ StudyFeatures  -- multiple entries possible for students pursuing several degree
     valid         Bool default=true
     relevanceCached UUID Maybe
     UniqueStudyFeatures user degree field type semester
-    deriving Eq Show
+    deriving Eq Show Generic
     -- UniqueUserSubject ubuser degree field -- There exists a counterexample
 
 RelevantStudyFeatures
     term          TermId
     studyFeatures StudyFeaturesId
     UniqueRelevantStudyFeatures term studyFeatures
+    deriving Generic
 
 StudyDegree   -- Studienabschluss
     key           Int            -- LMU-internal key
@@ -24,7 +25,7 @@ StudyDegree   -- Studienabschluss
     name          Text Maybe     -- description given by LDAP
     Primary key                  -- column key is used as actual DB row key
                                  -- newtype Key StudyDegree = StudyDegreeKey' { unStudyDegreeKey :: Int }
-    deriving Eq Show
+    deriving Eq Show Generic
 StudyTerms    -- Studiengang
     key           Int            -- standardised key
     shorthand     Text Maybe     -- admin determined shorthand
@@ -33,11 +34,12 @@ StudyTerms    -- Studiengang
     defaultType   StudyFieldType Maybe
     Primary key                  -- column key is used as actual DB row key
                                  -- newtype Key StudyTerms = StudyTermsKey' { unStudyTermsKey :: Int }
-    deriving Eq Ord Show
+    deriving Eq Ord Show Generic
 StudySubTerms
     child         StudyTermsId
     parent        StudyTermsId
     UniqueStudySubTerms child parent
+    deriving Generic
 StudyTermNameCandidate    -- No one at LMU is willing and able to tell us the meaning of the keys for StudyDegrees and StudyTerms.
     -- Each LDAP login provides an unordered set of keys and an unordered set of plain text description with an unknown 1-1 correspondence.
     -- This table helps us to infer which key belongs to which plain text by recording possible combinations at login.
@@ -45,14 +47,14 @@ StudyTermNameCandidate    -- No one at LMU is willing and able to tell us the me
     incidence     TermCandidateIncidence -- random id, generated once per login to associate matching pairs
     key           Int      -- a possible key for the studyTermName or studySubTermName
     name          Text     -- studyTermName as plain text from LDAP
-    deriving Show Eq Ord
+    deriving Show Eq Ord Generic
 StudySubTermParentCandidate
     incidence     TermCandidateIncidence
     key           Int
     parent        Int
-    deriving Show Eq Ord
+    deriving Show Eq Ord Generic
 StudyTermStandaloneCandidate
     incidence     TermCandidateIncidence
     key           Int
-    deriving Show Eq Ord
+    deriving Show Eq Ord Generic
 

models/submissions.model

@@ -10,6 +10,7 @@ SubmissionEdit                    -- user uploads new version of their submissio
     user            UserId Maybe  -- track id, important for group submissions
     time            UTCTime
     submission      SubmissionId
+    deriving Generic
 SubmissionFile json               -- files that are part of a submission
     submission SubmissionId
     title      FilePath
@@ -18,17 +19,19 @@ SubmissionFile json               -- files that are part of a submission
     isUpdate   Bool          -- is this the file updated by a corrector (original will always be retained)
     isDeletion Bool          -- only set if isUpdate is also set, but file was deleted by corrector
     UniqueSubmissionFile submission title isUpdate
-    deriving Eq Ord Read Show 
+    deriving Eq Ord Read Show Generic
 SubmissionUser                    -- which submission belongs to whom
     user            UserId
     submission      SubmissionId
     UniqueSubmissionUser user submission -- multiple users may share same submission, in case of (ad-hoc) submission groups
+    deriving Generic
 SubmissionGroup                   -- pre-defined submission groups; some courses only allow pre-defined submission groups
     course          CourseId
     name            SubmissionGroupName
     UniqueSubmissionGroup course name
+    deriving Generic
 SubmissionGroupUser              -- Registered submission groups, just for checking upon submission, but independent of actual SubmissionUser
     submissionGroup     SubmissionGroupId
     user                UserId
     UniqueSubmissionGroupUser submissionGroup user
-    deriving Eq Ord Show
+    deriving Eq Ord Show Generic

models/system-messages.model

@@ -13,6 +13,7 @@ SystemMessage
     defaultLanguage     Lang -- Language of @content@ and @summary@
     content             StoredMarkup -- Detailed message shown when clicking on the @summary@-popup or when no @summary@ is specified
     summary             StoredMarkup Maybe
+    deriving Generic
 
 SystemMessageTranslation -- Translation of a @SystemMessage@ into another language; which language to choose is determined by user-sent HTTP-headers
     message             SystemMessageId
@@ -20,9 +21,11 @@ SystemMessageTranslation -- Translation of a @SystemMessage@ into another langua
     content             StoredMarkup
     summary             StoredMarkup Maybe
     UniqueSystemMessageTranslation message language
+    deriving Generic
 
 SystemMessageHidden
     message             SystemMessageId
     user                UserId
     time                UTCTime
-    UniqueSystemMessageHidden user message
+    UniqueSystemMessageHidden user message
+    deriving Generic

models/tutorials.model

@@ -18,8 +18,10 @@ Tutor
     tutorial    TutorialId
     user        UserId
     UniqueTutor tutorial user
+    deriving Generic
 TutorialParticipant
     tutorial    TutorialId
     user        UserId
     UniqueTutorialParticipant tutorial user
-    deriving Eq Ord Show
+    deriving Eq Ord Show
+    deriving Generic

models/users.model

@@ -44,21 +44,25 @@ UserFunction -- Administratively assigned functions (lecturer, admin, evaluation
     school   SchoolId
     function SchoolFunction
     UniqueUserFunction user school function
+    deriving Generic
 UserSystemFunction
     user     UserId
     function SystemFunction
     manual   Bool
     isOptOut Bool
     UniqueUserSystemFunction user function
+    deriving Generic
 UserExamOffice
     user     UserId
     field    StudyTermsId
     UniqueUserExamOffice user field
+    deriving Generic
 UserSchool -- Managed by users themselves, encodes "schools of interest"
     user     UserId
     school   SchoolId
     isOptOut Bool     -- true if this a marker, that the user manually deleted this entry; it should not be recreated automatically 
     UniqueUserSchool user school
+    deriving Generic
 
 UserGroupMember
     group         UserGroupName
@@ -67,4 +71,6 @@ UserGroupMember
 
     UniquePrimaryUserGroupMember group primary !force
     UniqueUserGroupMember group user
+
+    deriving Generic
     

models/workflows.model

@@ -2,6 +2,7 @@ SharedWorkflowGraph
     hash        WorkflowGraphReference
     graph       (WorkflowGraph FileReference SqlBackendKey) -- UserId
     Primary     hash
+    deriving Generic
 
 WorkflowDefinition
     graph       SharedWorkflowGraphId
@@ -9,6 +10,7 @@ WorkflowDefinition
     name        WorkflowDefinitionName 
     instanceCategory WorkflowInstanceCategory Maybe
     UniqueWorkflowDefinition name scope
+    deriving Generic
 
 WorkflowDefinitionDescription
     definition  WorkflowDefinitionId
@@ -16,6 +18,7 @@ WorkflowDefinitionDescription
     title       Text
     description StoredMarkup Maybe
     UniqueWorkflowDefinitionDescription definition language
+    deriving Generic
 
 WorkflowDefinitionInstanceDescription
     definition  WorkflowDefinitionId
@@ -23,6 +26,7 @@ WorkflowDefinitionInstanceDescription
     title       Text
     description StoredMarkup Maybe
     UniqueWorkflowDefinitionInstanceDescription definition language
+    deriving Generic
 
 WorkflowInstance
     definition  WorkflowDefinitionId Maybe
@@ -31,6 +35,7 @@ WorkflowInstance
     name        WorkflowInstanceName
     category    WorkflowInstanceCategory Maybe
     UniqueWorkflowInstance name scope
+    deriving Generic
     
 WorkflowInstanceDescription
     instance    WorkflowInstanceId
@@ -38,9 +43,11 @@ WorkflowInstanceDescription
     title       Text
     description StoredMarkup Maybe
     UniqueWorkflowInstanceDescription instance language
+    deriving Generic
 
 WorkflowWorkflow
     instance    WorkflowInstanceId Maybe
     scope       (WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey)  -- TermId, SchoolId, CourseId
     graph       SharedWorkflowGraphId
     state       (WorkflowState FileReference SqlBackendKey)  -- UserId
+    deriving Generic

src/Database/Persist/Class/Instances.hs

@@ -30,9 +30,6 @@ instance PersistEntity record => Binary (Key record) where
   putList = Binary.putList . map toPersistValue
   get = either (fail . unpack) return . fromPersistValue =<< Binary.get
 
-instance PersistEntity record => NFData (Key record) where
-  rnf = rnf . keyToValues
-
 
 uniqueToMap :: PersistEntity record => Unique record -> Map (HaskellName, DBName) PersistValue
 uniqueToMap = fmap Map.fromList $ zip <$> persistUniqueToFieldNames <*> persistUniqueToValues

src/Database/Persist/Types/Instances.hs

@@ -26,3 +26,6 @@ instance NFData PersistValue
 
 instance (NFData record, NFData (Key record)) => NFData (Entity record) where
   rnf Entity{..} = rnf entityKey `seq` rnf entityVal
+
+deriving instance Generic Checkmark
+deriving anyclass instance NFData Checkmark

src/Model.hs

@@ -33,7 +33,7 @@ type SqlBackendKey = BackendKey SqlBackend
 -- You can find more information on persistent and how to declare entities
 -- at:
 -- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateUniWorX", mkSave "currentModel"]
+share [mkPersist sqlSettings{ mpsDeriveInstances = [''NFData] }, mkDeleteCascade sqlSettings, mkMigrate "migrateUniWorX", mkSave "currentModel"]
     $(persistDirectoryWith lowerCaseSettings "models")
 
 
@@ -51,8 +51,6 @@ deriving newtype instance FromJSONKey ExamOccurrenceId
 
 deriving instance Show (Unique ExamPart)
 
-deriving anyclass instance NFData ExamPart
-
 -- ToMarkup and ToMessage instances for displaying selected database primary keys
 
 instance ToMarkup (Key School) where

src/Model/Types/Allocation.hs

@@ -32,6 +32,7 @@ data AllocationPriority
   = AllocationPriorityNumeric { allocationPriorities :: Vector Integer }
   | AllocationPriorityOrdinal { allocationOrdinal :: Natural }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
   , constructorTagModifier = camelToPathPiece' 2
@@ -49,7 +50,9 @@ instance Binary AllocationPriority
 data AllocationPriorityNumericRecord = AllocationPriorityNumericRecord
   { apmrMatrikelnummer :: UserMatriculation
   , apmrPriority :: Vector Integer
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 allocationPriorityNumericMap :: Prism' (Map UserMatriculation AllocationPriority) AllocationPriorityNumericRecord
 allocationPriorityNumericMap = prism' fromPrioRecord toPrioRecord
@@ -90,6 +93,7 @@ data AllocationPriorityComparison
   = AllocationPriorityComparisonNumeric { allocationGradeScale :: Rational }
   | AllocationPriorityComparisonOrdinal { allocationCloneIndex :: Down Natural, allocationOrdinalScale :: Rational }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 
 type AllocationFingerprint = Digest (SHAKE128 128)

src/Model/Types/Course.hs

@@ -16,9 +16,7 @@ import Utils.Lens.TH
 
 data LecturerType = CourseLecturer | CourseAssistant
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-
+  deriving (Universe, Finite, NFData) 
-instance Universe LecturerType
-instance Finite LecturerType
 
 nullaryPathPiece ''LecturerType $ camelToPathPiece' 1
 deriveJSON  defaultOptions
@@ -33,7 +31,7 @@ data CourseParticipantState
   = CourseParticipantActive
   | CourseParticipantInactive { courseParticipantNoShow :: Bool }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
-  deriving anyclass (Hashable)
+  deriving anyclass (NFData, Hashable)
 
 makePrisms ''CourseParticipantState
 makeLenses_ ''CourseParticipantState

src/Model/Types/DateTime.hs

@@ -153,6 +153,7 @@ data OccurrenceSchedule = ScheduleWeekly
                           , scheduleEnd       :: TimeOfDay
                           }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
@@ -170,6 +171,7 @@ data OccurrenceException = ExceptOccur
                           { exceptTime  :: LocalTime
                           }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
@@ -180,7 +182,9 @@ deriveJSON defaultOptions
 data Occurrences = Occurrences
   { occurrencesScheduled  :: Set OccurrenceSchedule
   , occurrencesExceptions :: Set OccurrenceException
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1

src/Model/Types/Exam.hs

@@ -78,6 +78,7 @@ data ExamResult' res = ExamAttended { examResult :: res }
                      | ExamNoShow
                      | ExamVoided
   deriving (Show, Read, Eq, Ord, Functor, Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 1
   , fieldLabelModifier = camelToPathPiece' 1
@@ -156,6 +157,7 @@ data ExamBonusRule = ExamBonusManual
                      , bonusRound :: Points
                      }
   deriving (Show, Read, Eq, Ord, Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
   , constructorTagModifier = camelToPathPiece' 1
@@ -171,7 +173,8 @@ data ExamOccurrenceRule = ExamRoomManual
                         | ExamRoomSurname
                         | ExamRoomMatriculation
                         | ExamRoomRandom
-  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite, NFData)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
   , constructorTagModifier = camelToPathPiece' 2
@@ -195,6 +198,7 @@ data ExamOccurrenceMappingDescription
   | ExamOccurrenceMappingSpecial { eaomrSpecial :: [CI Char] }
   | ExamOccurrenceMappingRandom
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
   , constructorTagModifier = camelToPathPiece' 3
@@ -206,7 +210,9 @@ makePrisms ''ExamOccurrenceMappingDescription
 data ExamOccurrenceMapping roomId = ExamOccurrenceMapping
   { examOccurrenceMappingRule :: ExamOccurrenceRule
   , examOccurrenceMappingMapping :: Map roomId (Set ExamOccurrenceMappingDescription)
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 instance ToJSONKey roomId => ToJSON (ExamOccurrenceMapping roomId) where
   toJSON = genericToJSON defaultOptions
     { fieldLabelModifier = camelToPathPiece' 3
@@ -269,8 +275,7 @@ data ExamGrade
   | Grade13
   | Grade10
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe ExamGrade
+  deriving anyclass (Universe, Finite, NFData)
-instance Finite ExamGrade
 
 numberGrade :: Prism' Rational ExamGrade
 numberGrade = prism toNumberGrade fromNumberGrade
@@ -344,6 +349,7 @@ data ExamGradingRule
     { examGradingKey :: [Points] -- ^ @[n1, n2, n3, ..., n11]@ means @0 <= p < n1 -> p ~= 5@, @n1 <= p < n2 -> p ~ 4@, @n2 <= p < n3 -> p ~ 3.7@, ..., @n10 <= p -> p ~ 1.0@
     }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 2
   , constructorTagModifier = camelToPathPiece' 2
@@ -358,6 +364,7 @@ derivePersistFieldJSON ''ExamGradingRule
 newtype ExamPassed = ExamPassed { examPassed :: Bool }
   deriving (Read, Show, Generic, Typeable)
   deriving newtype (Eq, Ord, Enum, Bounded, PersistField)
+  deriving anyclass (NFData)
 
 instance PersistFieldSql ExamPassed where
   sqlType _ = sqlType $ Proxy @Bool
@@ -403,8 +410,7 @@ data ExamGradingMode
   | ExamGradingGrades
   | ExamGradingMixed
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe ExamGradingMode
+  deriving anyclass (Universe, Finite, NFData)
-instance Finite ExamGradingMode
 
 nullaryPathPiece ''ExamGradingMode $ camelToPathPiece' 2
 pathPieceJSON ''ExamGradingMode
@@ -478,12 +484,13 @@ data ExamAids
   = ExamAidsPreset { examAidsPreset :: ExamAidsPreset }
   | ExamAidsCustom { examAidsCustom :: StoredMarkup }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data ExamAidsPreset
   = ExamOpenBook
   | ExamClosedBook
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 2
@@ -499,12 +506,13 @@ data ExamOnline
   = ExamOnlinePreset { examOnlinePreset :: ExamOnlinePreset }
   | ExamOnlineCustom { examOnlineCustom :: StoredMarkup }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data ExamOnlinePreset
   = ExamOnline
   | ExamOffline
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 2
@@ -520,12 +528,13 @@ data ExamSynchronicity
   = ExamSynchronicityPreset { examSynchronicityPreset :: ExamSynchronicityPreset }
   | ExamSynchronicityCustom { examSynchronicityCustom :: StoredMarkup }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data ExamSynchronicityPreset
   = ExamSynchronous
   | ExamAsynchronous
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 2
@@ -541,6 +550,7 @@ data ExamRequiredEquipment
   = ExamRequiredEquipmentPreset { examRequiredEquipmentPreset :: ExamRequiredEquipmentPreset }
   | ExamRequiredEquipmentCustom { examRequiredEquipmentCustom :: StoredMarkup }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data ExamRequiredEquipmentPreset
   = ExamRequiredEquipmentNone
@@ -551,7 +561,7 @@ data ExamRequiredEquipmentPreset
   | ExamRequiredEquipmentWebcamMicrophoneInternet
   | ExamRequiredEquipmentMicrophoneInternet
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 2
@@ -570,6 +580,8 @@ data ExamMode = ExamMode
   , examSynchronicity :: Maybe ExamSynchronicity
   , examRequiredEquipment :: Maybe ExamRequiredEquipment
   }
+  deriving (Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
   , sumEncoding = UntaggedValue
@@ -582,6 +594,7 @@ data ExamModePredicate
   | ExamModePredSynchronicity ExamSynchronicityPreset
   | ExamModePredRequiredEquipment ExamRequiredEquipmentPreset
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 3
   , sumEncoding = TaggedObject "setting" "preset"
@@ -592,6 +605,7 @@ deriveFinite ''ExamModePredicate
 newtype ExamModeDNF = ExamModeDNF { examModeDNF :: PredDNF ExamModePredicate }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
   deriving newtype (ToJSON, FromJSON, PathPiece)
+  deriving anyclass (NFData)
 
 derivePersistFieldJSON ''ExamModeDNF
 
@@ -600,7 +614,7 @@ data ExamCloseMode
   = ExamCloseSeparate
   | ExamCloseOnFinished { examCloseOnFinishedHidden :: Bool }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
-  deriving anyclass (Binary)
+  deriving anyclass (Binary, NFData)
 deriveFinite ''ExamCloseMode
 finitePathPiece ''ExamCloseMode ["separate", "on-finished", "on-finished-hidden"]
 derivePersistFieldPathPiece ''ExamCloseMode

src/Model/Types/File.hs

@@ -157,7 +157,7 @@ data FileReference = FileReference
   , fileReferenceContent  :: Maybe FileContentReference
   , fileReferenceModified :: UTCTime
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
-    deriving anyclass (Hashable, Binary)
+    deriving anyclass (Hashable, Binary, NFData)
 
 makeLenses_ ''FileReference
 deriveJSON defaultOptions
@@ -179,7 +179,7 @@ instance HasFileReference Void where
 instance HasFileReference FileReference where
   data FileReferenceResidual FileReference = FileReferenceResidual
     deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-    deriving anyclass (Universe, Finite)
+    deriving anyclass (Universe, Finite, NFData)
   -- newtype FileReferenceTitleMap FileReference add = FileReferenceFileReferenceTitleMap { unFileReferenceFileReferenceTitleMap :: Map FilePath (FileReferenceTitleMapElem FileReference add) }
   --   deriving (Eq, Ord, Read, Show, Generic, Typeable)
   --   deriving newtype (Semigroup, Monoid)
@@ -196,6 +196,7 @@ instance HasFileReference PureFile where
   newtype FileReferenceResidual PureFile = PureFileResidual { unPureFileResidual :: Maybe ByteString }
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
     deriving newtype (ToJSON, FromJSON)
+    deriving anyclass (NFData)
 
   _FileReference = iso toFileReference fromFileReference
     where
@@ -213,6 +214,7 @@ instance HasFileReference PureFile where
 
 instance (HasFileReference a, HasFileReference b) => HasFileReference (Either a b) where
   newtype FileReferenceResidual (Either a b) = FileReferenceResidualEither { unFileReferenceResidualEither :: Either (FileReferenceResidual a) (FileReferenceResidual b) }
+    deriving (Generic, Typeable)
 
   _FileReference = iso doSplit doJoin
     where doSplit (Right r) = over _2 (FileReferenceResidualEither . Right) $ r ^. _FileReference
@@ -225,6 +227,7 @@ instance HasFileReference record => HasFileReference (Entity record) where
     { fileReferenceResidualEntityKey :: Key record
     , fileReferenceResidualEntityResidual :: FileReferenceResidual record
     }
+    deriving (Generic, Typeable)
 
   _FileReference = iso doSplit doJoin
     where doSplit Entity{..} = (fRef, FileReferenceResidualEntity entityKey res)
@@ -243,11 +246,14 @@ newtype instance FileReferenceTitleMap FileReference add = FileReferenceFileRefe
     }
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
     deriving newtype (Semigroup, Monoid)
+    deriving anyclass (NFData)
 data FileReferenceFileReferenceTitleMapElem add = FileReferenceFileReferenceTitleMapElem
   { fRefTitleMapContent    :: Maybe FileContentReference
   , fRefTitleMapModified   :: UTCTime
   , fRefTitleMapAdditional :: add
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 makePrisms ''FileReferenceFileReferenceTitleMapElem
 
@@ -265,7 +271,9 @@ instance FileReferenceTitleMapConvertible add FileReference FileReference where
 data FileFieldUserOption a = FileFieldUserOption
   { fieldOptionForce :: Bool
   , fieldOptionDefault :: a
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 2
@@ -279,11 +287,13 @@ data FileField fileid = FileField
   , fieldMaxFileSize :: Maybe Natural
   , fieldAdditionalFiles :: FileReferenceTitleMap fileid (FileFieldUserOption Bool)
   , fieldAllEmptyOk :: Bool
-  } deriving (Generic, Typeable)
+  }
+  deriving (Generic, Typeable)
 deriving instance Eq (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Eq (FileField fileid)
 deriving instance Ord (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Ord (FileField fileid)
 deriving instance Read (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Read (FileField fileid)
 deriving instance Show (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Show (FileField fileid)
+deriving anyclass instance NFData (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => NFData (FileField fileid)
 
 instance ToJSON (FileField FileReference) where
   toJSON FileField{..} = JSON.object $ catMaybes 

src/Model/Types/Mail.hs

@@ -64,11 +64,7 @@ data NotificationTrigger
   | NTExamOfficeExamResultsChanged
   | NTCourseRegistered
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-
+  deriving anyclass (Universe, Finite, Hashable, NFData)
-instance Universe NotificationTrigger
-instance Finite NotificationTrigger
-
-instance Hashable NotificationTrigger
 
 nullaryPathPiece ''NotificationTrigger $ camelToPathPiece' 1
 pathPieceJSON ''NotificationTrigger
@@ -78,6 +74,7 @@ pathPieceJSONKey ''NotificationTrigger
 newtype NotificationSettings = NotificationSettings { notificationAllowed :: NotificationTrigger -> Bool }
   deriving (Generic, Typeable)
   deriving newtype (Eq, Ord, Read, Show)
+  deriving anyclass (NFData)
 
 instance Default NotificationSettings where
   def = NotificationSettings $ not . flip HashSet.member defaultOff
@@ -117,7 +114,7 @@ instance PathPiece BounceSecret where
 newtype MailContent = MailContent [Alternatives]
   deriving (Eq, Show, Generic, Typeable)
   deriving newtype (ToJSON, FromJSON)
-  deriving anyclass (Binary)
+  deriving anyclass (Binary, NFData)
 
 derivePersistFieldJSON ''MailContent
 

src/Model/Types/Markup.hs

@@ -30,7 +30,7 @@ data MarkupFormat
   | MarkupHtml
   | MarkupPlaintext
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 nullaryPathPiece ''MarkupFormat $ camelToPathPiece' 1
 pathPieceJSON ''MarkupFormat
 
@@ -38,7 +38,9 @@ data StoredMarkup = StoredMarkup
   { markupInputFormat :: MarkupFormat
   , markupInput       :: LT.Text
   , markupOutput      :: Html
-  } deriving (Read, Show, Generic, Typeable)
+  }
+  deriving (Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 htmlToStoredMarkup :: Html -> StoredMarkup
 htmlToStoredMarkup html = StoredMarkup

src/Model/Types/Misc.hs

@@ -24,7 +24,7 @@ import Web.HttpApiData
 
 data StudyFieldType = FieldPrimary | FieldSecondary
   deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 derivePersistField "StudyFieldType"
 nullaryPathPiece ''StudyFieldType $ camelToPathPiece' 1
@@ -41,14 +41,12 @@ data Theme
   | ThemeMossGreen
   | ThemeSkyLove
   deriving (Eq, Ord, Bounded, Enum, Show, Read, Generic)
+  deriving anyclass (Universe, Finite, NFData)
 
 deriveJSON defaultOptions
   { constructorTagModifier = fromJust . stripPrefix "Theme"
   } ''Theme
 
-instance Universe Theme
-instance Finite Theme
-
 nullaryPathPiece ''Theme $ camelToPathPiece' 1
 
 $(deriveSimpleWith ''ToMessage 'toMessage (over Text.packed $ Text.intercalate " " . unsafeTail . splitCamel) ''Theme) -- describe theme to user
@@ -64,8 +62,7 @@ data FavouriteReason
   | FavouriteManual
   | FavouriteCurrent
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe FavouriteReason
+  deriving anyclass (Universe, Finite, NFData)
-instance Finite FavouriteReason
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 1
   } ''FavouriteReason
@@ -77,8 +74,7 @@ data Sex
   | SexFemale
   | SexNotApplicable
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe Sex
+  deriving anyclass (Universe, Finite, NFData)
-instance Finite Sex
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 1
   } ''Sex
@@ -129,7 +125,7 @@ data TokenBucketIdent = TokenBucketInjectFiles | TokenBucketInjectFilesCount
                       | TokenBucketPruneFiles
                       | TokenBucketRechunkFiles
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite, Hashable)
+  deriving anyclass (Universe, Finite, Hashable, NFData)
 
 nullaryPathPiece ''TokenBucketIdent $ camelToPathPiece' 2
 pathPieceJSON ''TokenBucketIdent

src/Model/Types/Room.hs

@@ -16,6 +16,7 @@ data RoomReference
     , roomRefInstructions :: Maybe StoredMarkup
     }
   deriving (Eq, Ord, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 2

src/Model/Types/School.hs

@@ -10,10 +10,7 @@ data SchoolFunction
   | SchoolExamOffice
   | SchoolAllocation
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-instance Universe SchoolFunction
+  deriving anyclass (Universe, Finite, Hashable, NFData)
-instance Finite SchoolFunction
-instance Hashable SchoolFunction
-instance NFData SchoolFunction
 
 nullaryPathPiece ''SchoolFunction $ camelToPathPiece' 1
 pathPieceJSON ''SchoolFunction

src/Model/Types/Security.hs

@@ -250,7 +250,7 @@ data UserGroupName
   = UserGroupMetrics | UserGroupCrontab
   | UserGroupCustom { userGroupCustomName :: CI Text }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
-  deriving anyclass (Hashable)
+  deriving anyclass (Hashable, NFData)
 
 instance PathPiece UserGroupName where
   toPathPiece UserGroupMetrics = "metrics"

src/Model/Types/Sheet.hs

@@ -168,7 +168,8 @@ data SheetGroup
   = Arbitrary { maxParticipants :: Natural }
   | RegisteredGroups
   | NoGroups
-  deriving (Show, Read, Eq, Generic)
+  deriving (Show, Read, Eq, Generic, Typeable)
+  deriving anyclass (NFData)
 deriveJSON defaultOptions ''SheetGroup
 derivePersistFieldJSON ''SheetGroup
 
@@ -200,7 +201,9 @@ data UploadSpecificFile = UploadSpecificFile
   , specificFileRequired :: Bool
   , specificFileEmptyOk :: Bool
   , specificFileMaxSize :: Maybe Natural
-  } deriving (Show, Read, Eq, Ord, Generic)
+  }
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+  deriving anyclass (NFData)
 
 instance ToJSON UploadSpecificFile where
   toJSON UploadSpecificFile{..} = Aeson.object
@@ -229,7 +232,8 @@ data UploadMode = NoUpload
                 | UploadSpecific
                   { uploadSpecificFiles :: NonNull (Set UploadSpecificFile)
                   }
-  deriving (Show, Read, Eq, Ord, Generic)
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+  deriving anyclass (NFData)
 
 defaultExtensionRestriction :: Maybe (NonNull (Set Extension))
 defaultExtensionRestriction = fromNullable $ Set.fromList ["txt", "pdf"]
@@ -284,7 +288,8 @@ data SubmissionMode = SubmissionMode
   { submissionModeCorrector :: Bool
   , submissionModeUser :: Maybe UploadMode
   }
-  deriving (Show, Read, Eq, Ord, Generic)
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+  deriving anyclass (NFData)
 
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 2
@@ -319,12 +324,11 @@ data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rati
            , byProportion :: Rational  -- ^ workload proportion of all submission not assigned to tutorial leaders
            }
   deriving (Show, Read, Eq, Ord, Generic)
+  deriving anyclass (Hashable, NFData)
 
 deriveJSON defaultOptions ''Load
 derivePersistFieldJSON ''Load
 
-instance Hashable Load
-
 instance Semigroup Load where
   (Load byTut prop) <> (Load byTut' prop') = Load byTut'' (prop + prop')
     where
@@ -346,7 +350,7 @@ instance Monoid Load where
 
 data CorrectorState = CorrectorNormal | CorrectorMissing | CorrectorExcused
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
-  deriving anyclass (Universe, Finite, Hashable)
+  deriving anyclass (Universe, Finite, Hashable, NFData)
 
 deriveJSON defaultOptions
   { constructorTagModifier = fromJust . stripPrefix "Corrector"

src/Model/Types/Submission.hs

@@ -56,6 +56,7 @@ newtype Pseudonym = Pseudonym Word24
   deriving newtype ( Bounded, Enum, Integral, Num, Real, Ix
                    , PersistField, Random
                    )
+  deriving anyclass (NFData)
 
 instance PersistFieldSql Pseudonym where
   sqlType _ = sqlType $ Proxy @Word24

src/Model/Types/Workflow.hs

@@ -78,15 +78,16 @@ newtype WorkflowGraph fileid userid = WorkflowGraph
 deriving instance (Eq fileid, Eq userid, Typeable fileid, Typeable userid, Eq (FileField fileid)) => Eq (WorkflowGraph fileid userid)
 deriving instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileField fileid)) => Ord (WorkflowGraph fileid userid)
 deriving instance (Show fileid, Show userid, Show (FileField fileid)) => Show (WorkflowGraph fileid userid)
+deriving anyclass instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (WorkflowGraph fileid userid)
 
 newtype WorkflowGraphReference = WorkflowGraphReference (Digest SHA3_256)
   deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
   deriving newtype ( PersistField
                    , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
-                   , Hashable, NFData
                    , ByteArrayAccess
                    , Binary
                    )
+  deriving anyclass (Hashable, NFData)
 
 instance PersistFieldSql WorkflowGraphReference where
   sqlType _ = sqlType $ Proxy @(Digest SHA3_256)
@@ -96,6 +97,7 @@ instance PersistFieldSql WorkflowGraphReference where
 newtype WorkflowGraphNodeLabel = WorkflowGraphNodeLabel { unWorkflowGraphNodeLabel :: CI Text }
   deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
   deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, Binary)
+  deriving anyclass (NFData)
 
 instance PersistFieldSql WorkflowGraphNodeLabel where
   sqlType _ = sqlType $ Proxy @(CI Text)
@@ -112,24 +114,30 @@ data WorkflowGraphNode fileid userid = WGN
 deriving instance (Eq fileid, Eq userid, Typeable fileid, Typeable userid, Eq (FileField fileid)) => Eq (WorkflowGraphNode fileid userid)
 deriving instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileField fileid)) => Ord (WorkflowGraphNode fileid userid)
 deriving instance (Show fileid, Show userid, Show (FileField fileid)) => Show (WorkflowGraphNode fileid userid)
+deriving anyclass instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (WorkflowGraphNode fileid userid)
 
 data WorkflowNodeView userid = WorkflowNodeView
   { wnvViewers :: NonNull (Set (WorkflowRole userid))
   , wnvDisplayLabel :: I18nText
-  } deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data WorkflowNodeMessage userid = WorkflowNodeMessage 
   { wnmViewers     :: NonNull (Set (WorkflowRole userid))
   , wnmRestriction :: Maybe (PredDNF WorkflowGraphRestriction)
   , wnmStatus      :: MessageStatus
   , wnmContent     :: I18nHtml
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 -----  WORKFLOW GRAPH: EDGES  -----
 
 newtype WorkflowGraphEdgeLabel = WorkflowGraphEdgeLabel { unWorkflowGraphEdgeLabel :: CI Text }
   deriving stock (Eq, Ord, Read, Show, Data, Generic, Typeable)
   deriving newtype (IsString, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PathPiece, PersistField, Binary)
+  deriving anyclass (NFData)
 
 instance PersistFieldSql WorkflowGraphEdgeLabel where
   sqlType _ = sqlType $ Proxy @(CI Text)
@@ -139,6 +147,7 @@ data WorkflowGraphRestriction
   | WorkflowGraphRestrictionPreviousNode { wgrPreviousNode :: WorkflowGraphNodeLabel }
   | WorkflowGraphRestrictionInitial
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data WorkflowGraphEdge fileid userid
   = WorkflowGraphEdgeManual
@@ -165,13 +174,16 @@ data WorkflowGraphEdge fileid userid
 deriving instance (Eq fileid, Eq userid, Typeable fileid, Typeable userid, Eq (FileField fileid)) => Eq (WorkflowGraphEdge fileid userid)
 deriving instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileField fileid)) => Ord (WorkflowGraphEdge fileid userid)
 deriving instance (Show fileid, Show userid, Show (FileField fileid)) => Show (WorkflowGraphEdge fileid userid)
+deriving anyclass instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (WorkflowGraphEdge fileid userid)
 
 data WorkflowEdgeMessage userid = WorkflowEdgeMessage 
   { wemViewers     :: NonNull (Set (WorkflowRole userid))
   , wemRestriction :: Maybe (PredDNF WorkflowGraphRestriction)
   , wemStatus      :: MessageStatus
   , wemContent     :: I18nHtml
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 -- | A wrapped `Scientific`
 --
@@ -180,6 +192,7 @@ newtype WorkflowGraphEdgeFormOrder = WorkflowGraphEdgeFormOrder { unWorkflowGrap
   deriving (Read, Show, Generic, Typeable)
   deriving (Eq, Ord) via (NTop (Maybe Scientific))
   deriving (Semigroup, Monoid) via (Maybe (Min Scientific))
+  deriving anyclass (NFData)
 
 newtype WorkflowGraphEdgeForm fileid userid
   = WorkflowGraphEdgeForm
@@ -191,11 +204,13 @@ newtype WorkflowGraphEdgeForm fileid userid
       -- - optional fields are always considered to be filled
       -- 
       -- since fields can reference other labels this allows arbitrary requirements to be encoded.
-    } deriving (Generic, Typeable)
+    }
+  deriving (Generic, Typeable)
 
 deriving instance (Eq fileid, Eq userid, Typeable fileid, Typeable userid, Eq (FileField fileid)) => Eq (WorkflowGraphEdgeForm fileid userid)
 deriving instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileField fileid)) => Ord (WorkflowGraphEdgeForm fileid userid)
 deriving instance (Show fileid, Show userid, Show (FileField fileid)) => Show (WorkflowGraphEdgeForm fileid userid)
+deriving anyclass instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (WorkflowGraphEdgeForm fileid userid)
 
 -----  WORKFLOW GRAPH: ROLES / ACTORS  -----
 
@@ -213,16 +228,21 @@ data WorkflowRole userid
 data WorkflowPayloadView userid = WorkflowPayloadView
   { wpvViewers :: NonNull (Set (WorkflowRole userid))
   , wpvDisplayLabel :: I18nText
-  } deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data WorkflowPayloadSpec fileid userid = forall payload. Typeable payload => WorkflowPayloadSpec (WorkflowPayloadField fileid userid payload)
   deriving (Typeable)
 
 deriving instance (Show fileid, Show userid, Show (FileField fileid)) => Show (WorkflowPayloadSpec fileid userid)
+instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (WorkflowPayloadSpec fileid userid) where
+  rnf (WorkflowPayloadSpec pField) = rnf pField
 
 data WorkflowPayloadFieldReference
   deriving (Typeable)
 
+-- Don't forget to update the NFData instance for every change!
 data WorkflowPayloadField fileid userid (payload :: Type) where
   WorkflowPayloadFieldText      :: { wpftLabel       :: I18nText
                                    , wpftPlaceholder :: Maybe I18nText
@@ -325,6 +345,18 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileFie
           (WorkflowPayloadFieldReference{}, _) -> LT
           (WorkflowPayloadFieldMultiple{}, _) -> GT
 
+instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (WorkflowPayloadField fileid userid payload) where
+  rnf = \case
+    WorkflowPayloadFieldText{..} -> wpftLabel `deepseq` wpftPlaceholder `deepseq` wpftTooltip `deepseq` wpftDefault `deepseq` wpftLarge `deepseq` wpftOptional `deepseq` ()
+    WorkflowPayloadFieldNumber{..} -> wpfnLabel `deepseq` wpfnPlaceholder `deepseq` wpfnTooltip `deepseq` wpfnDefault `deepseq` wpfnMin `deepseq` wpfnMax `deepseq` wpfnStep `deepseq` wpfnOptional `deepseq` ()
+    WorkflowPayloadFieldBool{..} -> wpfbLabel `deepseq` wpfbTooltip `deepseq` wpfbDefault `deepseq` wpfbOptional `deepseq` ()
+    WorkflowPayloadFieldDay{..} -> wpfdLabel `deepseq` wpfdTooltip `deepseq` wpfdDefault `deepseq` wpfdOptional `deepseq` ()
+    WorkflowPayloadFieldFile{..} -> wpffLabel `deepseq` wpffTooltip `deepseq` wpffConfig `deepseq` wpffOptional `deepseq` ()
+    WorkflowPayloadFieldUser{..} -> wpfuLabel `deepseq` wpfuTooltip `deepseq` wpfuDefault `deepseq` wpfuOptional `deepseq` ()
+    WorkflowPayloadFieldCaptureUser -> ()
+    WorkflowPayloadFieldReference{..} -> wpfrTarget `deepseq` ()
+    WorkflowPayloadFieldMultiple{..} -> wpfmLabel `deepseq` wpfmTooltip `deepseq` wpfmDefault `deepseq` wpfmSub `deepseq` wpfmMin `deepseq` wpfmRange `deepseq` ()
+
 _WorkflowPayloadSpec :: forall payload fileid userid.
                         ( Typeable payload, Typeable fileid, Typeable userid )
                      => Prism' (WorkflowPayloadSpec fileid userid) (WorkflowPayloadField fileid userid payload)
@@ -332,7 +364,7 @@ _WorkflowPayloadSpec = prism' WorkflowPayloadSpec $ \(WorkflowPayloadSpec pF) ->
   
 data WorkflowPayloadField' = WPFText' | WPFNumber' | WPFBool' | WPFDay' | WPFFile' | WPFUser' | WPFCaptureUser' | WPFReference' | WPFMultiple'
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Data, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 
 -----  WORKFLOW INSTANCE  -----
@@ -349,7 +381,7 @@ data WorkflowScope termid schoolid courseid
 data WorkflowScope'
   = WSGlobal' | WSTerm' | WSSchool' | WSTermSchool' | WSCourse'
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 classifyWorkflowScope :: WorkflowScope termid schoolid courseid -> WorkflowScope'
 classifyWorkflowScope = \case
@@ -372,6 +404,7 @@ instance PersistFieldSql WorkflowPayloadLabel where
 newtype WorkflowStateIndex = WorkflowStateIndex { unWorkflowStateIndex :: Word64 }
   deriving stock (Eq, Ord, Show, Read, Data, Generic, Typeable)
   deriving newtype (Num, Real, Integral, Enum, Bounded, ToJSON, FromJSON, PathPiece, Binary)
+  deriving anyclass (NFData)
 
 type WorkflowState fileid userid = NonNull (Seq (WorkflowAction fileid userid))
 
@@ -395,13 +428,16 @@ data WorkflowAction fileid userid = WorkflowAction
   , wpTime    :: UTCTime
   }
   deriving (Eq, Ord, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 data WorkflowActionInfo fileid userid = WorkflowActionInfo
   { waiIx      :: WorkflowStateIndex
   , waiFrom    :: Maybe WorkflowGraphNodeLabel
   , waiHistory :: [WorkflowAction fileid userid]
   , waiAction  :: WorkflowAction fileid userid
-  } deriving (Eq, Ord, Show, Generic, Typeable)
+  }
+  deriving (Eq, Ord, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 workflowActionInfos :: WorkflowState fileid userid -> [WorkflowActionInfo fileid userid]
 workflowActionInfos wState
@@ -416,6 +452,9 @@ workflowActionInfos wState
 data WorkflowFieldPayloadW fileid userid = forall payload. IsWorkflowFieldPayload' fileid userid payload => WorkflowFieldPayloadW (WorkflowFieldPayload fileid userid payload)
   deriving (Typeable)
 
+instance (NFData fileid, NFData userid) => NFData (WorkflowFieldPayloadW fileid userid) where
+  rnf (WorkflowFieldPayloadW fPayload) = rnf fPayload
+
 instance (Eq fileid, Eq userid, Typeable fileid, Typeable userid) => Eq (WorkflowFieldPayloadW fileid userid) where
   (WorkflowFieldPayloadW a) == (WorkflowFieldPayloadW b)
     = case typeOf a `eqTypeRep` typeOf b of
@@ -476,6 +515,7 @@ workflowPayloadSort ordFiles ordUsers (WorkflowFieldPayloadW a) (WorkflowFieldPa
 instance (Show fileid, Show userid) => Show (WorkflowFieldPayloadW fileid userid) where
   show (WorkflowFieldPayloadW payload) = show payload
 
+-- Don't forget to update the NFData instance for every change!
 data WorkflowFieldPayload fileid userid (payload :: Type) where
   WFPText     :: Text       -> WorkflowFieldPayload fileid userid Text
   WFPNumber   :: Scientific -> WorkflowFieldPayload fileid userid Scientific
@@ -489,6 +529,15 @@ deriving instance (Show fileid, Show userid) => Show (WorkflowFieldPayload filei
 deriving instance (Typeable fileid, Typeable userid, Eq fileid, Eq userid) => Eq (WorkflowFieldPayload fileid userid payload)
 deriving instance (Typeable fileid, Typeable userid, Ord fileid, Ord userid) => Ord (WorkflowFieldPayload fileid userid payload)
 
+instance (NFData fileid, NFData userid) => NFData (WorkflowFieldPayload fileid userid payload) where
+  rnf = \case
+    WFPText t   -> rnf t
+    WFPNumber n -> rnf n
+    WFPBool b   -> rnf b
+    WFPDay d    -> rnf d
+    WFPFile f   -> rnf f
+    WFPUser u   -> rnf u
+
 _WorkflowFieldPayloadW :: forall payload fileid userid.
                           ( IsWorkflowFieldPayload' fileid userid payload, Typeable fileid, Typeable userid )
                        => Prism' (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayload fileid userid payload)
@@ -496,7 +545,7 @@ _WorkflowFieldPayloadW = prism' WorkflowFieldPayloadW $ \(WorkflowFieldPayloadW
 
 data WorkflowFieldPayload' = WFPText' | WFPNumber' | WFPBool' | WFPDay' | WFPFile' | WFPUser'
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Data, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 type IsWorkflowFieldPayload' fileid userid payload = IsWorkflowFieldPayload fileid fileid userid userid payload payload
 

src/Network/Mail/Mime/Instances.hs

@@ -31,9 +31,7 @@ import Control.Lens
 deriving instance Read Address
 deriving instance Ord Address
 deriving instance Generic Address
-
+deriving anyclass instance Hashable Address
-instance Hashable Address
-instance NFData Address
 
 deriveToJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1
@@ -58,6 +56,7 @@ instance Csv.DefaultOrdered Address where
   
 newtype MailHeaders = MailHeaders Headers
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (NFData)
 
 instance ToJSON MailHeaders where
   toJSON (MailHeaders hs) = toJSON $ over (traverse . _1) decodeUtf8 hs
@@ -76,6 +75,13 @@ instance Binary PartContent
 instance Binary Part
 instance Binary Address
 instance Binary Mail
+
+deriving anyclass instance NFData Encoding
+deriving anyclass instance NFData Disposition
+deriving anyclass instance NFData PartContent
+deriving anyclass instance NFData Part
+deriving anyclass instance NFData Address
+deriving anyclass instance NFData Mail
   
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece

src/Settings/Cluster.hs

@@ -7,7 +7,6 @@ module Settings.Cluster
   ) where
 
 import ClassyPrelude.Yesod
-import Web.HttpApiData
 
 import Data.Kind (Type)
 
@@ -51,21 +50,15 @@ data ClusterSettingsKey
   | ClusterMemcachedKey
   | ClusterVerpSecret
   | ClusterAuthKey
-  deriving (Eq, Ord, Enum, Bounded, Show, Read)
+  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
-
+  deriving anyclass (Universe, Finite, NFData)
-instance Universe ClusterSettingsKey
-instance Finite ClusterSettingsKey
 
 nullaryPathPiece ''ClusterSettingsKey $ camelToPathPiece' 1
 pathPieceJSON ''ClusterSettingsKey
 pathPieceJSONKey ''ClusterSettingsKey
+pathPieceHttpApiData ''ClusterSettingsKey
 derivePersistFieldPathPiece ''ClusterSettingsKey
 
-instance ToHttpApiData ClusterSettingsKey where
-  toUrlPiece = toPathPiece
-instance FromHttpApiData ClusterSettingsKey where
-  parseUrlPiece = maybe (Left "Could not parse url piece") Right . fromPathPiece
-
 
 class (ToJSON (ClusterSettingValue key), FromJSON (ClusterSettingValue key)) => ClusterSetting (key :: ClusterSettingsKey) where
   type ClusterSettingValue key :: Type

src/Utils/ARC.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
 module Utils.ARC
   ( ARCTick
   , ARC, initARC
@@ -133,17 +135,18 @@ arcAlterF :: forall f k w v.
              ( Ord k, Hashable k
              , Functor f
              , Integral w
+             , NFData k, NFData w, NFData v
              )
           => k
           -> (Maybe (v, w) -> f (Maybe (v, w)))
           -> ARC k w v
           -> ARCTick -> f (ARC k w v, ARCTick)
 -- | Unchecked precondition: item weights are always less than `arcMaximumWeight`
-arcAlterF unhashedK@(hashed -> k) f oldARC@ARC{..} now
+arcAlterF !(force -> unhashedK@(hashed -> k)) f oldARC@ARC{..} now
   | later <= initialARCTick = uncurry (arcAlterF unhashedK f) $ initARC arcMaximumGhost arcMaximumWeight
   | otherwise = (, later) <$> if
     | Just (_p, x@(_, w), arcFrequent') <- HashPSQ.deleteView k arcFrequent
-      -> f (Just x) <&> \(fromMaybe x -> x'@(_, w'))
+      -> f (Just x) <&> \(fromMaybe x -> !(force -> x'@(_, w')))
            -> let (arcFrequent'', arcFrequentWeight'', arcGhostFrequent') = evictToSize (arcMaximumWeight |- arcTargetRecent |- w') arcFrequent' (arcFrequentWeight - w) arcGhostFrequent
                in oldARC
                     { arcFrequent = HashPSQ.insert k now x' arcFrequent''
@@ -151,7 +154,7 @@ arcAlterF unhashedK@(hashed -> k) f oldARC@ARC{..} now
                     , arcGhostFrequent = arcGhostFrequent'
                     }
     | Just (_p, x@(_, w), arcRecent') <- HashPSQ.deleteView k arcRecent
-      -> f (Just x) <&> \(fromMaybe x -> x'@(_, w'))
+      -> f (Just x) <&> \(fromMaybe x -> !(force -> x'@(_, w')))
            -> let (arcFrequent', arcFrequentWeight', arcGhostFrequent') = evictToSize (arcMaximumWeight |- arcTargetRecent |- w') arcFrequent arcFrequentWeight arcGhostFrequent
                in oldARC
                     { arcRecent = arcRecent'
@@ -165,7 +168,7 @@ arcAlterF unhashedK@(hashed -> k) f oldARC@ARC{..} now
            Nothing -> oldARC
              { arcGhostRecent = HashPSQ.insert k now () arcGhostRecent'
              }
-           Just x@(_, w)
+           Just !(force -> x@(_, w))
              -> let arcTargetRecent' = min arcMaximumWeight $ arcTargetRecent + max avgWeight (round $ toRational (HashPSQ.size arcGhostFrequent) / toRational (HashPSQ.size arcGhostRecent) * toRational avgWeight)
                     (arcFrequent', arcFrequentWeight', arcGhostFrequent') = evictToSize (arcMaximumWeight |- arcTargetRecent' |- w) arcFrequent arcFrequentWeight arcGhostFrequent
                     (arcRecent', arcRecentWeight', arcGhostRecent'') = evictToSize (max arcTargetRecent' $ arcMaximumWeight |- arcFrequentWeight' |- w) arcRecent arcRecentWeight arcGhostRecent'
@@ -183,7 +186,7 @@ arcAlterF unhashedK@(hashed -> k) f oldARC@ARC{..} now
            Nothing -> oldARC
              { arcGhostFrequent = HashPSQ.insert k now () arcGhostFrequent'
              }
-           Just x@(_, w)
+           Just !(force -> x@(_, w))
              -> let arcTargetRecent' = arcTargetRecent |- max avgWeight (round $ toRational (HashPSQ.size arcGhostRecent) / toRational (HashPSQ.size arcGhostFrequent) * toRational avgWeight)
                     (arcFrequent', arcFrequentWeight', arcGhostFrequent'') = evictToSize (arcMaximumWeight |- arcTargetRecent' |- w) arcFrequent arcFrequentWeight arcGhostFrequent'
                     (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent' $ arcMaximumWeight |- arcFrequentWeight' |- w) arcRecent arcRecentWeight arcGhostRecent
@@ -200,7 +203,7 @@ arcAlterF unhashedK@(hashed -> k) f oldARC@ARC{..} now
         Nothing -> oldARC
           { arcGhostRecent = HashPSQ.insert k now () $ evictGhostToCount arcGhostRecent
           }
-        Just x@(_, w)
+        Just !(force -> x@(_, w))
           -> let (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent (arcMaximumWeight |- arcFrequentWeight) |- w) arcRecent arcRecentWeight arcGhostRecent
               in oldARC
                    { arcRecent = HashPSQ.insert k now x arcRecent'
@@ -228,6 +231,7 @@ arcAlterF unhashedK@(hashed -> k) f oldARC@ARC{..} now
 lookupARC :: forall k w v.
              ( Ord k, Hashable k
              , Integral w
+             , NFData k, NFData w, NFData v
              )
           => k
           -> (ARC k w v, ARCTick)
@@ -237,6 +241,7 @@ lookupARC k = getConst . uncurry (arcAlterF k Const)
 insertARC :: forall k w v.
              ( Ord k, Hashable k
              , Integral w
+             , NFData k, NFData w, NFData v
              )
           => k
           -> Maybe (v, w)
@@ -272,7 +277,7 @@ cachedARC' :: forall k w v m.
 cachedARC' (ARCHandle arcVar) k f = do
   oldVal <- lookupARC k <$> readIORef arcVar
   newVal <- f oldVal
-  modifyIORef' arcVar $ force . uncurry (insertARC k newVal)
+  modifyIORef' arcVar $ uncurry (insertARC k newVal)
   -- Using `modifyIORef'` instead of `atomicModifyIORef'` might very
   -- well drop newer values computed during the update.
   --
@@ -304,6 +309,7 @@ lookupARCHandle :: forall k w v m.
                    ( MonadIO m
                    , Ord k, Hashable k
                    , Integral w
+                   , NFData k, NFData w, NFData v
                    )
                 => ARCHandle k w v
                 -> k

src/Utils/DateTime.hs

@@ -100,6 +100,7 @@ instance HasLocalTime TimeOfDay where
 newtype DateTimeFormat = DateTimeFormat { unDateTimeFormat :: String }
   deriving (Eq, Ord, Read, Show, Data, Generic, Typeable)
   deriving newtype (ToJSON, FromJSON, PersistField, IsString)
+  deriving anyclass (NFData)
 
 instance PersistFieldSql DateTimeFormat where
   sqlType _ = sqlType $ Proxy @String
@@ -108,10 +109,7 @@ instance Hashable DateTimeFormat
 
 data SelDateTimeFormat = SelFormatDate | SelFormatTime | SelFormatDateTime
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic, Typeable)
-
+  deriving anyclass (Universe, Finite, Hashable, NFData)
-instance Universe SelDateTimeFormat
-instance Finite SelDateTimeFormat
-instance Hashable SelDateTimeFormat
 
 nullaryPathPiece ''SelDateTimeFormat $ camelToPathPiece' 2
 pathPieceJSON ''SelDateTimeFormat

src/Utils/Icon.hs

@@ -98,6 +98,7 @@ data Icon
   | IconVideo
   | IconSubmissionUserDuplicate
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
+  deriving anyclass (Universe, Finite, NFData)
 
 iconText :: Icon -> Text
 iconText = \case
@@ -175,8 +176,6 @@ iconText = \case
     IconVideo                   -> "video"
     IconSubmissionUserDuplicate -> "copy"
 
-instance Universe Icon
-instance Finite   Icon
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon
 

src/Utils/Message.hs

@@ -31,7 +31,7 @@ import Text.HTML.SanitizeXSS (sanitizeBalance)
 
 data MessageStatus = Error | Warning | Info | Success
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Lift, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
+  deriving anyclass (Universe, Finite, NFData)
 
 instance Default MessageStatus where
   def = Info

src/Utils/TH.hs

@@ -222,6 +222,7 @@ mkI18nWidgetEnum (splitCamel -> namebase) basename = do
         , derivClause (Just AnyclassStrategy)
             [ conT ''Universe
             , conT ''Finite
+            , conT ''NFData
             ]
         ]
     , instanceD (cxt []) (conT ''PathPiece `appT` conT dataName)