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

chore(json): generic json to widget function for pretty printing

Browse Source
This commit is contained in:
Steffen Jost 2023-04-03 09:27:43 +00:00
parent b0c211da65
commit 97abc47cdf
3 changed files with 49 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -654,21 +654,30 @@ getAdminAvsUserR uuid = do
Es erfolgte damit aber noch kein Update der FRADrive Daten. Es erfolgte damit aber noch kein Update der FRADrive Daten.
<p> <p>
<dl .deflist> <dl .deflist>
<dt .deflist__dt>Info Person Contact <br> <dt .deflist__dt>InfoPersonContact <br>
<i>(bevorzugt) <i>(bevorzugt)
<dd .deflist_dd> <dd .deflist__dd>
$case mbContact $case mbContact
$of Left err $of Left err
Fehler: #{tshow err} Fehler: #{tshow err}
$of Right contactInfo $of Right contactInfo
#{decodeUtf8 (Pretty.encodePretty (toJSON contactInfo))} #{decodeUtf8 (Pretty.encodePretty (toJSON contactInfo))}
<dt .deflist__dt>PersonStatus und mehrere PersoSearch <br> <dt .deflist__dt>PersonStatus und mehrere PersonSearch <br>
<i>(benötigt mehrere AVS Abfragen) <i>(benötigt mehrere AVS Abfragen)
<dd .deflist_dd> <dd .deflist__dd>
$maybe dataPerson <- mbDataPerson $maybe dataPerson <- mbDataPerson
#{decodeUtf8 (Pretty.encodePretty (toJSON dataPerson))} #{decodeUtf8 (Pretty.encodePretty (toJSON dataPerson))}
$nothing $nothing
Keine Daten erhalten. Keine Daten erhalten.
<h3>
Provisorische formatierte Ansicht
<p>
Generisch formatierte Ansicht, die zeigt, in welche Richtung die Endansicht gehen könnte.
In der Endansicht wären nur ausgewählte Felder mit besserer Bennenung in einer manuell gewählten Reihenfolge sichtbar.
<p>
^{foldMap jsonWidget mbContact}
<p>
^{foldMap jsonWidget mbDataPerson}
|] |]
let heading = [whamlet|_{MsgAvsPersonNo} #{userAvsNoPerson}|] let heading = [whamlet|_{MsgAvsPersonNo} #{userAvsNoPerson}|]
siteLayout heading $ do siteLayout heading $ do

35
src/Handler/Utils/Widgets.hs
View File

@ -13,7 +13,7 @@ import Text.Hamlet (shamletFile)
import Handler.Utils.DateTime import Handler.Utils.DateTime
import qualified Data.Char as Char import qualified Data.Char as Char
import qualified Data.HashMap.Strict as Aeson -- ON UPDATE replace with: import qualified Data.Aeson.KeyMap as Aeson
--------- ---------
-- Simple utilities for consistent display -- Simple utilities for consistent display
@ -198,3 +198,36 @@ roomReferenceWidget RoomReferenceLink{..} = $(widgetFile "widgets/room-reference
where where
linkText = uriToString id roomRefLink mempty linkText = uriToString id roomRefLink mempty
instrModal = modal (i18n MsgRoomReferenceLinkInstructions) $ Right $(widgetFile "widgets/room-reference/link-instructions-modal") instrModal = modal (i18n MsgRoomReferenceLinkInstructions) $ Right $(widgetFile "widgets/room-reference/link-instructions-modal")
----------
-- JSON --
----------
-- Data.Aeson.Encode.Pretty.encodePretty did not render in Html properly, hence jsonWidget
jsonWidget :: ToJSON a => a -> Widget
jsonWidget x = jsonWidgetAux $ toJSON x
where
jsonWidgetAux :: Value -> Widget
jsonWidgetAux Null = [whamlet|Null|]
jsonWidgetAux (Bool b) = toWidget $ boolSymbol b
jsonWidgetAux (String s) = [whamlet|#{s}|]
jsonWidgetAux (Number n) = [whamlet|#{show n}|]
jsonWidgetAux (Array l)
| 1 >= length l = foldMap jsonWidgetAux l -- empty arrays don't show
| otherwise =
[whamlet|
<ul>
$forall x <- sort l
<li>^{jsonWidgetAux x}
|]
jsonWidgetAux (Object o) = case Aeson.toList o of -- toAscList not supported
[ ] -> mempty -- empty objects don't show
[(_,v)] -> jsonWidgetAux v
r -> [whamlet|
<dl .deflist>
$forall (k,v) <- sort r
<dt .deflist__dt>#{k}
<dd .deflist__dd>^{jsonWidgetAux v}
|]

2
src/Utils/Avs.hs
View File

@ -68,7 +68,7 @@ mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
mkAvsQuery _ _ _ = AvsQuery mkAvsQuery _ _ _ = AvsQuery
{ avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty { avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty
, avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty , avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty
, avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "AVSNO:123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing) , avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
, avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty , avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty
, avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty , avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty
} }