fix(avs): fix #152 by providing new online avs card filter throughout
This commit is contained in:
parent
ef36e22f76
commit
ad2375b338
@ -499,13 +499,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.&&. testcrit
|
||||
)
|
||||
, single ("avs-card" , FilterColumn $ \(queryUser -> user) (criterion :: Set.Set Text) -> case readAvsFullCardNo =<< Set.lookupMin criterion of
|
||||
Nothing -> E.false
|
||||
Just cardNo -> E.exists $ E.from $ \(avsCard `E.InnerJoin` usrAvs) -> do
|
||||
E.on $ usrAvs E.^. UserAvsPersonId E.==. avsCard E.^. UserAvsCardPersonId
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo)
|
||||
)
|
||||
, fltrAVSCardNos queryUser
|
||||
, single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if
|
||||
| Set.null criteria -> E.true
|
||||
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
|
||||
@ -515,7 +509,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev
|
||||
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
||||
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
|
||||
, prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo)
|
||||
, fltrAVSCardNosUI mPrev
|
||||
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
|
||||
, prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
|
||||
|
||||
@ -18,8 +18,6 @@ import Import
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Users
|
||||
import Handler.Utils.LMS
|
||||
import Handler.Utils.Avs (queryAvsCardNos)
|
||||
import Handler.Utils.Concurrent
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
@ -405,34 +403,13 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
-- , single ("validity", SortColumn $ queryQualUser >>> validQualification now)
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail queryUser
|
||||
[ single $ fltrUserNameEmail queryUser
|
||||
, single ("avs-number" , FilterColumn . E.mkExistsFilter $ \row criterion ->
|
||||
E.from $ \usrAvs -> -- do
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. queryUser row E.^. UserId
|
||||
E.&&. ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
|
||||
(E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) ))
|
||||
-- , single ("avs-card" , FilterColumn $ \(queryUser -> user) (criterion :: Set.Set Text) -> case readAvsFullCardNo =<< Set.lookupMin criterion of
|
||||
-- Nothing -> E.false
|
||||
-- Just cardNo -> E.exists $ E.from $ \(avsCard `E.InnerJoin` usrAvs) -> do
|
||||
-- E.on $ usrAvs E.^. UserAvsPersonId E.==. avsCard E.^. UserAvsCardPersonId
|
||||
-- E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
-- E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo)
|
||||
-- )
|
||||
, single ("avs-card" , FilterColumnHandler $ \case
|
||||
[] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool))
|
||||
cs -> do
|
||||
let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs
|
||||
toutsecs <- getsYesod $ preview $ _appAvsConf . _Just . _avsTimeout
|
||||
maybeTimeoutHandler toutsecs (queryAvsCardNos crds) >>= \case
|
||||
Nothing -> addMessageI Error MsgAvsCommunicationTimeout
|
||||
>> return (const E.false)
|
||||
(Just (null -> True)) -> return (const E.false)
|
||||
(Just apids) -> return $
|
||||
\(queryUser -> user) ->
|
||||
E.exists $ E.from $ \usrAvs ->
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
E.&&. usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids
|
||||
)
|
||||
, fltrAVSCardNos queryUser
|
||||
, single ("personal-number", FilterColumn $ \(queryUser -> user) (criteria :: Set.Set Text) -> if
|
||||
| Set.null criteria -> E.true
|
||||
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
|
||||
@ -463,7 +440,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev
|
||||
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
||||
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
|
||||
, prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo & setTooltip (SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]))
|
||||
, fltrAVSCardNosUI mPrev
|
||||
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
|
||||
, if isNothing mbRenewal then mempty
|
||||
|
||||
@ -8,6 +8,8 @@ module Handler.Utils.Table.Columns where
|
||||
|
||||
import Import hiding (link)
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E hiding ((->.))
|
||||
import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, mkContainsFilterWithComma, mkContainsFilterWithCommaPlus, anyFilter)
|
||||
@ -21,6 +23,8 @@ import Handler.Utils.Form
|
||||
import Handler.Utils.Widgets
|
||||
import Handler.Utils.DateTime
|
||||
import Handler.Utils.StudyFeatures
|
||||
import Handler.Utils.Avs (queryAvsCardNos)
|
||||
import Handler.Utils.Concurrent
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
@ -801,6 +805,37 @@ fltrCompanyNameNrHdrUI msg mPrev =
|
||||
prismAForm (singletonFilter "company-name-number") mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaNameNr)
|
||||
|
||||
|
||||
---------
|
||||
-- AVS --
|
||||
---------
|
||||
|
||||
|
||||
fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k)
|
||||
=> (a -> E.SqlExpr (Entity User)) -> Map k (FilterColumn t fs)
|
||||
fltrAVSCardNos queryUser = Map.singleton "avs-card" fch
|
||||
where
|
||||
fch = FilterColumnHandler $ \case
|
||||
[] -> return (const E.true)
|
||||
cs -> do
|
||||
let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs
|
||||
toutsecs <- getsYesod $ preview $ _appAvsConf . _Just . _avsTimeout
|
||||
maybeTimeoutHandler toutsecs (queryAvsCardNos crds) >>= \case
|
||||
Nothing -> addMessageI Error MsgAvsCommunicationTimeout
|
||||
>> return (const E.false)
|
||||
(Just (null -> True)) -> return (const E.false)
|
||||
(Just apids) -> return $
|
||||
\(queryUser -> user) ->
|
||||
E.exists $ E.from $ \usrAvs ->
|
||||
E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId
|
||||
E.&&. usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids
|
||||
|
||||
fltrAVSCardNosUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
|
||||
fltrAVSCardNosUI mPrev =
|
||||
prismAForm (singletonFilter "avs-card" ) mPrev $
|
||||
aopt textField (fslI MsgAvsCardNo & setTooltip (SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]))
|
||||
|
||||
|
||||
|
||||
----------------------------
|
||||
-- Colonnade manipulation --
|
||||
----------------------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user