124 lines
4.7 KiB
Haskell
124 lines
4.7 KiB
Haskell
{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only
|
|
|
|
module Handler.Admin.Apc
|
|
( getAdminApcR
|
|
, postAdminApcR
|
|
) where
|
|
|
|
import Import
|
|
import qualified Text.Pandoc as P
|
|
import qualified Text.Pandoc.Builder as P
|
|
-- import Utils.Print
|
|
-- 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
|
|
|
|
data MetaPinRenewal = MetaPinRenewal
|
|
{ mppOpening :: Maybe Text
|
|
, mppClosing :: Maybe Text
|
|
, mppDate :: Maybe Text
|
|
, mppURL :: Maybe Text
|
|
, mppLogin :: Text
|
|
, mppPin :: Text
|
|
, mppRecipient :: Text
|
|
, mppAddress :: [Text]
|
|
, mppLang :: Text
|
|
, mppIsDe :: Bool
|
|
}
|
|
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
|
|
|
formToMetaValues :: MetaPinRenewal -> P.Meta
|
|
formToMetaValues MetaPinRenewal{..} = P.Meta . mconcat $ catMaybes
|
|
[ toMeta "opening" <$> mppOpening
|
|
, toMeta "closing" <$> mppClosing
|
|
, toMeta "date" <$> mppDate
|
|
, toMeta "url" <$> mppURL
|
|
, toMeta "login" mppLogin & pure
|
|
, toMeta "pin" mppPin & pure
|
|
, toMeta "recipient" mppRecipient & pure
|
|
, toMeta "address" mppAddress & pure
|
|
, toMeta "lang" mppLang & pure
|
|
, toMeta "is-de" mppIsDe & pure
|
|
]
|
|
where
|
|
toMeta k = singletonMap k . P.toMetaValue
|
|
|
|
{-
|
|
makePrintForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal
|
|
makePrintForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html ->
|
|
flip (renderAForm FormStandard) html $ MetaPinRenewal
|
|
<$> aopt textField (fslI MsgMppOpening) (mppOpening <$> tmpl)
|
|
<*> aopt textField (fslI MsgMppClosing) (mppClosing <$> tmpl)
|
|
<*> aopt textField (fslI MsgMppDate) (mppDate <$> tmpl)
|
|
<*> aopt textField (fslI MsgMppURL) (mppURL <$> tmpl)
|
|
<*> aopt textField (fslI MsgMppnNo) (mppRecipient <$> tmpl)
|
|
|
|
validateMetaPinReneqal :: FormValidator MetaPinRenewal Handler ()
|
|
validateMetaPinReneqal = do
|
|
AvsQueryPeMetaPinRenewalate.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 MsgAvsCardNo) (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)
|
|
-}
|
|
getAdminApcR, postAdminApcR :: Handler Html
|
|
getAdminApcR = postAdminApcR
|
|
postAdminApcR = do
|
|
{-
|
|
((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
|
|
let procFormPerson fr = do
|
|
res <- runAvsPersonSearch fr
|
|
case res of
|
|
Left err -> return $ Just err
|
|
Right jsn -> return $ Just $ tshow jsn
|
|
mbPerson <- formResultMaybe presult procFormPerson
|
|
|
|
((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing
|
|
let procFormStatus fr = do
|
|
res <- runAvsStatusSearch fr
|
|
case res of
|
|
Left err -> return $ Just err
|
|
Right jsn -> return $ Just $ tshow jsn
|
|
mbStatus <- formResultMaybe sresult procFormStatus
|
|
-}
|
|
-- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
|
|
siteLayoutMsg MsgMenuAvs $ do
|
|
setTitleI MsgMenuApc
|
|
{-
|
|
let personForm = wrapForm pwidget def
|
|
{ formAction = Just $ SomeRoute actionUrl
|
|
, formEncoding = penctype
|
|
}
|
|
statusForm = wrapForm swidget def
|
|
{ formAction = Just $ SomeRoute actionUrl
|
|
, formEncoding = senctype
|
|
}
|
|
-}
|
|
let personForm = [whamlet|TODO|]
|
|
mbPerson = Just ("Not yet implemented"::Text)
|
|
-- TODO: use i18nWidgetFile instead if this is to become permanent
|
|
$(widgetFile "apc")
|