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

refactor: various minor changes, mostly some comments

Browse Source
This commit is contained in:
Steffen Jost 2024-08-07 17:51:33 +02:00
parent 8f54ea1051
commit 6299612adc
3 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Handler/Course/Edit.hs
View File

@ -87,8 +87,8 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
uid <- liftHandler requireAuthId uid <- liftHandler requireAuthId
(userSchools, elegibleQualifications) :: ([SchoolId], OptionList QualificationId) <- liftHandler . runDB $ do (userSchools, elegibleQualifications) :: ([SchoolId], OptionList QualificationId) <- liftHandler . runDB $ do
lecturerSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] [] lecturerSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] []
protoAdminSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] [] protoAdminSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] [] -- default rights
adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools -- and user as admin rights active right now
oldSchool <- forM (cfCourseId =<< template) $ fmap courseSchool . getJust oldSchool <- forM (cfCourseId =<< template) $ fmap courseSchool . getJust
let elegibleSchools = Set.fromList $ lecturerSchools ++ adminSchools let elegibleSchools = Set.fromList $ lecturerSchools ++ adminSchools
userSchools = Set.toList $ maybe id Set.insert oldSchool elegibleSchools userSchools = Set.toList $ maybe id Set.insert oldSchool elegibleSchools

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

@ -714,7 +714,7 @@ upsertCompanySuperior (mbCid, newAfi) mbOldAfi
) )
reportAdminProblem $ AdminProblemCompanySuperiorChange supid cid oldSup reportAdminProblem $ AdminProblemCompanySuperiorChange supid cid oldSup
return (cid,supid) return (cid,supid)
| Just oldSupeEmail <- mbOldAfi ^? _Just . _avsFirmEMailSuperior . _Just -- no more superior, delete old one | Just oldSupeEmail <- mbOldAfi ^. _Just . _avsFirmEMailSuperior -- no more superior, delete old one
= do = do
void $ runMaybeT $ do void $ runMaybeT $ do
oldAfi <- MaybeT $ pure mbOldAfi oldAfi <- MaybeT $ pure mbOldAfi
@ -928,7 +928,7 @@ retrieveDifferingLicences' getStatus = do
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1 -- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs] ] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
#else #else
allLicences <- avsQuery AvsQueryGetAllLicences allLicences <- avsQueryNoCache AvsQueryGetAllLicences
#endif #endif
lDiff <- getDifferingLicences allLicences lDiff <- getDifferingLicences allLicences
#ifdef DEVELOPMENT #ifdef DEVELOPMENT
@ -960,7 +960,7 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
--let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences --let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences
-- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld -- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld
-- Note: FRADrive users with 'R' also own 'F' qualification, but AvsGetResponseGetLicences yields only either -- Note: FRADrive users with 'R' also own 'F' qualification, but AvsGetResponseGetLicences yields only either
let vorORrollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) licences let vorORrollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) licences -- antitone is ok, see test/Utils/TypesSpec -> "Ord AvsPersonLicence"
rollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) vorORrollfeld' rollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) vorORrollfeld'
vorORrollfeld = Set.map avsLicencePersonID vorORrollfeld' vorORrollfeld = Set.map avsLicencePersonID vorORrollfeld'
rollfeld = Set.map avsLicencePersonID rollfeld' rollfeld = Set.map avsLicencePersonID rollfeld'
@ -995,7 +995,7 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
<$> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld <$> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld
<*> antijoinAvsLicences AvsLicenceRollfeld rollfeld <*> antijoinAvsLicences AvsLicenceRollfeld rollfeld
let setTo0 = vorfRevoke -- revoke driving licences let setTo0 = vorfRevoke -- revoke driving licences
setTo1up = vorfGrant Set.\\ rollGrant -- grant apron driving licence setTo1up = vorfGrant Set.\\ rollGrant -- grant apron driving licence
setTo1down = rollRevoke Set.\\ vorfRevoke -- revoke maneuvering area licence, but retain apron driving licence setTo1down = rollRevoke Set.\\ vorfRevoke -- revoke maneuvering area licence, but retain apron driving licence
setTo2 = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld) -- grant maneuvering driving licence setTo2 = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld) -- grant maneuvering driving licence
return AvsLicenceDifferences return AvsLicenceDifferences

2
src/Handler/Utils/Form.hs
View File

@ -1489,7 +1489,7 @@ boolField' :: ( MonadHandler m
, HandlerSite m ~ UniWorX , HandlerSite m ~ UniWorX
) )
=> Field m Bool => Field m Bool
boolField' = boolField (Just $ SomeMessage MsgBoolIrrelevant) boolField' = boolField (Just $ SomeMessage MsgBoolIrrelevant) -- MsgBoolIrrelevant is shown if the field is optional
boolField :: ( MonadHandler m boolField :: ( MonadHandler m
, HandlerSite m ~ UniWorX , HandlerSite m ~ UniWorX