fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Split models

Browse Source
This commit is contained in:
Gregor Kleen 2018-12-19 17:37:42 +01:00
parent 45bfe771ad
commit 2eb09d0de7
17 changed files with 292 additions and 263 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

262
models
View File

@ -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
View File

@ -0,0 +1,4 @@
ClusterConfig
setting ClusterSettingsKey
value Value
Primary setting

40
models/courses Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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

1
package.yaml
View File

@ -112,6 +112,7 @@ dependencies:
- text-metrics
- pkcs7
- memcached-binary
- directory-tree
other-extensions:
- GeneralizedNewtypeDeriving

27
src/Database/Persist/TH/Directory.hs Normal file
View 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

3
src/Model.hs
View File

@ -8,6 +8,7 @@ module Model
import ClassyPrelude.Yesod
import Database.Persist.Quasi
import Database.Persist.TH.Directory
-- import Data.Time
-- import Data.ByteString
import Model.Types
@ -26,7 +27,7 @@ import Settings.Cluster (ClusterSettingsKey)
-- at:
-- http://www.yesodweb.com/book/persistent/
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
deriving instance Eq (Unique Course)