This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Admin/Avs.hs
2022-06-27 16:50:29 +02:00

77 lines
3.2 KiB
Haskell

module Handler.Admin.Avs
( getAdminAvsR
, postAdminAvsR
) where
import Import
import qualified Control.Monad.State.Class as State
-- import Data.Aeson (encode)
import Handler.Utils
import Handler.Utils.Servant.Avs
makeAvsPersonForm :: Maybe AvsPersonQuery -> Form AvsPersonQuery
makeAvsPersonForm tmpl = identifyForm FIDAvsPersonQuery . validateForm validateAvsPersonQuery $ \html ->
flip (renderAForm FormStandard) html $ AvsPersonQuery
<$> 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)
validateAvsPersonQuery :: FormValidator AvsPersonQuery Handler ()
validateAvsPersonQuery = do
AvsPersonQuery{..} <- State.get
guardValidation MsgAvsQueryEmpty $
is _Just avsPersonQueryCardNo ||
is _Just avsPersonQueryFirstName ||
is _Just avsPersonQueryLastName ||
is _Just avsPersonQueryInternalPersonalNo ||
is _Just avsPersonQueryVersionNo
{-
makeAvsForm :: Maybe AvsStatusQuery -> Form AvsStatusQuery
makeAvsForm tmpl = identifyForm FIDAvsStatusQuery . validateForm validateAvsStatusQuery $ \html ->
flip (renderAForm FormStandard) html $ AvsStatusQuery
<$> 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)
validateAvsPersonQuery :: FormValidator AvsPersonQuery Handler ()
validateAvsPersonQuery = do
AvsPersonQuery{..} <- State.get
guardValidation MsgAvsQueryEmpty $
is _Just avsPersonQueryCardNo ||
is _Just avsPersonQueryFirstName ||
is _Just avsPersonQueryLastName ||
is _Just avsPersonQueryInternalPersonalNo ||
is _Just avsPersonQueryVersionNo
-}
getAdminAvsR, postAdminAvsR :: Handler Html
getAdminAvsR = postAdminAvsR
postAdminAvsR = do
((result,widget), enctype) <- runFormPost $ makeAvsPersonForm Nothing
let procForm fr = do
res <- runAvsPersonSearch fr
case res of
Left err -> return $ Just err
Right jsn -> return $ Just $ tshow jsn
mbAnswer <- formResultMaybe result procForm
actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
siteLayoutMsg MsgMenuAvs $ do
setTitleI MsgMenuAvs
let formWidget = wrapForm widget def
{ formAction = Just $ SomeRoute actionUrl
, formEncoding = enctype
}
-- TODO: use i18nWidgetFile instead if this is to become permanent
$(widgetFile "avs")