chore(avs): avs testpage shows JSON pandoc formatted

src/Handler/Admin/Avs.hs

@@ -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
+              Left  err -> return . Just $ text2widget $ tshow err
-              Right jsn -> return . Just $ tshow jsn
+              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
+              Left err  -> return . Just $ text2widget $ tshow err
-              Right jsn -> return . Just $ tshow jsn
+              Right jsn -> return . Just $ jsonToWidget jsn
       mbStatus <- formResultMaybe sresult procFormStatus
 
       ((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html ->

src/Handler/Utils/Pandoc.hs

@@ -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
+  }

templates/avs.hamlet

@@ -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}