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

Various minor fixes

Browse Source
This commit is contained in:
Steffen Jost 2019-03-20 14:09:46 +01:00
parent 350dfa6c4a
commit 1c1dc70066
6 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ChangeLog.md
View File

@ -1,3 +1,7 @@
* Version 20.03.2019
Kursanmeldung benötigen assoziertes Hauptfach (für Studierende mit mehreren Hauptfächern)
* Version 30.01.2019 * Version 30.01.2019
Designänderungen Designänderungen

4
messages/uniworx/de.msg
View File

@ -71,8 +71,8 @@ CourseNewHeading: Neuen Kurs anlegen
CourseEditHeading tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} editieren CourseEditHeading tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} editieren
CourseEditTitle: Kurs editieren/anlegen CourseEditTitle: Kurs editieren/anlegen
CourseMembers: Teilnehmer CourseMembers: Teilnehmer
CourseMembersCount num@Int64: #{display num} CourseMembersCount n@Int: #{display n}
CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} CourseMembersCountLimited n@Int max@Int: #{display n}/#{display max}
CourseName: Name CourseName: Name
CourseDescription: Beschreibung CourseDescription: Beschreibung
CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet

4
models/courses
View File

@ -10,7 +10,7 @@ Course -- Information about a single course; contained info is always visible
shorthand (CI Text) -- practical shorthand of course name, used for identification shorthand (CI Text) -- practical shorthand of course name, used for identification
term TermId -- semester this course is taught term TermId -- semester this course is taught
school SchoolId school SchoolId
capacity Int64 Maybe -- number of allowed enrolements, if restricted capacity Int Maybe -- number of allowed enrolements, if restricted
-- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo -- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
registerFrom UTCTime Maybe -- enrolement allowed from a given day onwwards or prohibited registerFrom UTCTime Maybe -- enrolement allowed from a given day onwwards or prohibited
registerTo UTCTime Maybe -- enrolement may be prohibited from a given date onwards registerTo UTCTime Maybe -- enrolement may be prohibited from a given date onwards
@ -20,7 +20,7 @@ Course -- Information about a single course; contained info is always visible
TermSchoolCourseShort term school shorthand -- shorthand must be unique within school and semester TermSchoolCourseShort term school shorthand -- shorthand must be unique within school and semester
TermSchoolCourseName term school name -- name must be unique within school and semester TermSchoolCourseName term school name -- name must be unique within school and semester
deriving Generic deriving Generic
CourseEdit -- who edited when a row in table "Course", kept indefinitely CourseEdit -- who edited when a row in table "Course", kept indefinitely (might be replaced by generic Audit Table; like all ...-Edit tables)
user UserId user UserId
time UTCTime time UTCTime
course CourseId course CourseId

2
models/tutorials
View File

@ -4,7 +4,7 @@ Tutorial json
name Text name Text
tutor UserId tutor UserId
course CourseId course CourseId
capacity Int64 Maybe -- limit for enrolement in this tutorial capacity Int Maybe -- limit for enrolement in this tutorial
TutorialUser TutorialUser
user UserId user UserId
tutorial TutorialId tutorial TutorialId

10
src/Handler/Course.hs
View File

@ -31,7 +31,7 @@ import qualified Database.Esqueleto as E
-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method. -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School) type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School)
colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
colCourse = sortable (Just "course") (i18nCell MsgCourse) colCourse = sortable (Just "course") (i18nCell MsgCourse)
@ -108,10 +108,10 @@ colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School) type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School)
course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int64) course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int)
course2Participants (course `E.InnerJoin` _school) = E.sub_select . E.from $ \courseParticipant -> do course2Participants (course `E.InnerJoin` _school) = E.sub_select . E.from $ \courseParticipant -> do
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
return (E.countRows :: E.SqlExpr (E.Value Int64)) return (E.countRows :: E.SqlExpr (E.Value Int))
course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool) course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant -> course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant ->
@ -281,7 +281,7 @@ getCShowR tid ssh csh = do
E.limit 1 -- we know that there is at most one match, but we tell the DB this info too E.limit 1 -- we know that there is at most one match, but we tell the DB this info too
let numParticipants = E.sub_select . E.from $ \part -> do let numParticipants = E.sub_select . E.from $ \part -> do
E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
return ( E.countRows :: E.SqlExpr (E.Value Int64)) return ( E.countRows :: E.SqlExpr (E.Value Int))
return (course,school E.^. SchoolName, numParticipants, participant) return (course,school E.^. SchoolName, numParticipants, participant)
defSFid <- ifMaybeM mbAid Nothing $ \uid -> lift $ selectFirst [StudyFeaturesUser ==. uid, StudyFeaturesType ==. FieldPrimary, StudyFeaturesValid ==. True] [Desc StudyFeaturesUpdated, Desc StudyFeaturesDegree, Desc StudyFeaturesField] -- sorting by degree & field is an heuristic only, but this is okay for a default suggestion defSFid <- ifMaybeM mbAid Nothing $ \uid -> lift $ selectFirst [StudyFeaturesUser ==. uid, StudyFeaturesType ==. FieldPrimary, StudyFeaturesValid ==. True] [Desc StudyFeaturesUpdated, Desc StudyFeaturesDegree, Desc StudyFeaturesField] -- sorting by degree & field is an heuristic only, but this is okay for a default suggestion
lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
@ -532,7 +532,7 @@ data CourseForm = CourseForm
, cfShort :: CourseShorthand , cfShort :: CourseShorthand
, cfTerm :: TermId , cfTerm :: TermId
, cfSchool :: SchoolId , cfSchool :: SchoolId
, cfCapacity :: Maybe Int64 , cfCapacity :: Maybe Int
, cfSecret :: Maybe Text , cfSecret :: Maybe Text
, cfMatFree :: Bool , cfMatFree :: Bool
, cfRegFrom :: Maybe UTCTime , cfRegFrom :: Maybe UTCTime

8
src/Handler/Utils/TermCandidates.hs
View File

@ -37,9 +37,9 @@ data FailedCandidateInference = FailedCandidateInference [Entity StudyTerms]
instance Exception FailedCandidateInference instance Exception FailedCandidateInference
-- Default Instance -- Default Instance
-- | Just an heuristik to fill in defaults -- -- | Just an heuristik to fill in defaults
shortenStudyTerm :: Text -> Text -- shortenStudyTerm :: Text -> Text
shortenStudyTerm = concatMap (take 4) . splitCamel -- shortenStudyTerm = concatMap (take 4) . splitCamel
-- | Attempt to identify new StudyTerms based on observations, returning: -- | Attempt to identify new StudyTerms based on observations, returning:
-- * list of ambiguous instances that were discarded outright (identical names for differents keys observed in single incidences) -- * list of ambiguous instances that were discarded outright (identical names for differents keys observed in single incidences)
@ -162,7 +162,7 @@ acceptSingletons = do
-- registerFixed :: (STKey, Text) -> DB (Key StudyTerms) -- registerFixed :: (STKey, Text) -> DB (Key StudyTerms)
registerFixed :: (STKey, Text) -> DB () registerFixed :: (STKey, Text) -> DB ()
registerFixed (key, name) = repsert (StudyTermsKey' key) $ StudyTerms key (Just $ shortenStudyTerm name) (Just name) registerFixed (key, name) = repsert (StudyTermsKey' key) $ StudyTerms key Nothing (Just name)
-- register newly fixed candidates -- register newly fixed candidates
forM_ fixedKeys registerFixed forM_ fixedKeys registerFixed