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

refactor(qualifications): towards using dbtProj for companies working

Browse Source
This commit is contained in:
Steffen Jost 2023-04-28 08:59:37 +00:00
parent 797729a248
commit f1ec4d0b7b
1 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Handler/Qualification.hs
View File

@ -153,7 +153,7 @@ mkQualificationAllTable = do
data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc..
{ qtcDisplayName :: UserDisplayName
, qtcEmail :: UserEmail
, qtcCompany :: [Text]
, qtcCompany :: Maybe Text
, qtcValidUntil :: Day
, qtcLastRefresh :: Day
, qtcBlocked :: Maybe Day
@ -168,7 +168,7 @@ qtcExample :: QualificationTableCsv
qtcExample = QualificationTableCsv
{ qtcDisplayName = "Max Mustermann"
, qtcEmail = "m.mustermann@example.com"
, qtcCompany = ["Example Brothers LLC"]
, qtcCompany = Just "Example Brothers LLC, SecondayJobs Inc"
, qtcValidUntil = compDay
, qtcLastRefresh = compDay
, qtcBlocked = Nothing
@ -281,7 +281,7 @@ isBlockAct _ = False
qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) -> QualificationTableExpr
-> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
, E.SqlExpr (Entity User)
, E.SqlExpr (Maybe (Entity LmsUser))
, E.SqlExpr (Maybe (Entity LmsUser))
)
qualificationTableQuery qid fltr (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do
E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser
@ -345,7 +345,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId
E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyName)
)
)
]
dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser
@ -394,7 +394,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
doEncode' = QualificationTableCsv
<$> view (resultUser . _entityVal . _userDisplayName)
<*> view (resultUser . _entityVal . _userDisplayEmail)
<*> pure ["TODO: companies not yet exported"]
<*> pure (Just "TODO: companies not yet exported")
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
<*> preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay)
@ -444,7 +444,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
getQualificationR, postQualificationR :: SchoolId -> QualificationShorthand -> Handler Html
getQualificationR = postQualificationR
postQualificationR sid qsh = do
isAdmin <- hasReadAccessTo AdminR
isAdmin <- hasReadAccessTo AdminR
((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh
let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
@ -461,7 +461,7 @@ postQualificationR sid qsh = do
linkUserName = bool ForProfileR ForProfileDataR isAdmin
blockedDueCell = bool qualificationBlockedCellNoReason qualificationBlockedCell isAdmin
colChoices cmpMap = mconcat
[ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
[ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
, colUserNameModalHdr MsgLmsUser linkUserName
, colUserEmail
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \( view $ resultUser . _entityKey -> uid) -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
@ -470,21 +470,20 @@ postQualificationR sid qsh = do
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
let companies = intersperse (text2markup ", ") $
let companies = intercalate (text2markup ", ") $
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
icnSuper = text2markup " " <> icon IconSupervisor
pure $ toWgt $ mconcat companies
, sortable (Just "company") (i18nCell MsgTableCompany) $ \( view resultCompanyUser -> cmps) -> do
pure $ toWgt companies
, sortable (Just "company") (i18nCell MsgTableCompany) $ \( view resultCompanyUser -> cmps) ->
let icnSuper = text2markup " " <> icon IconSupervisor
cs = [ (cmpName, cmpSpr)
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
, let cmpEnt = Map.lookup cmpId cmpMap
, isJust cmpEnt
, let Just (Entity _ Company{companyName = cmpName}) = cmpEnt
, Just (Entity _ Company{companyName = cmpName}) <- [cmpEnt]
]
companies = intersperse (text2markup ", ") $
companies = intercalate (text2markup ", ") $
(\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs
pure $ toWgt $ mconcat companies
in wgtCell companies
, guardMonoid isAdmin colUserMatriclenr
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d