fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 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
(userSchools, elegibleQualifications) :: ([SchoolId], OptionList QualificationId) <- liftHandler . runDB $ do
lecturerSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] []
protoAdminSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] []
adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
protoAdminSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] [] -- default rights
adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools -- and user as admin rights active right now
oldSchool <- forM (cfCourseId =<< template) $ fmap courseSchool . getJust
let elegibleSchools = Set.fromList $ lecturerSchools ++ adminSchools
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
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
void $ runMaybeT $ do
oldAfi <- MaybeT $ pure mbOldAfi
@ -928,7 +928,7 @@ retrieveDifferingLicences' getStatus = do
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
#else
allLicences <- avsQuery AvsQueryGetAllLicences
allLicences <- avsQueryNoCache AvsQueryGetAllLicences
#endif
lDiff <- getDifferingLicences allLicences
#ifdef DEVELOPMENT
@ -960,7 +960,7 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
--let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld) licences
-- rollfeld = Set.filter (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld
-- 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'
vorORrollfeld = Set.map avsLicencePersonID vorORrollfeld'
rollfeld = Set.map avsLicencePersonID rollfeld'
@ -995,7 +995,7 @@ getDifferingLicences (AvsResponseGetLicences licences) = do
<$> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld
<*> antijoinAvsLicences AvsLicenceRollfeld rollfeld
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
setTo2 = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld) -- grant maneuvering driving licence
return AvsLicenceDifferences

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

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