91 lines
3.7 KiB
Haskell
91 lines
3.7 KiB
Haskell
module Handler.Admin.Avs
|
|
( getAdminAvsR
|
|
, postAdminAvsR
|
|
) where
|
|
|
|
import Import
|
|
import qualified Control.Monad.State.Class as State
|
|
-- import Data.Aeson (encode)
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Set as Set
|
|
|
|
import Handler.Utils
|
|
|
|
import Utils.Avs
|
|
|
|
|
|
makeAvsPersonForm :: Maybe AvsQueryPerson -> Form AvsQueryPerson
|
|
makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html ->
|
|
flip (renderAForm FormStandard) html $ AvsQueryPerson
|
|
<$> aopt textField (fslI MsgAvsCardNo) (avsPersonQueryCardNo <$> 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
|
|
AvsQueryPerson{..} <- State.get
|
|
guardValidation MsgAvsQueryEmpty $
|
|
is _Just avsPersonQueryCardNo ||
|
|
is _Just avsPersonQueryFirstName ||
|
|
is _Just avsPersonQueryLastName ||
|
|
is _Just avsPersonQueryInternalPersonalNo ||
|
|
is _Just avsPersonQueryVersionNo
|
|
|
|
makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus
|
|
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
|
|
ids = catMaybes $ readMay <$> nonemptys
|
|
unparseAvsIds :: AvsQueryStatus -> Text
|
|
unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids
|
|
|
|
validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler ()
|
|
validateAvsQueryStatus = do
|
|
AvsQueryStatus ids <- State.get
|
|
guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids)
|
|
|
|
getAdminAvsR, postAdminAvsR :: Handler Html
|
|
getAdminAvsR = postAdminAvsR
|
|
postAdminAvsR = do
|
|
mAvsQuery <- getsYesod $ view _appAvsQuery
|
|
case mAvsQuery of
|
|
Nothing -> return mempty
|
|
Just AvsQuery{..} -> do
|
|
((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
|
|
|
|
let procFormPerson fr = do
|
|
res <- avsQueryPerson fr
|
|
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
|
|
res <- avsQueryStatus fr
|
|
case res of
|
|
Left err -> return . Just $ tshow err
|
|
Right jsn -> return . Just $ tshow jsn
|
|
mbStatus <- formResultMaybe sresult procFormStatus
|
|
|
|
actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
|
|
siteLayoutMsg MsgMenuAvs $ do
|
|
setTitleI MsgMenuAvs
|
|
let personForm = wrapForm pwidget def
|
|
{ formAction = Just $ SomeRoute actionUrl
|
|
, formEncoding = penctype
|
|
}
|
|
statusForm = wrapForm swidget def
|
|
{ formAction = Just $ SomeRoute actionUrl
|
|
, formEncoding = senctype
|
|
}
|
|
-- TODO: use i18nWidgetFile instead if this is to become permanent
|
|
$(widgetFile "avs")
|