chore(firm): add firm-all filters and code cleaning
This commit is contained in:
parent
dfa03f8ba8
commit
a28786412e
@ -75,6 +75,7 @@ TableExamOfficeLabelStatus: Label-Farbe
|
||||
TableExamOfficeLabelPriority: Label-Priorität
|
||||
TableQualifications: Qualifikationen
|
||||
TableCompany: Firma
|
||||
TableCompanyFilter: Firma oder Nummer
|
||||
TableCompanyShort: Firmenkürzel
|
||||
TableCompanies: Firmen
|
||||
TableCompanyNo: Firmennummer
|
||||
|
||||
@ -75,6 +75,7 @@ TableExamOfficeLabelStatus: Label colour
|
||||
TableExamOfficeLabelPriority: Label priority
|
||||
TableQualifications: Qualifications
|
||||
TableCompany: Company
|
||||
TableCompanyFilter: Company/Nr
|
||||
TableCompanyShort: Company shorthand
|
||||
TableCompanies: Companies
|
||||
TableCompanyNo: Company number
|
||||
|
||||
2
routes
2
routes
@ -113,7 +113,7 @@
|
||||
/for/#CryptoUUIDUser/user ForProfileR GET POST !supervisor !self
|
||||
/for/#CryptoUUIDUser/user/profile ForProfileDataR GET !supervisor !self
|
||||
|
||||
/firm FirmAllR GET
|
||||
/firm FirmAllR GET POST
|
||||
/firm/#CompanyShorthand FirmR GET POST
|
||||
/firm/#CompanyShorthand/users FirmUsersR GET POST
|
||||
/firm/#CompanyShorthand/supers FirmSupersR GET POST
|
||||
|
||||
@ -46,6 +46,7 @@ module Database.Esqueleto.Utils
|
||||
, subSelectCountDistinct
|
||||
, selectCountRows, selectCountDistinct
|
||||
, selectMaybe
|
||||
, num2text
|
||||
, day, day', dayMaybe, interval, diffDays, diffTimes
|
||||
, exprLift
|
||||
, explicitUnsafeCoerceSqlExprValue
|
||||
@ -656,10 +657,14 @@ selectCountDistinct q = do
|
||||
selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r)
|
||||
selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
|
||||
|
||||
-- | cast numeric type to text, which is safe and allows for an inefficient but safe comparison of numbers stored as text and numbers
|
||||
num2text :: Num n => E.SqlExpr (E.Value n) -> E.SqlExpr (E.Value Text)
|
||||
num2text = E.unsafeSqlCastAs "text"
|
||||
|
||||
day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
|
||||
day = E.unsafeSqlCastAs "date"
|
||||
|
||||
-- | cast text to day, truly unsafe
|
||||
day' :: E.SqlExpr (E.Value Text) -> E.SqlExpr (E.Value Day)
|
||||
day' = E.unsafeSqlCastAs "date"
|
||||
|
||||
|
||||
@ -19,11 +19,11 @@ import Import
|
||||
-- import Jobs
|
||||
import Handler.Utils
|
||||
|
||||
-- import qualified Data.Set as Set
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
-- import qualified Data.Csv as Csv
|
||||
-- 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 Database.Persist.Sql (updateWhereCount)
|
||||
import Database.Esqueleto.Experimental ((:&)(..))
|
||||
@ -35,8 +35,8 @@ import Database.Esqueleto.Utils.TH
|
||||
|
||||
|
||||
-- avoids repetition of local definitions
|
||||
-- single :: (k,a) -> Map k a
|
||||
-- single = uncurry Map.singleton
|
||||
single :: (k,a) -> Map k a
|
||||
single = uncurry Map.singleton
|
||||
|
||||
|
||||
getFirmR, postFirmR :: CompanyShorthand -> Handler Html
|
||||
@ -106,6 +106,10 @@ data FirmAllActionData = FirmAllActNotifyData
|
||||
| FirmAllActResetSupervisionData
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
|
||||
-- just in case for future extensions
|
||||
type AllCompanyTableExpr = E.SqlExpr (Entity Company)
|
||||
queryCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
|
||||
queryCompany = id
|
||||
|
||||
type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64)
|
||||
resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company)
|
||||
@ -184,14 +188,7 @@ firmCountActiveReroutes' cmpy = E.subSelectCount $ do
|
||||
E.&&. usrSuper E.^. UserSupervisorRerouteNotifications
|
||||
|
||||
|
||||
mkFirmAllTable ::
|
||||
-- ( Functor h, ToSortable h
|
||||
-- , AsCornice h p FirmAllActionData
|
||||
-- (DBCell (MForm Handler)
|
||||
-- (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
|
||||
-- ) cols
|
||||
-- ) =>
|
||||
Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
|
||||
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
|
||||
mkFirmAllTable isAdmin uid = do
|
||||
-- now <- liftIO getCurrentTime
|
||||
let
|
||||
@ -214,48 +211,14 @@ mkFirmAllTable isAdmin uid = do
|
||||
dbtProj = dbtProjId
|
||||
dbtColonnade = formColonnade $
|
||||
mconcat
|
||||
[ -- if not isAdmin then mempty else -- guardOnM idAdmin $
|
||||
{- hole :: (x -> f x) -> r -> f r
|
||||
(FormResult
|
||||
(DBFormResult (Key Company) Bool (DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64))
|
||||
)
|
||||
-> f (FormResult
|
||||
(DBFormResult
|
||||
(Key Company)
|
||||
Bool
|
||||
(DBRow
|
||||
(Entity Company, E.Value Word64, E.Value Word64, E.Value Word64,
|
||||
E.Value Word64, E.Value Word64, E.Value Word64)))))
|
||||
-> FormResult
|
||||
(First FirmAllActionData,
|
||||
DBFormResult CompanyId Bool FirmAllActionData)
|
||||
-> f (FormResult
|
||||
(First FirmAllActionData,
|
||||
DBFormResult CompanyId Bool FirmAllActionData))
|
||||
|
||||
-------
|
||||
|
||||
( (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData))
|
||||
-> f (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData))
|
||||
)
|
||||
-> (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
|
||||
-> f (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
|
||||
|
||||
------
|
||||
Lens' (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData))
|
||||
(FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
|
||||
------
|
||||
Lens' (FormResult (Map (Key Company) (AllCompanyTableData,Bool -> Bool)))
|
||||
(FormResult (First FirmAllActionData, (Map (CompanyId) (FirmAllActionData ,Bool -> Bool))))
|
||||
-- applying bringt uns unter das FormResult
|
||||
-}
|
||||
[ if not isAdmin then mempty else -- guardOnM idAdmin $
|
||||
dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
|
||||
, sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
|
||||
, sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> 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
|
||||
in anchorCell (FirmR fsh) $ toWgt fsh
|
||||
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
|
||||
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
|
||||
anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
|
||||
, sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \(view resultAllCompanySupervisors -> nr) -> wgtCell $ word2widget nr
|
||||
@ -276,10 +239,21 @@ mkFirmAllTable isAdmin uid = do
|
||||
, singletonMap "reroute-all" $ SortColumn firmCountActiveReroutes'
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[
|
||||
[ single $ fltrCompanyNameNr queryCompany
|
||||
, single ("is-supervisor", FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
|
||||
(usr :& usrCmp) <- E.from $ E.table @User
|
||||
`E.innerJoin` E.table @UserCompany
|
||||
`E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser)
|
||||
E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryCompany row E.^. CompanyId
|
||||
E.&&. ( (usr E.^. UserDisplayName `E.hasInfix` E.val criterion)
|
||||
E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk criterion))
|
||||
E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion)
|
||||
)
|
||||
)
|
||||
]
|
||||
dbtFilterUI = mconcat
|
||||
[
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrCompanyNameNrUI mPrev
|
||||
, prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
|
||||
]
|
||||
dbtStyle = def -- { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
|
||||
@ -293,8 +267,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional
|
||||
= renderAForm FormStandard
|
||||
$ (, mempty) . First . Just
|
||||
= renderAForm FormStandard $ (, mempty) . First . Just
|
||||
<$> multiActionA acts (fslI MsgTableAction) Nothing
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
@ -313,7 +286,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap
|
||||
return (act, cmpSet)
|
||||
|
||||
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)) -- This type signature is not optional!
|
||||
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
|
||||
resultDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "short"]
|
||||
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
|
||||
|
||||
@ -504,8 +504,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional
|
||||
= renderAForm FormStandard
|
||||
$ (, mempty) . First . Just
|
||||
= renderAForm FormStandard $ (, mempty) . First . Just
|
||||
<$> multiActionA acts (fslI MsgTableAction) Nothing
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
|
||||
@ -753,6 +753,25 @@ sortUserCompany queryUser = ( "user-company"
|
||||
return (comp E.^. CompanyName)
|
||||
))
|
||||
|
||||
-- | Search companies by name, shorthand oder AVS nr
|
||||
fltrCompanyNameNr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
|
||||
=> (a -> E.SqlExpr (Entity Company))
|
||||
-> (d, FilterColumn t fs)
|
||||
fltrCompanyNameNr query = ( "company-name-number", FilterColumn $ anyFilter
|
||||
[ mkContainsFilterWithCommaPlus CI.mk $ query >>> (E.^. CompanyName)
|
||||
, mkContainsFilterWithCommaPlus CI.mk $ query >>> (E.^. CompanyShorthand)
|
||||
, mkContainsFilterWithCommaPlus id $ query >>> (E.num2text . (E.^. CompanyAvsId))
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
fltrCompanyNameNrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrCompanyNameNrUI = fltrCompanyNameNrHdrUI MsgTableCompanyFilter
|
||||
|
||||
fltrCompanyNameNrHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrCompanyNameNrHdrUI msg mPrev =
|
||||
prismAForm (singletonFilter "company-name-number") mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaPlus)
|
||||
|
||||
|
||||
----------------------------
|
||||
-- Colonnade manipulation --
|
||||
|
||||
Loading…
Reference in New Issue
Block a user