Split models
This commit is contained in:
Gregor Kleen
parent
45bfe771ad
commit
2eb09d0de7
262
models
262
models
@ -1,262 +0,0 @@
|
|||||||
User json
|
|
||||||
ident (CI Text)
|
|
||||||
authentication AuthenticationMode
|
|
||||||
matrikelnummer Text Maybe
|
|
||||||
email (CI Text)
|
|
||||||
displayName Text
|
|
||||||
surname Text -- always use: nameWidget displayName surname
|
|
||||||
maxFavourites Int default=12
|
|
||||||
theme Theme default='Default'
|
|
||||||
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
|
|
||||||
dateFormat DateTimeFormat "default='%d.%m.%Y'"
|
|
||||||
timeFormat DateTimeFormat "default='%R'"
|
|
||||||
downloadFiles Bool default=false
|
|
||||||
mailLanguages MailLanguages default='[]'
|
|
||||||
notificationSettings NotificationSettings
|
|
||||||
UniqueAuthentication ident
|
|
||||||
UniqueEmail email
|
|
||||||
deriving Show Eq
|
|
||||||
UserAdmin
|
|
||||||
user UserId
|
|
||||||
school SchoolId
|
|
||||||
UniqueUserAdmin user school
|
|
||||||
UserLecturer
|
|
||||||
user UserId
|
|
||||||
school SchoolId
|
|
||||||
UniqueSchoolLecturer user school
|
|
||||||
StudyFeatures
|
|
||||||
user UserId
|
|
||||||
degree StudyDegreeId
|
|
||||||
field StudyTermsId
|
|
||||||
type StudyFieldType
|
|
||||||
semester Int
|
|
||||||
-- UniqueUserSubject user degree field -- There exists a counterexample
|
|
||||||
StudyDegree
|
|
||||||
key Int
|
|
||||||
shorthand Text Maybe
|
|
||||||
name Text Maybe
|
|
||||||
Primary key
|
|
||||||
StudyTerms
|
|
||||||
key Int
|
|
||||||
shorthand Text Maybe
|
|
||||||
name Text Maybe
|
|
||||||
Primary key
|
|
||||||
Term json
|
|
||||||
name TermIdentifier -- unTermKey :: TermId -> TermIdentifier
|
|
||||||
start Day -- TermKey :: TermIdentifier -> TermId
|
|
||||||
end Day
|
|
||||||
holidays [Day]
|
|
||||||
lectureStart Day
|
|
||||||
lectureEnd Day
|
|
||||||
active Bool
|
|
||||||
Primary name -- newtype Key Term = TermKey { unTermKey :: TermIdentifier }
|
|
||||||
deriving Show -- type TermId = Key Term
|
|
||||||
School json
|
|
||||||
name (CI Text)
|
|
||||||
shorthand (CI Text)
|
|
||||||
UniqueSchool name
|
|
||||||
UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
|
|
||||||
Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }
|
|
||||||
deriving Eq
|
|
||||||
DegreeCourse json
|
|
||||||
course CourseId
|
|
||||||
degree StudyDegreeId
|
|
||||||
terms StudyTermsId
|
|
||||||
UniqueDegreeCourse course degree terms
|
|
||||||
Course
|
|
||||||
name (CI Text)
|
|
||||||
description Html Maybe
|
|
||||||
linkExternal Text Maybe
|
|
||||||
shorthand (CI Text)
|
|
||||||
term TermId
|
|
||||||
school SchoolId
|
|
||||||
capacity Int64 Maybe
|
|
||||||
-- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
|
|
||||||
registerFrom UTCTime Maybe
|
|
||||||
registerTo UTCTime Maybe
|
|
||||||
deregisterUntil UTCTime Maybe
|
|
||||||
registerSecret Text Maybe -- Falls ein Passwort erforderlich ist
|
|
||||||
materialFree Bool
|
|
||||||
TermSchoolCourseShort term school shorthand
|
|
||||||
TermSchoolCourseName term school name
|
|
||||||
CourseEdit
|
|
||||||
user UserId
|
|
||||||
time UTCTime
|
|
||||||
course CourseId
|
|
||||||
CourseFavourite
|
|
||||||
user UserId
|
|
||||||
time UTCTime
|
|
||||||
course CourseId
|
|
||||||
UniqueCourseFavourite user course
|
|
||||||
deriving Show
|
|
||||||
Lecturer
|
|
||||||
user UserId
|
|
||||||
course CourseId
|
|
||||||
UniqueLecturer user course
|
|
||||||
CourseParticipant
|
|
||||||
course CourseId
|
|
||||||
user UserId
|
|
||||||
registration UTCTime
|
|
||||||
UniqueParticipant user course
|
|
||||||
Sheet
|
|
||||||
course CourseId
|
|
||||||
name (CI Text)
|
|
||||||
description Html Maybe
|
|
||||||
type SheetType
|
|
||||||
grouping SheetGroup
|
|
||||||
markingText Html Maybe
|
|
||||||
visibleFrom UTCTime Maybe
|
|
||||||
activeFrom UTCTime
|
|
||||||
activeTo UTCTime
|
|
||||||
hintFrom UTCTime Maybe
|
|
||||||
solutionFrom UTCTime Maybe
|
|
||||||
uploadMode UploadMode
|
|
||||||
submissionMode SheetSubmissionMode default='UserSubmissions'
|
|
||||||
CourseSheet course name
|
|
||||||
SheetEdit
|
|
||||||
user UserId
|
|
||||||
time UTCTime
|
|
||||||
sheet SheetId
|
|
||||||
SheetPseudonym
|
|
||||||
sheet SheetId
|
|
||||||
pseudonym Pseudonym
|
|
||||||
user UserId
|
|
||||||
UniqueSheetPseudonym sheet pseudonym
|
|
||||||
UniqueSheetPseudonymUser sheet user
|
|
||||||
SheetCorrector
|
|
||||||
user UserId
|
|
||||||
sheet SheetId
|
|
||||||
load Load
|
|
||||||
state CorrectorState default='CorrectorNormal'
|
|
||||||
UniqueSheetCorrector user sheet
|
|
||||||
deriving Show Eq Ord
|
|
||||||
SheetFile
|
|
||||||
sheet SheetId
|
|
||||||
file FileId
|
|
||||||
type SheetFileType
|
|
||||||
UniqueSheetFile file sheet type
|
|
||||||
File
|
|
||||||
title FilePath
|
|
||||||
content ByteString Maybe -- Nothing iff this is a directory
|
|
||||||
modified UTCTime
|
|
||||||
deriving Show Eq Generic
|
|
||||||
Submission
|
|
||||||
sheet SheetId
|
|
||||||
ratingPoints Points Maybe -- "Just" does not mean done
|
|
||||||
ratingComment Text Maybe -- "Just" does not mean done
|
|
||||||
ratingBy UserId Maybe -- assigned corrector
|
|
||||||
ratingAssigned UTCTime Maybe -- time assigned corrector
|
|
||||||
ratingTime UTCTime Maybe -- "Just" here indicates done!
|
|
||||||
deriving Show
|
|
||||||
SubmissionEdit
|
|
||||||
user UserId
|
|
||||||
time UTCTime
|
|
||||||
submission SubmissionId
|
|
||||||
SubmissionFile
|
|
||||||
submission SubmissionId
|
|
||||||
file FileId
|
|
||||||
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 file submission isUpdate
|
|
||||||
deriving Show
|
|
||||||
SubmissionUser -- Actual submission participant
|
|
||||||
user UserId
|
|
||||||
submission SubmissionId
|
|
||||||
UniqueSubmissionUser user submission
|
|
||||||
SubmissionGroup
|
|
||||||
course CourseId
|
|
||||||
name Text Maybe
|
|
||||||
SubmissionGroupEdit
|
|
||||||
user UserId
|
|
||||||
time UTCTime
|
|
||||||
submissionGroup SubmissionGroupId
|
|
||||||
SubmissionGroupUser -- Registered submission groups, independent of actual SubmissionUser
|
|
||||||
submissionGroup SubmissionGroupId
|
|
||||||
user UserId
|
|
||||||
UniqueSubmissionGroupUser submissionGroup user
|
|
||||||
Tutorial json
|
|
||||||
name Text
|
|
||||||
tutor UserId
|
|
||||||
course CourseId
|
|
||||||
TutorialUser
|
|
||||||
user UserId
|
|
||||||
tutorial TutorialId
|
|
||||||
UniqueTutorialUser user tutorial
|
|
||||||
Booking
|
|
||||||
term TermId
|
|
||||||
begin UTCTime
|
|
||||||
end UTCTime
|
|
||||||
weekly Bool
|
|
||||||
exceptions [Day] -- only if weekly, begin in exception
|
|
||||||
bookedFor RoomForId
|
|
||||||
room RoomId
|
|
||||||
BookingEdit
|
|
||||||
user UserId
|
|
||||||
time UTCTime
|
|
||||||
boooking BookingId
|
|
||||||
Room
|
|
||||||
name Text
|
|
||||||
capacity Int Maybe
|
|
||||||
building Text Maybe
|
|
||||||
-- BookingRoom
|
|
||||||
-- subject RoomForId
|
|
||||||
-- room RoomId
|
|
||||||
-- booking BookingId
|
|
||||||
-- UniqueRoomCourse subject room booking
|
|
||||||
+RoomFor
|
|
||||||
course CourseId
|
|
||||||
tutorial TutorialId
|
|
||||||
exam ExamId
|
|
||||||
-- data RoomFor = RoomForCourseSum CourseId | RoomForTutorialSum TutorialId ...
|
|
||||||
-- EXAMS ARE TODO:
|
|
||||||
Exam
|
|
||||||
course CourseId
|
|
||||||
name Text
|
|
||||||
description Text
|
|
||||||
begin UTCTime
|
|
||||||
end UTCTime
|
|
||||||
registrationBegin UTCTime
|
|
||||||
registrationEnd UTCTime
|
|
||||||
deregistrationEnd UTCTime
|
|
||||||
ratingVisible Bool
|
|
||||||
statisticsVisible Bool
|
|
||||||
--ExamEdit
|
|
||||||
-- user UserId
|
|
||||||
-- time UTCTime
|
|
||||||
-- exam ExamId
|
|
||||||
--ExamUser
|
|
||||||
-- user UserId
|
|
||||||
-- examId ExamId
|
|
||||||
-- -- CONTINUE HERE: Include rating in this table or separately?
|
|
||||||
-- UniqueExamUser user examId
|
|
||||||
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
|
|
||||||
QueuedJob
|
|
||||||
content Value
|
|
||||||
creationInstance InstanceId
|
|
||||||
creationTime UTCTime
|
|
||||||
lockInstance InstanceId Maybe
|
|
||||||
lockTime UTCTime Maybe
|
|
||||||
deriving Eq Read Show Generic Typeable
|
|
||||||
CronLastExec
|
|
||||||
job Value
|
|
||||||
time UTCTime
|
|
||||||
instance InstanceId
|
|
||||||
UniqueCronLastExec job
|
|
||||||
SystemMessage
|
|
||||||
from UTCTime Maybe
|
|
||||||
to UTCTime Maybe
|
|
||||||
authenticatedOnly Bool
|
|
||||||
severity MessageClass
|
|
||||||
defaultLanguage Lang
|
|
||||||
content Html
|
|
||||||
summary Html Maybe
|
|
||||||
SystemMessageTranslation
|
|
||||||
message SystemMessageId
|
|
||||||
language Lang
|
|
||||||
content Html
|
|
||||||
summary Html Maybe
|
|
||||||
UniqueSystemMessageTranslation message language
|
|
||||||
ClusterConfig
|
|
||||||
setting ClusterSettingsKey
|
|
||||||
value Value
|
|
||||||
Primary setting
|
|
||||||
4
models/config
Normal file
4
models/config
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
ClusterConfig
|
||||||
|
setting ClusterSettingsKey
|
||||||
|
value Value
|
||||||
|
Primary setting
|
||||||
40
models/courses
Normal file
40
models/courses
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
DegreeCourse json
|
||||||
|
course CourseId
|
||||||
|
degree StudyDegreeId
|
||||||
|
terms StudyTermsId
|
||||||
|
UniqueDegreeCourse course degree terms
|
||||||
|
Course
|
||||||
|
name (CI Text)
|
||||||
|
description Html Maybe
|
||||||
|
linkExternal Text Maybe
|
||||||
|
shorthand (CI Text)
|
||||||
|
term TermId
|
||||||
|
school SchoolId
|
||||||
|
capacity Int64 Maybe
|
||||||
|
-- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
|
||||||
|
registerFrom UTCTime Maybe
|
||||||
|
registerTo UTCTime Maybe
|
||||||
|
deregisterUntil UTCTime Maybe
|
||||||
|
registerSecret Text Maybe -- Falls ein Passwort erforderlich ist
|
||||||
|
materialFree Bool
|
||||||
|
TermSchoolCourseShort term school shorthand
|
||||||
|
TermSchoolCourseName term school name
|
||||||
|
CourseEdit
|
||||||
|
user UserId
|
||||||
|
time UTCTime
|
||||||
|
course CourseId
|
||||||
|
CourseFavourite
|
||||||
|
user UserId
|
||||||
|
time UTCTime
|
||||||
|
course CourseId
|
||||||
|
UniqueCourseFavourite user course
|
||||||
|
deriving Show
|
||||||
|
Lecturer
|
||||||
|
user UserId
|
||||||
|
course CourseId
|
||||||
|
UniqueLecturer user course
|
||||||
|
CourseParticipant
|
||||||
|
course CourseId
|
||||||
|
user UserId
|
||||||
|
registration UTCTime
|
||||||
|
UniqueParticipant user course
|
||||||
22
models/exams
Normal file
22
models/exams
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
-- EXAMS ARE TODO:
|
||||||
|
Exam
|
||||||
|
course CourseId
|
||||||
|
name Text
|
||||||
|
description Text
|
||||||
|
begin UTCTime
|
||||||
|
end UTCTime
|
||||||
|
registrationBegin UTCTime
|
||||||
|
registrationEnd UTCTime
|
||||||
|
deregistrationEnd UTCTime
|
||||||
|
ratingVisible Bool
|
||||||
|
statisticsVisible Bool
|
||||||
|
--ExamEdit
|
||||||
|
-- user UserId
|
||||||
|
-- time UTCTime
|
||||||
|
-- exam ExamId
|
||||||
|
--ExamUser
|
||||||
|
-- user UserId
|
||||||
|
-- examId ExamId
|
||||||
|
-- -- CONTINUE HERE: Include rating in this table or separately?
|
||||||
|
-- UniqueExamUser user examId
|
||||||
|
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
|
||||||
5
models/files
Normal file
5
models/files
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
File
|
||||||
|
title FilePath
|
||||||
|
content ByteString Maybe -- Nothing iff this is a directory
|
||||||
|
modified UTCTime
|
||||||
|
deriving Show Eq Generic
|
||||||
12
models/jobs
Normal file
12
models/jobs
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
QueuedJob
|
||||||
|
content Value
|
||||||
|
creationInstance InstanceId
|
||||||
|
creationTime UTCTime
|
||||||
|
lockInstance InstanceId Maybe
|
||||||
|
lockTime UTCTime Maybe
|
||||||
|
deriving Eq Read Show Generic Typeable
|
||||||
|
CronLastExec
|
||||||
|
job Value
|
||||||
|
time UTCTime
|
||||||
|
instance InstanceId
|
||||||
|
UniqueCronLastExec job
|
||||||
26
models/rooms
Normal file
26
models/rooms
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
Booking
|
||||||
|
term TermId
|
||||||
|
begin UTCTime
|
||||||
|
end UTCTime
|
||||||
|
weekly Bool
|
||||||
|
exceptions [Day] -- only if weekly, begin in exception
|
||||||
|
bookedFor RoomForId
|
||||||
|
room RoomId
|
||||||
|
BookingEdit
|
||||||
|
user UserId
|
||||||
|
time UTCTime
|
||||||
|
boooking BookingId
|
||||||
|
Room
|
||||||
|
name Text
|
||||||
|
capacity Int Maybe
|
||||||
|
building Text Maybe
|
||||||
|
-- BookingRoom
|
||||||
|
-- subject RoomForId
|
||||||
|
-- room RoomId
|
||||||
|
-- booking BookingId
|
||||||
|
-- UniqueRoomCourse subject room booking
|
||||||
|
+RoomFor
|
||||||
|
course CourseId
|
||||||
|
tutorial TutorialId
|
||||||
|
exam ExamId
|
||||||
|
-- data RoomFor = RoomForCourseSum CourseId | RoomForTutorialSum TutorialId ...
|
||||||
7
models/schools
Normal file
7
models/schools
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
School json
|
||||||
|
name (CI Text)
|
||||||
|
shorthand (CI Text)
|
||||||
|
UniqueSchool name
|
||||||
|
UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
|
||||||
|
Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }
|
||||||
|
deriving Eq
|
||||||
37
models/sheets
Normal file
37
models/sheets
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
Sheet
|
||||||
|
course CourseId
|
||||||
|
name (CI Text)
|
||||||
|
description Html Maybe
|
||||||
|
type SheetType
|
||||||
|
grouping SheetGroup
|
||||||
|
markingText Html Maybe
|
||||||
|
visibleFrom UTCTime Maybe
|
||||||
|
activeFrom UTCTime
|
||||||
|
activeTo UTCTime
|
||||||
|
hintFrom UTCTime Maybe
|
||||||
|
solutionFrom UTCTime Maybe
|
||||||
|
uploadMode UploadMode
|
||||||
|
submissionMode SheetSubmissionMode default='UserSubmissions'
|
||||||
|
CourseSheet course name
|
||||||
|
SheetEdit
|
||||||
|
user UserId
|
||||||
|
time UTCTime
|
||||||
|
sheet SheetId
|
||||||
|
SheetPseudonym
|
||||||
|
sheet SheetId
|
||||||
|
pseudonym Pseudonym
|
||||||
|
user UserId
|
||||||
|
UniqueSheetPseudonym sheet pseudonym
|
||||||
|
UniqueSheetPseudonymUser sheet user
|
||||||
|
SheetCorrector
|
||||||
|
user UserId
|
||||||
|
sheet SheetId
|
||||||
|
load Load
|
||||||
|
state CorrectorState default='CorrectorNormal'
|
||||||
|
UniqueSheetCorrector user sheet
|
||||||
|
deriving Show Eq Ord
|
||||||
|
SheetFile
|
||||||
|
sheet SheetId
|
||||||
|
file FileId
|
||||||
|
type SheetFileType
|
||||||
|
UniqueSheetFile file sheet type
|
||||||
34
models/submissions
Normal file
34
models/submissions
Normal file
@ -0,0 +1,34 @@
|
|||||||
|
Submission
|
||||||
|
sheet SheetId
|
||||||
|
ratingPoints Points Maybe -- "Just" does not mean done
|
||||||
|
ratingComment Text Maybe -- "Just" does not mean done
|
||||||
|
ratingBy UserId Maybe -- assigned corrector
|
||||||
|
ratingAssigned UTCTime Maybe -- time assigned corrector
|
||||||
|
ratingTime UTCTime Maybe -- "Just" here indicates done!
|
||||||
|
deriving Show
|
||||||
|
SubmissionEdit
|
||||||
|
user UserId
|
||||||
|
time UTCTime
|
||||||
|
submission SubmissionId
|
||||||
|
SubmissionFile
|
||||||
|
submission SubmissionId
|
||||||
|
file FileId
|
||||||
|
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 file submission isUpdate
|
||||||
|
deriving Show
|
||||||
|
SubmissionUser -- Actual submission participant
|
||||||
|
user UserId
|
||||||
|
submission SubmissionId
|
||||||
|
UniqueSubmissionUser user submission
|
||||||
|
SubmissionGroup
|
||||||
|
course CourseId
|
||||||
|
name Text Maybe
|
||||||
|
SubmissionGroupEdit
|
||||||
|
user UserId
|
||||||
|
time UTCTime
|
||||||
|
submissionGroup SubmissionGroupId
|
||||||
|
SubmissionGroupUser -- Registered submission groups, independent of actual SubmissionUser
|
||||||
|
submissionGroup SubmissionGroupId
|
||||||
|
user UserId
|
||||||
|
UniqueSubmissionGroupUser submissionGroup user
|
||||||
14
models/system-messages
Normal file
14
models/system-messages
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
SystemMessage
|
||||||
|
from UTCTime Maybe
|
||||||
|
to UTCTime Maybe
|
||||||
|
authenticatedOnly Bool
|
||||||
|
severity MessageClass
|
||||||
|
defaultLanguage Lang
|
||||||
|
content Html
|
||||||
|
summary Html Maybe
|
||||||
|
SystemMessageTranslation
|
||||||
|
message SystemMessageId
|
||||||
|
language Lang
|
||||||
|
content Html
|
||||||
|
summary Html Maybe
|
||||||
|
UniqueSystemMessageTranslation message language
|
||||||
10
models/terms
Normal file
10
models/terms
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
Term json
|
||||||
|
name TermIdentifier -- unTermKey :: TermId -> TermIdentifier
|
||||||
|
start Day -- TermKey :: TermIdentifier -> TermId
|
||||||
|
end Day
|
||||||
|
holidays [Day]
|
||||||
|
lectureStart Day
|
||||||
|
lectureEnd Day
|
||||||
|
active Bool
|
||||||
|
Primary name -- newtype Key Term = TermKey { unTermKey :: TermIdentifier }
|
||||||
|
deriving Show -- type TermId = Key Term
|
||||||
8
models/tutorials
Normal file
8
models/tutorials
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
Tutorial json
|
||||||
|
name Text
|
||||||
|
tutor UserId
|
||||||
|
course CourseId
|
||||||
|
TutorialUser
|
||||||
|
user UserId
|
||||||
|
tutorial TutorialId
|
||||||
|
UniqueTutorialUser user tutorial
|
||||||
43
models/users
Normal file
43
models/users
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
User json
|
||||||
|
ident (CI Text)
|
||||||
|
authentication AuthenticationMode
|
||||||
|
matrikelnummer Text Maybe
|
||||||
|
email (CI Text)
|
||||||
|
displayName Text
|
||||||
|
surname Text -- always use: nameWidget displayName surname
|
||||||
|
maxFavourites Int default=12
|
||||||
|
theme Theme default='Default'
|
||||||
|
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
|
||||||
|
dateFormat DateTimeFormat "default='%d.%m.%Y'"
|
||||||
|
timeFormat DateTimeFormat "default='%R'"
|
||||||
|
downloadFiles Bool default=false
|
||||||
|
mailLanguages MailLanguages default='[]'
|
||||||
|
notificationSettings NotificationSettings
|
||||||
|
UniqueAuthentication ident
|
||||||
|
UniqueEmail email
|
||||||
|
deriving Show Eq
|
||||||
|
UserAdmin
|
||||||
|
user UserId
|
||||||
|
school SchoolId
|
||||||
|
UniqueUserAdmin user school
|
||||||
|
UserLecturer
|
||||||
|
user UserId
|
||||||
|
school SchoolId
|
||||||
|
UniqueSchoolLecturer user school
|
||||||
|
StudyFeatures
|
||||||
|
user UserId
|
||||||
|
degree StudyDegreeId
|
||||||
|
field StudyTermsId
|
||||||
|
type StudyFieldType
|
||||||
|
semester Int
|
||||||
|
-- UniqueUserSubject user degree field -- There exists a counterexample
|
||||||
|
StudyDegree
|
||||||
|
key Int
|
||||||
|
shorthand Text Maybe
|
||||||
|
name Text Maybe
|
||||||
|
Primary key
|
||||||
|
StudyTerms
|
||||||
|
key Int
|
||||||
|
shorthand Text Maybe
|
||||||
|
name Text Maybe
|
||||||
|
Primary key
|
||||||
@ -112,6 +112,7 @@ dependencies:
|
|||||||
- text-metrics
|
- text-metrics
|
||||||
- pkcs7
|
- pkcs7
|
||||||
- memcached-binary
|
- memcached-binary
|
||||||
|
- directory-tree
|
||||||
|
|
||||||
other-extensions:
|
other-extensions:
|
||||||
- GeneralizedNewtypeDeriving
|
- GeneralizedNewtypeDeriving
|
||||||
|
|||||||
27
src/Database/Persist/TH/Directory.hs
Normal file
27
src/Database/Persist/TH/Directory.hs
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
module Database.Persist.TH.Directory
|
||||||
|
( persistDirectoryWith
|
||||||
|
) where
|
||||||
|
|
||||||
|
import ClassyPrelude hiding (mapM_, toList)
|
||||||
|
|
||||||
|
import Database.Persist.TH (parseReferences)
|
||||||
|
import Database.Persist.Quasi (PersistSettings)
|
||||||
|
import Language.Haskell.TH.Syntax
|
||||||
|
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
import qualified Data.Text.IO as Text
|
||||||
|
import qualified System.IO as SIO
|
||||||
|
|
||||||
|
import qualified System.Directory.Tree as DirTree
|
||||||
|
|
||||||
|
import Data.Foldable (Foldable(..), mapM_)
|
||||||
|
|
||||||
|
persistDirectoryWith :: PersistSettings -> FilePath -> Q Exp
|
||||||
|
persistDirectoryWith settings dir = do
|
||||||
|
files <- runIO . flip DirTree.readDirectoryWith dir $ \fp -> do
|
||||||
|
h <- SIO.openFile fp SIO.ReadMode
|
||||||
|
SIO.hSetEncoding h SIO.utf8_bom
|
||||||
|
Text.hGetContents h
|
||||||
|
mapM_ (qAddDependentFile . fst) $ DirTree.zipPaths files
|
||||||
|
|
||||||
|
parseReferences settings . Text.intercalate "\n" . toList $ DirTree.dirTree files
|
||||||
@ -8,6 +8,7 @@ module Model
|
|||||||
|
|
||||||
import ClassyPrelude.Yesod
|
import ClassyPrelude.Yesod
|
||||||
import Database.Persist.Quasi
|
import Database.Persist.Quasi
|
||||||
|
import Database.Persist.TH.Directory
|
||||||
-- import Data.Time
|
-- import Data.Time
|
||||||
-- import Data.ByteString
|
-- import Data.ByteString
|
||||||
import Model.Types
|
import Model.Types
|
||||||
@ -26,7 +27,7 @@ import Settings.Cluster (ClusterSettingsKey)
|
|||||||
-- at:
|
-- at:
|
||||||
-- http://www.yesodweb.com/book/persistent/
|
-- http://www.yesodweb.com/book/persistent/
|
||||||
share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll'", mkSave "currentModel"]
|
share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll'", mkSave "currentModel"]
|
||||||
$(persistFileWith lowerCaseSettings "models")
|
$(persistDirectoryWith lowerCaseSettings "models")
|
||||||
|
|
||||||
-- (Eq Course) is impossible so we derive it for the Uniqueness Constraint only
|
-- (Eq Course) is impossible so we derive it for the Uniqueness Constraint only
|
||||||
deriving instance Eq (Unique Course)
|
deriving instance Eq (Unique Course)
|
||||||
|
|||||||
Reference in New Issue
Block a user