From 617706b895b96c4838520e5fbcba7ee201bafc8e Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 29 Nov 2022 19:04:43 +0100 Subject: [PATCH] fix(build) --- src/Handler/Admin/Avs.hs | 83 +++++++++++++++++++++------------------- 1 file changed, 44 insertions(+), 39 deletions(-) diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index b438803cd..10704553a 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -4,7 +4,7 @@ module Handler.Admin.Avs ( getAdminAvsR - , postAdminAvsR + , postAdminAvsR ) where import Import @@ -28,7 +28,7 @@ nullaryPathPiece ''ButtonAvsTest camelToPathPiece instance Button UniWorX ButtonAvsTest where btnLabel BtnCheckLicences = "Check all licences" -- could be msg - btnClasses BtnCheckLicences = [BCIsButton, BCPrimary] + btnClasses BtnCheckLicences = [BCIsButton, BCPrimary] -- END Button @@ -36,16 +36,17 @@ avsCardNoField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field avsCardNoField = convertField AvsCardNo avsCardNo textField makeAvsPersonForm :: Maybe AvsQueryPerson -> Form AvsQueryPerson -makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html -> - flip (renderAForm FormStandard) html $ AvsQueryPerson +makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html -> + flip (renderAForm FormStandard) html $ AvsQueryPerson <$> aopt avsCardNoField (fslI MsgAvsCardNo) (avsPersonQueryCardNo <$> tmpl) + <*> aopt textField (fslI MsgAvsVersionNo) (avsPersonQueryVersionNo <$> tmpl) <*> aopt textField (fslI MsgAvsFirstName) (avsPersonQueryFirstName <$> tmpl) <*> aopt textField (fslI MsgAvsLastName) (avsPersonQueryLastName <$> tmpl) <*> aopt textField (fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo <$> tmpl) - <*> aopt textField (fslI MsgAvsVersionNo) (avsPersonQueryVersionNo <$> tmpl) + validateAvsQueryPerson :: FormValidator AvsQueryPerson Handler () -validateAvsQueryPerson = do +validateAvsQueryPerson = do AvsQueryPerson{..} <- State.get guardValidation MsgAvsQueryEmpty $ is _Just avsPersonQueryCardNo || @@ -55,31 +56,31 @@ validateAvsQueryPerson = do is _Just avsPersonQueryVersionNo makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus -makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> +makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> flip (renderAForm FormStandard) html $ parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) where parseAvsIds :: Text -> AvsQueryStatus parseAvsIds txt = AvsQueryStatus $ Set.fromList ids - where - nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt + where + nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt ids = catMaybes $ readMay <$> nonemptys - unparseAvsIds :: AvsQueryStatus -> Text - unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids + unparseAvsIds :: AvsQueryStatus -> Text + unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler () -validateAvsQueryStatus = do +validateAvsQueryStatus = do AvsQueryStatus ids <- State.get guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids) avsLicenceOptions :: OptionList AvsLicence -avsLicenceOptions = mkOptionList - [ Option +avsLicenceOptions = mkOptionList + [ Option { optionDisplay = Text.singleton $ licence2char l , optionInternalValue = l , optionExternalValue = toJsonText l - } + } | l <- universeF ] @@ -92,27 +93,30 @@ postAdminAvsR = do Just AvsQuery{..} -> do ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing - let procFormPerson fr = do + let procFormPerson fr = do + addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr) res <- avsQueryPerson fr - case res of - Left err -> return . Just $ tshow err + case res of + Left err -> return . Just $ tshow err Right jsn -> return . Just $ tshow jsn mbPerson <- formResultMaybe presult procFormPerson ((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing - let procFormStatus fr = do + let procFormStatus fr = do + addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr) res <- avsQueryStatus fr - case res of - Left err -> return . Just $ tshow err - Right jsn -> return . Just $ tshow jsn + case res of + Left err -> return . Just $ tshow err + Right jsn -> return . Just $ tshow jsn mbStatus <- formResultMaybe sresult procFormStatus - ((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html -> + ((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html -> flip (renderAForm FormStandard) html $ areq textField (fslI MsgAvsCardNo) Nothing - let procFormCrUsr fr = do + let procFormCrUsr fr = do + addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr) res <- try $ upsertAvsUser fr - case res of - (Right (Just uid)) -> do + case res of + (Right (Just uid)) -> do uuid :: CryptoUUIDUser <- encrypt uid return $ Just [whamlet|

Success:

User created or updated.|] (Right Nothing) -> @@ -122,12 +126,13 @@ postAdminAvsR = do return $ Just [whamlet|

Error:

#{msg}|] mbCrUser <- formResultMaybe crUsrRes procFormCrUsr - ((getLicRes, getLicWgt), getLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicence $ \html -> + ((getLicRes, getLicWgt), getLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicence $ \html -> flip (renderAForm FormStandard) html $ areq intField (fslI MsgAvsPersonId) Nothing - let procFormGetLic fr = do + let procFormGetLic fr = do + addMessage Info $ text2Html $ "Query: " <> tshow (toJSON (AvsPersonId fr)) res <- try $ getLicenceByAvsId $ AvsPersonId fr - case res of - (Right (Just lic)) -> + case res of + (Right (Just lic)) -> return $ Just [whamlet|

Success:

Licence #{tshow lic}|] (Right Nothing) -> return $ Just [whamlet|

Warning:

User not found.|] @@ -136,13 +141,13 @@ postAdminAvsR = do return $ Just [whamlet|

Error:

#{msg}|] mbGetLic <- formResultMaybe getLicRes procFormGetLic - ((setLicRes, setLicWgt), setLicEnctype) <- runFormPost $ identifyForm FIDAvsSetLicence $ \html -> - flip (renderAForm FormStandard) html $ (,) <$> areq intField (fslI MsgAvsPersonId) Nothing + ((setLicRes, setLicWgt), setLicEnctype) <- runFormPost $ identifyForm FIDAvsSetLicence $ \html -> + flip (renderAForm FormStandard) html $ (,) <$> areq intField (fslI MsgAvsPersonId) Nothing <*> areq (selectField $ return avsLicenceOptions) (fslI MsgAvsLicence) (Just AvsLicenceVorfeld) - let procFormSetLic (aid, lic) = do + let procFormSetLic (aid, lic) = do res <- try $ setLicenceAvs (AvsPersonId aid) lic - case res of - (Right True) -> + case res of + (Right True) -> return $ Just [whamlet|

Success:

Licence #{tshow (licence2char lic)} set for #{tshow aid}.|] (Right False) -> return $ Just [whamlet|

Error:

Licence could not be set for #{tshow aid}.|] @@ -153,10 +158,10 @@ postAdminAvsR = do ((qryLicRes, qryLicWgt), qryLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicenceDiffs (buttonForm :: Form ButtonAvsTest) - let procFormQryLic BtnCheckLicences = do + let procFormQryLic BtnCheckLicences = do res <- try checkLicences - case res of - (Right True) -> + case res of + (Right True) -> return $ Just [whamlet|

Success:

Licences sychronized.|] (Right False) -> return $ Just [whamlet|

Error:

Licences could not be synchronized, see error log.|] @@ -176,4 +181,4 @@ postAdminAvsR = do setLicForm = wrapFormHere setLicWgt setLicEnctype qryLicForm = wrapForm qryLicWgt def { formAction = Just $ SomeRoute actionUrl, formEncoding = qryLicEnctype, formSubmit = FormNoSubmit } -- TODO: use i18nWidgetFile instead if this is to become permanent - $(widgetFile "avs") + $(widgetFile "avs")