fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): avs testpage shows JSON pandoc formatted

Browse Source
This commit is contained in:
Steffen Jost 2022-12-12 16:46:22 +01:00
parent f352eca7e7
commit 1216bc0f2f
3 changed files with 28 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Handler/Admin/Avs.hs
View File

@ -90,6 +90,13 @@ avsLicenceOptions = mkOptionList
| l <- universeF
]
jsonToWidget :: ToJSON a => a -> Widget
jsonToWidget x =
case jsonToHtml jsonReaderOptions htmlWriterOptions $ tshow $ toJSON x of
Left err -> msg2widget err
Right html -> toWgt html
getAdminAvsR, postAdminAvsR :: Handler Html
getAdminAvsR = postAdminAvsR
postAdminAvsR = do
@ -103,8 +110,8 @@ postAdminAvsR = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
res <- avsQueryPerson fr
case res of
Left err -> return . Just $ tshow err
Right jsn -> return . Just $ tshow jsn
Left err -> return . Just $ text2widget $ tshow err
Right jsn -> return . Just $ jsonToWidget jsn
mbPerson <- formResultMaybe presult procFormPerson
((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing
@ -112,8 +119,8 @@ postAdminAvsR = 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
Left err -> return . Just $ text2widget $ tshow err
Right jsn -> return . Just $ jsonToWidget jsn
mbStatus <- formResultMaybe sresult procFormStatus
((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html ->

15
src/Handler/Utils/Pandoc.hs
View File

@ -7,6 +7,8 @@ module Handler.Utils.Pandoc
, renderMarkdownWith, parseMarkdownWith
, htmlReaderOptions, markdownReaderOptions
, markdownWriterOptions, htmlWriterOptions
, jsonToHtml
, jsonReaderOptions
) where
import Import.NoFoundation
@ -103,3 +105,16 @@ markdownWriterOptions = def
, P.writerTabStop = P.readerTabStop markdownReaderOptions
}
htmlWriterOptions = markdownWriterOptions
jsonToHtml :: P.ReaderOptions -> P.WriterOptions -> Text -> Either (SomeMessage site) Html
jsonToHtml readerOptions writerOptions text =
bimap pandocError (preEscapedText . sanitizeBalance) . P.runPure $
P.writeHtml5String writerOptions =<< P.readJSON readerOptions text
where
pandocError = SomeMessage . tshow
jsonReaderOptions :: P.ReaderOptions
jsonReaderOptions = def
{ P.readerExtensions = P.pandocExtensions
, P.readerTabStop = 2
}

4
templates/avs.hamlet
View File

@ -43,7 +43,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe answer <- mbPerson
<p>
Unverarbeitete Antwort: #
#{answer}
^{answer}
<section>
<p>
@ -52,4 +52,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe answer <- mbStatus
<p>
Unverarbeitete Antwort: #
#{answer}
^{answer}