diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 3cb709b6f..886ffa010 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -87,7 +87,7 @@ validateAvsQueryPerson = do makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> flip (renderAForm FormStandard) html $ - parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) + parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) where parseAvsIds :: Text -> AvsQueryStatus parseAvsIds txt = AvsQueryStatus $ Set.fromList ids @@ -102,6 +102,25 @@ validateAvsQueryStatus = do AvsQueryStatus ids <- State.get guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids) +makeAvsContactForm :: Maybe AvsQueryContact -> Form AvsQueryContact +makeAvsContactForm tmpl = identifyForm FIDAvsQueryContact . validateForm validateAvsQueryContact $ \html -> + flip (renderAForm FormStandard) html $ + parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) -- consider using cfAnySeparatedSet here + where + parseAvsIds :: Text -> AvsQueryContact + parseAvsIds txt = AvsQueryContact $ Set.fromList ids + where + nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt + ids = catMaybes $ fmap AvsObjPersonId . readMay <$> nonemptys + unparseAvsIds :: AvsQueryContact -> Text + unparseAvsIds (AvsQueryContact ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids + +validateAvsQueryContact :: FormValidator AvsQueryContact Handler () +validateAvsQueryContact = do + AvsQueryContact ids <- State.get + guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids) + + avsLicenceOptions :: OptionList AvsLicence avsLicenceOptions = mkOptionList [ Option @@ -142,7 +161,7 @@ postAdminAvsR = do ((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing let procFormStatus fr = do - addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr) + addMessage Info $ text2Html $ "Status Query: " <> tshow (toJSON fr) res <- avsQueryStatus fr case res of Left err -> let msg = tshow err in return $ Just [whamlet|

Error:

#{msg}|] @@ -153,6 +172,20 @@ postAdminAvsR = do |] mbStatus <- formResultMaybe sresult procFormStatus + ((cresult, cwidget), cenctype) <- runFormPost $ makeAvsContactForm Nothing + let procFormContact fr = do + addMessage Info $ text2Html $ "Contact Query: " <> tshow (toJSON fr) + res <- avsQueryContact fr + case res of + Left err -> let msg = tshow err in return $ Just [whamlet|

Error:

#{msg}|] + Right (AvsResponseContact pns) -> return $ Just [whamlet| +