chore(firm): link firms throughout
This commit is contained in:
parent
d81e6e15dc
commit
92e83475a9
8
routes
8
routes
@ -113,7 +113,7 @@
|
|||||||
/for/#CryptoUUIDUser/user ForProfileR GET POST !supervisor !self
|
/for/#CryptoUUIDUser/user ForProfileR GET POST !supervisor !self
|
||||||
/for/#CryptoUUIDUser/user/profile ForProfileDataR GET !supervisor !self
|
/for/#CryptoUUIDUser/user/profile ForProfileDataR GET !supervisor !self
|
||||||
|
|
||||||
/firm FirmAllR GET
|
/firm FirmAllR GET
|
||||||
/firm/#CompanyShorthand FirmR GET POST
|
/firm/#CompanyShorthand FirmR GET POST
|
||||||
|
|
||||||
/exam-office ExamOfficeR !exam-office:
|
/exam-office ExamOfficeR !exam-office:
|
||||||
@ -278,7 +278,7 @@
|
|||||||
/lms/#SchoolId/#QualificationShorthand/edit LmsEditR GET POST
|
/lms/#SchoolId/#QualificationShorthand/edit LmsEditR GET POST
|
||||||
-- old V1 LMS Interface
|
-- old V1 LMS Interface
|
||||||
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET
|
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET
|
||||||
/lms/#SchoolId/#QualificationShorthand/users/direct LmsUsersDirectR GET !token -- LMS
|
/lms/#SchoolId/#QualificationShorthand/users/direct LmsUsersDirectR GET !token -- LMS
|
||||||
/lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET POST
|
/lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET POST
|
||||||
/lms/#SchoolId/#QualificationShorthand/userlist/upload LmsUserlistUploadR GET POST !development
|
/lms/#SchoolId/#QualificationShorthand/userlist/upload LmsUserlistUploadR GET POST !development
|
||||||
/lms/#SchoolId/#QualificationShorthand/userlist/direct LmsUserlistDirectR POST !token -- LMS, also remove JobLmsUserlist constructor
|
/lms/#SchoolId/#QualificationShorthand/userlist/direct LmsUserlistDirectR POST !token -- LMS, also remove JobLmsUserlist constructor
|
||||||
@ -287,11 +287,11 @@
|
|||||||
/lms/#SchoolId/#QualificationShorthand/result/direct LmsResultDirectR POST !token -- LMS, also remove JobLmsResults constructor
|
/lms/#SchoolId/#QualificationShorthand/result/direct LmsResultDirectR POST !token -- LMS, also remove JobLmsResults constructor
|
||||||
-- new V2 LMS Interface
|
-- new V2 LMS Interface
|
||||||
/lms/#SchoolId/#QualificationShorthand/learners LmsLearnersR GET
|
/lms/#SchoolId/#QualificationShorthand/learners LmsLearnersR GET
|
||||||
/lms/#SchoolId/#QualificationShorthand/learners/direct LmsLearnersDirectR GET !token -- LMS
|
/lms/#SchoolId/#QualificationShorthand/learners/direct LmsLearnersDirectR GET !token -- LMS
|
||||||
/lms/#SchoolId/#QualificationShorthand/report LmsReportR GET POST
|
/lms/#SchoolId/#QualificationShorthand/report LmsReportR GET POST
|
||||||
/lms/#SchoolId/#QualificationShorthand/report/upload LmsReportUploadR GET POST !development
|
/lms/#SchoolId/#QualificationShorthand/report/upload LmsReportUploadR GET POST !development
|
||||||
/lms/#SchoolId/#QualificationShorthand/report/direct LmsReportDirectR POST !token -- LMS
|
/lms/#SchoolId/#QualificationShorthand/report/direct LmsReportDirectR POST !token -- LMS
|
||||||
-- other lms routes
|
-- other lms routes
|
||||||
/lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent LmsIdentR GET -- redirect to LmsR with filter-parameter
|
/lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent LmsIdentR GET -- redirect to LmsR with filter-parameter
|
||||||
/lms/#SchoolId/#QualificationShorthand/user/#CryptoUUIDUser LmsUserR GET
|
/lms/#SchoolId/#QualificationShorthand/user/#CryptoUUIDUser LmsUserR GET
|
||||||
/lmsuser/#CryptoUUIDUser LmsUserAllR GET
|
/lmsuser/#CryptoUUIDUser LmsUserAllR GET
|
||||||
|
|||||||
@ -556,11 +556,12 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
|
|||||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
||||||
E.orderBy [E.asc (comp E.^. CompanyName)]
|
E.orderBy [E.asc (comp E.^. CompanyName)]
|
||||||
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||||
let companies = intersperse (text2markup ", ") $
|
let icnSuper = toWidget $ text2markup " " <> icon IconSupervisor
|
||||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
companies =
|
||||||
icnSuper = text2markup " " <> icon IconSupervisor
|
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||||
pure $ toWgt $ mconcat companies
|
|
||||||
|
pure $ intercalate (text2widget "; ") companies
|
||||||
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q
|
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q
|
||||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
|
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
|
||||||
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d
|
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d
|
||||||
|
|||||||
@ -28,7 +28,7 @@ import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications
|
|||||||
-- import qualified Database.Esqueleto.Legacy as E
|
-- import qualified Database.Esqueleto.Legacy as E
|
||||||
-- import qualified Database.Esqueleto.PostgreSQL as E
|
-- import qualified Database.Esqueleto.PostgreSQL as E
|
||||||
-- import qualified Database.Esqueleto.Utils as E
|
-- import qualified Database.Esqueleto.Utils as E
|
||||||
-- import Database.Esqueleto.Utils.TH
|
import Database.Esqueleto.Utils.TH
|
||||||
|
|
||||||
|
|
||||||
-- avoids repetition of local definitions
|
-- avoids repetition of local definitions
|
||||||
@ -38,10 +38,10 @@ import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications
|
|||||||
|
|
||||||
getFirmR, postFirmR :: CompanyShorthand -> Handler Html
|
getFirmR, postFirmR :: CompanyShorthand -> Handler Html
|
||||||
getFirmR = postFirmR
|
getFirmR = postFirmR
|
||||||
postFirmR _ = do
|
postFirmR fsh = do
|
||||||
siteLayoutMsg MsgMenuFirms $ do
|
siteLayoutMsg MsgMenuFirms $ do
|
||||||
setTitleI MsgMenuFirms
|
setTitleI MsgMenuFirms
|
||||||
[whamlet|STUB TO DO|]
|
[whamlet|STUB FOR #{fsh} TO DO|]
|
||||||
|
|
||||||
|
|
||||||
getFirmAllR :: Handler Html
|
getFirmAllR :: Handler Html
|
||||||
@ -53,8 +53,7 @@ getFirmAllR = do
|
|||||||
siteLayoutMsg MsgMenuFirms $ do
|
siteLayoutMsg MsgMenuFirms $ do
|
||||||
setTitleI MsgMenuFirms
|
setTitleI MsgMenuFirms
|
||||||
-- $(widgetFile "firm-all")
|
-- $(widgetFile "firm-all")
|
||||||
[whamlet|!!!STUB!!!TO DO!!!
|
[whamlet|!!!STUB!!!TO DO!!!
|
||||||
|
|
||||||
^{firmTable}
|
^{firmTable}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
@ -73,9 +72,9 @@ resultAllCompanyForeignSupers :: Lens' AllCompanyTableData Word64
|
|||||||
resultAllCompanyForeignSupers = _dbrOutput . _4 . _unValue
|
resultAllCompanyForeignSupers = _dbrOutput . _4 . _unValue
|
||||||
|
|
||||||
|
|
||||||
mkQualificationAllTable :: Bool -> UserId -> DB (Any, Widget)
|
mkFirmAllTable :: Bool -> UserId -> DB (Any, Widget)
|
||||||
mkQualificationAllTable isAdmin uid = do
|
mkFirmAllTable isAdmin uid = do
|
||||||
now <- liftIO getCurrentTime
|
-- now <- liftIO getCurrentTime
|
||||||
let
|
let
|
||||||
resultDBTable = DBTable{..}
|
resultDBTable = DBTable{..}
|
||||||
where
|
where
|
||||||
@ -83,7 +82,7 @@ mkQualificationAllTable isAdmin uid = do
|
|||||||
let filterCmpy usrCmpy = usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
|
let filterCmpy usrCmpy = usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
|
||||||
cforeign = E.subSelectCount $ E.distinct $ do
|
cforeign = E.subSelectCount $ E.distinct $ do
|
||||||
usrSuper <- E.from $ E.table @UserSupervisor
|
usrSuper <- E.from $ E.table @UserSupervisor
|
||||||
E.where_ (E.exists $ do
|
E.where_ $ E.exists (do
|
||||||
usrCmpy <- E.from $ E.table @UserCompany
|
usrCmpy <- E.from $ E.table @UserCompany
|
||||||
E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser
|
E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser
|
||||||
) E.&&. E.notExists (do
|
) E.&&. E.notExists (do
|
||||||
@ -97,23 +96,21 @@ mkQualificationAllTable isAdmin uid = do
|
|||||||
csupers = E.subSelectCount $ do
|
csupers = E.subSelectCount $ do
|
||||||
usrCmpy <- E.from $ E.table @UserCompany
|
usrCmpy <- E.from $ E.table @UserCompany
|
||||||
E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanySupervisor
|
E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanySupervisor
|
||||||
whenIsJust mbUid $ \uid ->
|
unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies
|
||||||
E.where_ $ E.exists $ do -- only show associated companies
|
usrCmpy <- E.from $ E.table @UserCompany
|
||||||
usrCmpy <- E.from $ E.table @UserCompany
|
E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid
|
||||||
E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid
|
|
||||||
return (cmpy, csupers, cusers, cforeign)
|
return (cmpy, csupers, cusers, cforeign)
|
||||||
dbtRowKey = (E.^. CompanyShorthand)
|
dbtRowKey = (E.^. CompanyShorthand)
|
||||||
dbtProj = dbtProjId
|
dbtProj = dbtProjId
|
||||||
dbtColonnade = dbColonnade $ mconcat
|
dbtColonnade = dbColonnade $ mconcat
|
||||||
[ if not isAdmin then mempty else dbSelect (applying _2) id (return . view (resultAllCompany . _companyShorthand))
|
[ -- if not isAdmin then mempty else dbSelect (applying _2) id (return . view (resultAllCompany . _companyShorthand))
|
||||||
, sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
|
sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
|
||||||
anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm
|
anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm
|
||||||
, sortable (Just "short") (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) ->
|
, sortable (Just "short") (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) ->
|
||||||
let fsh = companyShorthand firm
|
let fsh = companyShorthand firm
|
||||||
anchorCell (FirmR fsh) $ toWgt fsh
|
in anchorCell (FirmR fsh) $ toWgt fsh
|
||||||
, sortable (Just "nr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
|
, sortable (Just "nr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
|
||||||
let fsh = companyShorthand firm
|
anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
|
||||||
anchorCell (FirmR fsh) $ toWgt $ companyAvsId firm
|
|
||||||
, sortable Nothing (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr
|
, sortable Nothing (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr
|
||||||
, sortable Nothing (i18nCell MsgTableCompanyNrSupers) $ \(view resultAllCompanySupervisors -> nr) -> wgtCell $ word2widget nr
|
, sortable Nothing (i18nCell MsgTableCompanyNrSupers) $ \(view resultAllCompanySupervisors -> nr) -> wgtCell $ word2widget nr
|
||||||
, sortable Nothing (i18nCell MsgTableCompanyNrForeignSupers) $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr
|
, sortable Nothing (i18nCell MsgTableCompanyNrForeignSupers) $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr
|
||||||
|
|||||||
@ -42,7 +42,7 @@ import qualified Data.Set as Set
|
|||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Csv as Csv
|
import qualified Data.Csv as Csv
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.CaseInsensitive as CI
|
-- import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Conduit.List as C
|
import qualified Data.Conduit.List as C
|
||||||
import Database.Esqueleto.Experimental ((:&)(..))
|
import Database.Esqueleto.Experimental ((:&)(..))
|
||||||
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
|
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
|
||||||
@ -445,7 +445,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
|||||||
cmps <- selectList [] [] -- [Asc CompanyShorthand]
|
cmps <- selectList [] [] -- [Asc CompanyShorthand]
|
||||||
return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
|
return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
|
||||||
let
|
let
|
||||||
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
|
csvName = T.replace " " "-" $ ciOriginal (quali ^. _qualificationName)
|
||||||
dbtIdent :: Text
|
dbtIdent :: Text
|
||||||
dbtIdent = "lms"
|
dbtIdent = "lms"
|
||||||
dbtSQLQuery = lmsTableQuery now qid
|
dbtSQLQuery = lmsTableQuery now qid
|
||||||
@ -506,7 +506,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
|||||||
let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
|
let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
|
||||||
(E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
|
(E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
|
||||||
testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
|
testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
|
||||||
testcrit = maybe testname testnumber $ readMay $ CI.original criterion
|
testcrit = maybe testname testnumber $ readMay $ ciOriginal criterion
|
||||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.&&. testcrit
|
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.&&. testcrit
|
||||||
)
|
)
|
||||||
@ -637,14 +637,11 @@ postLmsR sid qsh = do
|
|||||||
, colUserNameModalHdr MsgLmsUser AdminUserR
|
, colUserNameModalHdr MsgLmsUser AdminUserR
|
||||||
, colUserEmail
|
, colUserEmail
|
||||||
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
|
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
|
||||||
let icnSuper = text2markup " " <> icon IconSupervisor
|
let cs = [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
|
||||||
cs = [ (cmpName, cmpSpr)
|
|
||||||
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
|
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
|
||||||
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
|
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
|
||||||
]
|
]
|
||||||
companies = intercalate (text2markup ", ") $
|
in intercalate spacerCell cs
|
||||||
(\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs
|
|
||||||
in wgtCell companies
|
|
||||||
, colUserMatriclenr
|
, colUserMatriclenr
|
||||||
-- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
|
-- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
|
||||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
|
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
|
||||||
|
|||||||
@ -586,14 +586,11 @@ postQualificationR sid qsh = do
|
|||||||
, colUserNameModalHdr MsgLmsUser linkUserName
|
, colUserNameModalHdr MsgLmsUser linkUserName
|
||||||
, colUserEmail
|
, colUserEmail
|
||||||
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
|
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
|
||||||
let icnSuper = text2markup " " <> icon IconSupervisor
|
let cs = [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
|
||||||
cs = [ (cmpName, cmpSpr)
|
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
|
||||||
| Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
|
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
|
||||||
, let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap
|
|
||||||
]
|
]
|
||||||
companies = intercalate (text2markup ", ") $
|
in intercalate spacerCell cs
|
||||||
(\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs
|
|
||||||
in wgtCell companies
|
|
||||||
, guardMonoid isAdmin colUserMatriclenr
|
, guardMonoid isAdmin colUserMatriclenr
|
||||||
-- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
|
-- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
|
||||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
|
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
|
||||||
|
|||||||
@ -106,11 +106,11 @@ postUsersR = do
|
|||||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
||||||
E.orderBy [E.asc (comp E.^. CompanyName)]
|
E.orderBy [E.asc (comp E.^. CompanyName)]
|
||||||
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||||
let companies = intersperse (text2markup ", ") $
|
let icnSuper = toWidget $ text2markup " " <> icon IconSupervisor
|
||||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
companies =
|
||||||
icnSuper = text2markup " " <> icon IconSupervisor
|
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||||
pure $ toWgt $ mconcat companies
|
pure $ intercalate (text2widget "; ") companies
|
||||||
, sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
, sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||||
(AdminUserR <$> encrypt uid)
|
(AdminUserR <$> encrypt uid)
|
||||||
(toWgt userCompanyPersonalNumber)
|
(toWgt userCompanyPersonalNumber)
|
||||||
|
|||||||
@ -307,6 +307,16 @@ courseCell Course{..} = anchorCell link name `mappend` desc
|
|||||||
^{modal "Beschreibung" (Right $ toWidget descr)}
|
^{modal "Beschreibung" (Right $ toWidget descr)}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
|
||||||
|
companyCell cid cname isSupervisor = anchorCell link name
|
||||||
|
where
|
||||||
|
link = FirmR cid
|
||||||
|
corg = ciOriginal cname
|
||||||
|
name
|
||||||
|
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
|
||||||
|
| otherwise = text2markup corg
|
||||||
|
|
||||||
|
|
||||||
qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
|
qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
|
||||||
qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
|
qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
|
||||||
where
|
where
|
||||||
|
|||||||
@ -305,6 +305,10 @@ tshowCrop = cropText . tshow
|
|||||||
stripCI :: Text -> CI Text
|
stripCI :: Text -> CI Text
|
||||||
stripCI = CI.mk . Text.strip
|
stripCI = CI.mk . Text.strip
|
||||||
|
|
||||||
|
-- | just to avoid adding an import for this
|
||||||
|
ciOriginal :: CI Text -> Text
|
||||||
|
ciOriginal = CI.original
|
||||||
|
|
||||||
citext2lower :: CI Text -> Text
|
citext2lower :: CI Text -> Text
|
||||||
citext2lower = Text.toLower . CI.original
|
citext2lower = Text.toLower . CI.original
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user