refactor(qualifications): unify qualification selectField mechanics
This commit is contained in:
parent
c1dbd61c14
commit
8f54ea1051
@ -59,7 +59,7 @@ instance Finite ButtonAvsTest
|
|||||||
nullaryPathPiece ''ButtonAvsTest camelToPathPiece
|
nullaryPathPiece ''ButtonAvsTest camelToPathPiece
|
||||||
|
|
||||||
instance Button UniWorX ButtonAvsTest where
|
instance Button UniWorX ButtonAvsTest where
|
||||||
btnLabel BtnCheckLicences = "Check all licences" -- could be msg
|
btnLabel BtnCheckLicences = "Show all licence difference to current AVS" -- could be msg
|
||||||
-- btnLabel BtnSynchLicences = "Synchronize all licences" -- could be msg
|
-- btnLabel BtnSynchLicences = "Synchronize all licences" -- could be msg
|
||||||
btnClasses BtnCheckLicences = [BCIsButton, BCPrimary]
|
btnClasses BtnCheckLicences = [BCIsButton, BCPrimary]
|
||||||
-- btnClasses BtnSynchLicences = [BCIsButton, BCDanger]
|
-- btnClasses BtnSynchLicences = [BCIsButton, BCDanger]
|
||||||
@ -270,7 +270,7 @@ postAdminAvsR = do
|
|||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
(Just BtnCheckLicences) -> do
|
(Just BtnCheckLicences) -> do
|
||||||
res <- try $ do
|
res <- try $ do
|
||||||
allLicences <- avsQuery AvsQueryGetAllLicences
|
allLicences <- avsQueryNoCache AvsQueryGetAllLicences
|
||||||
computeDifferingLicences allLicences
|
computeDifferingLicences allLicences
|
||||||
case res of
|
case res of
|
||||||
(Right diffs) -> do
|
(Right diffs) -> do
|
||||||
@ -531,11 +531,12 @@ instance HasUser LicenceTableData where
|
|||||||
mkLicenceTable :: AvsPersonIdMapPersonCard -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
mkLicenceTable :: AvsPersonIdMapPersonCard -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||||
mkLicenceTable apidStatus dbtIdent aLic apids = do
|
mkLicenceTable apidStatus dbtIdent aLic apids = do
|
||||||
currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
|
currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
|
||||||
avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] []
|
avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] [Asc QualificationName]
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
|
|
||||||
let nowaday = utctDay now
|
let nowaday = utctDay now
|
||||||
avsQids = entityKey <$> avsQualifications
|
avsQids = entityKey <$> avsQualifications
|
||||||
|
qualOpts = pure $ qualificationsOptionList avsQualifications
|
||||||
-- fltrLic qual = if
|
-- fltrLic qual = if
|
||||||
-- | aLic == AvsNoLicence -> E.isNothing (qual E.?. QualificationId) E.||. E.isJust (E.joinV $ qual E.?. QualificationAvsLicence) -- could be R, F, both or none at all, but has licence in AVS
|
-- | aLic == AvsNoLicence -> E.isNothing (qual E.?. QualificationId) E.||. E.isJust (E.joinV $ qual E.?. QualificationAvsLicence) -- could be R, F, both or none at all, but has licence in AVS
|
||||||
-- | otherwise -> E.isNothing (qual E.?. QualificationId) E.||. (E.val aLic E.=?. E.joinV (qual E.?. QualificationAvsLicence)) -- if we suggest granting that licence, this join should deliver a value too
|
-- | otherwise -> E.isNothing (qual E.?. QualificationId) E.||. (E.val aLic E.=?. E.joinV (qual E.?. QualificationAvsLicence)) -- if we suggest granting that licence, this join should deliver a value too
|
||||||
@ -614,14 +615,6 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
|
|||||||
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
||||||
]
|
]
|
||||||
|
|
||||||
qualOpt :: Entity Qualification -> Handler (Option QualificationId)
|
|
||||||
qualOpt (Entity qualId qual) = do
|
|
||||||
cQualId :: CryptoUUIDQualification <- encrypt qualId
|
|
||||||
return $ Option
|
|
||||||
{ optionDisplay = CI.original $ qualificationName qual
|
|
||||||
, optionInternalValue = qualId
|
|
||||||
, optionExternalValue = tshow cQualId
|
|
||||||
}
|
|
||||||
aLicQid = fmap entityKey . headMay $ filter ((== Just aLic) . qualificationAvsLicence . entityVal) avsQualifications
|
aLicQid = fmap entityKey . headMay $ filter ((== Just aLic) . qualificationAvsLicence . entityVal) avsQualifications
|
||||||
|
|
||||||
-- Block identical to Handler/Qualifications TODO: refactor
|
-- Block identical to Handler/Qualifications TODO: refactor
|
||||||
@ -647,12 +640,12 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
|
|||||||
[ singletonMap LicenceTableChangeAvs $ pure LicenceTableChangeAvsData
|
[ singletonMap LicenceTableChangeAvs $ pure LicenceTableChangeAvsData
|
||||||
, if aLic == AvsNoLicence
|
, if aLic == AvsNoLicence
|
||||||
then singletonMap LicenceTableRevokeFDrive $ LicenceTableRevokeFDriveData
|
then singletonMap LicenceTableRevokeFDrive $ LicenceTableRevokeFDriveData
|
||||||
<$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
|
<$> apreq (selectField qualOpts) (fslI MsgQualificationName) aLicQid
|
||||||
<*> apreq (textField & cfStrip & addDatalist suggestionsBlock) (fslI MsgQualificationBlockReason) Nothing
|
<*> apreq (textField & cfStrip & addDatalist suggestionsBlock) (fslI MsgQualificationBlockReason) Nothing
|
||||||
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify) (Just False)
|
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify) (Just False)
|
||||||
|
|
||||||
else singletonMap LicenceTableGrantFDrive $ LicenceTableGrantFDriveData
|
else singletonMap LicenceTableGrantFDrive $ LicenceTableGrantFDriveData
|
||||||
<$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
|
<$> apreq (selectField qualOpts) (fslI MsgQualificationName) aLicQid
|
||||||
<*> apreq (textField & cfStrip & addDatalist suggestionsUnblock) (fslI MsgQualificationGrantReason) Nothing
|
<*> apreq (textField & cfStrip & addDatalist suggestionsUnblock) (fslI MsgQualificationGrantReason) Nothing
|
||||||
<*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?!
|
<*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?!
|
||||||
<*> aopt (convertField not not (boolField . Just $ SomeMessage MsgBoolIrrelevant)) (fslI MsgQualificationUserNoRenewal) Nothing
|
<*> aopt (convertField not not (boolField . Just $ SomeMessage MsgBoolIrrelevant)) (fslI MsgQualificationUserNoRenewal) Nothing
|
||||||
|
|||||||
@ -299,8 +299,8 @@ qualificationUserUnblockByReason qid uids mbUnblockTime (qualificationChangeReas
|
|||||||
qualificationOption :: Entity Qualification -> Option QualificationId
|
qualificationOption :: Entity Qualification -> Option QualificationId
|
||||||
qualificationOption (Entity qid Qualification{..}) =
|
qualificationOption (Entity qid Qualification{..}) =
|
||||||
let qsh = ciOriginal $ unSchoolKey qualificationSchool
|
let qsh = ciOriginal $ unSchoolKey qualificationSchool
|
||||||
in Option{ optionDisplay = ciOriginal qualificationName <> " (" <> qsh <> ")"
|
in Option{ optionDisplay = ciOriginal qualificationName <> " (" <> qsh <> ")"
|
||||||
, optionExternalValue = "(" <> ciOriginal qualificationShorthand <> "___" <> qsh <> ")"
|
, optionExternalValue = toPathPiece $ ciOriginal qualificationShorthand <> "___" <> qsh -- both a publicly known already
|
||||||
, optionInternalValue = qid
|
, optionInternalValue = qid
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user