Complete basic JSON docs explorer

json-docs
Bram 2024-01-23 18:45:19 +01:00
parent 779bb2d5e2
commit b01278b32f
4 changed files with 551 additions and 179 deletions

View File

@ -6,6 +6,7 @@ module Colors exposing (..)
import Color exposing (rgb255)
import Element
import Element.Background
import Element.Border
import Element.Font
import Svg
import Svg.Attributes exposing (fill)
@ -15,9 +16,11 @@ import Widget.Material exposing (Palette)
type alias Color =
Color.Color
type alias AllColors a =
AllBlindnesses (AllModes (AllShades (AllNames a)))
allColors : AllColors Color
allColors =
allBlindnesses
@ -34,10 +37,12 @@ allColors =
)
)
stdPicker : Picker
stdPicker =
allColors.trichromatic.lightMode
type Name
= Primary
| Secondary
@ -47,6 +52,7 @@ type Name
| Black
| White
type alias AllNames a =
{ primary : a
, secondary : a
@ -57,6 +63,7 @@ type alias AllNames a =
, white : a
}
allNames : (Name -> a) -> AllNames a
allNames builder =
{ primary = builder Primary
@ -68,17 +75,20 @@ allNames builder =
, white = builder White
}
type Shade
= Light
| Medium
| Dark
type alias AllShades a =
{ light : a
, medium : a
, dark : a
}
allShades : (Shade -> a) -> AllShades a
allShades builder =
{ light = builder Light
@ -86,23 +96,27 @@ allShades builder =
, dark = builder Dark
}
{-| Based on the user's preferences, the website can be displayed in light mode or dark mode.
-}
type Mode
= LightMode
| DarkMode
type alias AllModes a =
{ lightMode : a
, darkMode : a
}
allModes : (Mode -> a) -> AllModes a
allModes builder =
{ lightMode = builder LightMode
, darkMode = builder DarkMode
}
{-| The website supports color blindness friendly color palettes.
This way, everyone can enjoy the website's graphs without having to distinguish
colors that they cannot distinguish.
@ -118,6 +132,7 @@ type Blindness
| Monochromacy -- NO COLOR
| BlueConeMonochromacy -- BARELY COLOR
type alias AllBlindnesses a =
{ trichromatic : a
, protanomaly : a
@ -130,6 +145,7 @@ type alias AllBlindnesses a =
, blueConeMonochromacy : a
}
allBlindnesses : (Blindness -> a) -> AllBlindnesses a
allBlindnesses builder =
{ trichromatic = builder Trichromatic
@ -143,6 +159,7 @@ allBlindnesses builder =
, blueConeMonochromacy = builder BlueConeMonochromacy
}
type alias Picker =
AllShades (AllNames Color)
@ -487,6 +504,11 @@ font =
Color.toRgba >> Element.fromRgb >> Element.Font.color
border : Color -> Element.Attribute msg
border =
Color.toRgba >> Element.fromRgb >> Element.Border.color
background : Color -> Element.Attribute msg
background =
Color.toRgba >> Element.fromRgb >> Element.Background.color

View File

@ -1,16 +1,15 @@
module DocsDisplay exposing (..)
import Internal.Tools.Json as Json exposing (Docs(..))
import Element exposing (Element)
import Element.Font as Font
import Widget
import Widget.Material as Material
import Widget.Material.Typography as Typography
import Colors as C
import Internal.Tools.Json as Json
import Internal.Tools.Json as Json
import Internal.Tools.Json as Json
import FastDict as Dict exposing (Dict)
import Element exposing (Element)
import Element.Border as Border
import Element.Events as Events
import Element.Font as Font
import Element.Region as Region
import Html.Attributes
import Internal.Tools.Json as Json exposing (Docs(..))
import Widget.Material.Typography as Typography
type alias DObject =
{ name : String
@ -24,38 +23,49 @@ type alias DObject =
}
}
render : Dict String Bool -> Docs -> Element (String, Bool)
render dict docs =
render : Docs -> Element String
render docs =
docs
|> findObjects
|> List.map
(\dobject ->
Element.column []
[ Element.el Typography.h3
Element.column
[ Element.width Element.fill
, Element.spacing 12
]
[ Element.el
(List.append
[ Region.heading 3
, Element.htmlAttribute <| Html.Attributes.id dobject.name
]
Typography.h3
)
(Element.text dobject.name)
, dobject.description
|> List.map (Element.text >> List.singleton >> Element.paragraph [])
|> Element.column []
, toTable (Dict.get dobject.name dict |> Maybe.withDefault True) dobject
|> Element.map (Tuple.pair dobject.name)
, toTable dobject
]
)
|> List.append
[ Element.paragraph []
[ Element.text "This coder decodes to "
, Element.el
[ Font.family [ Font.monospace ]
, C.background C.stdPicker.medium.white
, toString docs
]
( Element.text <| toString docs )
, showFunctions (getFunctions docs)
]
|> Element.column
[ Element.spacing 20
, Element.width Element.fill
]
|> Element.column []
findObjects : Docs -> List DObject
findObjects docs =
bfs [ docs ] []
bfs : List Docs -> List DObject -> List DObject
bfs queue acc =
case queue of
@ -88,6 +98,7 @@ bfs queue acc =
DocsObject dobject ->
if List.any (\item -> item.name == dobject.name) acc then
bfs tail acc
else
bfs
(List.append tail (List.map .content dobject.keys))
@ -105,147 +116,270 @@ bfs queue acc =
DocsValue ->
bfs tail acc
toTable : Bool -> DObject -> Element Bool
toTable asc dobject =
Widget.sortTableV2 (Material.sortTable <| C.defaultPalette C.stdPicker)
{ content = dobject.keys
, columns =
[ Widget.stringColumnV2
{ title = "Field"
, value = .field
, toString = identity
, width = Element.fillPortion 1
}
, Widget.customColumnV2
{ title = "Type"
, value =
(\item ->
item.content
|> toString
toTable : DObject -> Element String
toTable dobject =
let
toCell : Element String -> Int -> Element String
toCell content i =
Element.el
[ if (i |> modBy 2) == 0 then
C.background C.stdPicker.light.white
else
C.background C.stdPicker.medium.white
, Element.padding 3
]
content
header : String -> Element msg
header t =
t
|> Element.text
|> Element.el
[ Font.family [Font.monospace]
, C.background C.stdPicker.dark.white
, Element.padding 3
, Element.centerX
[ Element.height Element.fill
, Element.width Element.fill
, Font.bold
]
)
in
Element.indexedTable
[ C.background <| C.stdPicker.light.white ]
{ data = dobject.keys
, columns =
[ { header = header "Field"
, width = Element.fillPortion 1
, view = \i item -> toCell (Element.text item.field) i
}
, Widget.customColumnV2
{ title = "Description"
, value = showDescription
, width = Element.fillPortion 5
, { header = header "Type"
, width = Element.fillPortion 1
, view = \i item -> toCell (toString item.content) i
}
, { header = header "Description"
, width = Element.fillPortion 3
, view = \i item -> showDescription i item
}
]
, asc = asc
, sortBy = "Field"
, onChange =
(\f ->
if f == "Field" then
not asc
else
asc
)
}
{-| Show the description of a field in a table column.
-}
showDescription : { a | description : List String, required : Json.RequiredField } -> Element msg
showDescription { description, required } =
case description of
showDescription : Int -> { a | content : Docs, description : List String, required : Json.RequiredField } -> Element msg
showDescription i { content, description, required } =
Element.column
[ if (i |> modBy 2) == 0 then
C.background C.stdPicker.light.white
else
C.background C.stdPicker.medium.white
, Element.padding 3
]
-- Field description
[ case description of
[] ->
Element.column []
[ Element.paragraph []
[ "WARNING: "
|> Element.text
|> Element.el [ Font.bold ]
, "This field has no documentation yet!"
|> Element.text
]
, case required of
Json.RequiredField ->
Element.paragraph []
[ "This field is required."
|> Element.text
]
Json.OptionalField ->
Element.paragraph []
[ "This field is optional."
|> Element.text
]
Json.OptionalFieldWithDefault default ->
Element.paragraph []
[ "This field is optional. If it is not there, a default value of \"" ++ default ++ "\" will be taken."
|> Element.text
]
[ Element.el [ Font.bold ] <| Element.text "WARNING: "
, Element.text "This field has no documentation yet!"
]
head :: tail ->
case required of
Element.column [ Element.width Element.fill ]
(List.append
[ Element.paragraph []
[ Element.el [ Font.bold ] <|
Element.text
(case required of
Json.RequiredField ->
( Element.paragraph []
[ Element.el [ Font.bold ] (Element.text "Required: ")
"Required: "
_ ->
""
)
, Element.text head
]
)
::
( List.map (Element.text >> List.singleton >> Element.paragraph []) tail)
|> Element.column []
Json.OptionalField ->
description
|> List.map (Element.text >> List.singleton >> Element.paragraph [])
|> Element.column []
Json.OptionalFieldWithDefault default ->
Element.paragraph []
[ Element.el [ Font.bold] (Element.text "Defaults to: ")
, Element.text default
]
|> List.singleton
|> List.append (List.map (Element.text >> List.singleton >> Element.paragraph []) description)
|> Element.column []
(List.map
(Element.text
>> List.singleton
>> Element.paragraph []
)
tail
)
)
-- Additional function descriptions
, showFunctions (getFunctions content)
]
showFunctions : List { name : String, description : List String } -> Element msg
showFunctions functions =
functions
|> List.indexedMap
(\i f ->
let
name : C.AllNames C.Color -> C.Color
name =
case modBy 5 i of
0 ->
.primary
1 ->
.secondary
2 ->
.tertiary
3 ->
.quaternary
_ ->
.extra
in
Element.column
[ Border.rounded 15
, C.background (name <| C.stdPicker.light)
, C.border <| name <| C.stdPicker.dark
, Border.width 2
, Element.padding 5
]
((f.name
|> (++) "Function "
|> Element.text
|> Element.el [ Font.bold ]
)
:: List.map
(Element.text
>> List.singleton
>> Element.paragraph []
)
f.description
)
)
|> Element.column
[ Element.padding 5
, Element.spacing 5
, Element.width Element.fill
]
{-| Gather all the untranslatable functions that are hidden in the coders
-}
getFunctions : Docs -> List { name : String, description : List String }
getFunctions docs =
getFunctionBFS docs []
getFunctionBFS : Docs -> List { name : String, description : List String } -> List { name : String, description : List String }
getFunctionBFS docs acc =
case docs of
DocsBool ->
acc
DocsDict d ->
getFunctionBFS d acc
DocsFloat ->
acc
DocsInt ->
acc
DocsLazy f ->
getFunctionBFS (f ()) acc
DocsList d ->
getFunctionBFS d acc
DocsMap { name, description, content } ->
getFunctionBFS
content
(List.append acc [ { name = name, description = description } ])
DocsObject _ ->
acc
DocsOptional d ->
getFunctionBFS d acc
DocsRiskyMap { name, description, content } ->
getFunctionBFS
content
(List.append acc [ { name = name, description = description } ])
DocsString ->
acc
DocsValue ->
acc
{-| Write JSON type as a string.
-}
toString : Docs -> String
toString docs =
toString : Docs -> Element String
toString =
let
go : Docs -> List (Element String)
go docs =
case docs of
DocsBool ->
"bool"
[ Element.text "bool" ]
DocsDict d ->
"{string:" ++ (toString d) ++ "}"
List.concat
[ [ Element.text "{string:" ]
, go d
, [ Element.text "}" ]
]
DocsFloat ->
"float"
[ Element.text "float" ]
DocsInt ->
"int"
[ Element.text "int" ]
DocsLazy f ->
toString (f ())
go (f ())
DocsList d ->
"[" ++ (toString d) ++ "]"
List.concat
[ [ Element.text "[" ]
, go d
, [ Element.text "]" ]
]
DocsMap { content } ->
"f(" ++ (toString content) ++ ")"
DocsMap { name, content } ->
List.concat
[ [ Element.text name, Element.text "(" ]
, go content
, [ Element.text ")" ]
]
DocsObject { name } ->
name
|> Element.text
|> Element.el
[ Events.onClick name ]
|> List.singleton
DocsOptional d ->
toString d
go d
DocsRiskyMap { content } ->
"f(" ++ (toString content) ++ ")"
DocsRiskyMap { name, content } ->
List.concat
[ [ Element.text name, Element.text "(" ]
, go content
, [ Element.text ")" ]
]
DocsString ->
"string"
[ Element.text "string" ]
DocsValue ->
"<json>"
[ Element.text "JSON" ]
in
go
>> Element.paragraph
[ Font.family [ Font.monospace ]
, C.background C.stdPicker.dark.white
]

View File

@ -5,14 +5,29 @@ documentation elements of the Elm Matrix SDK.
-}
import Browser
import Browser.Dom as Dom
import Browser.Navigation as Navigation
import Route exposing (Route(..))
import Url
import FastDict as Dict
import Colors as C
import Dict exposing (Dict)
import DocsDisplay as Display
import Internal.Values.StateManager
import Element
import Element exposing (Element)
import Element.Font as Font
import Element.Input as Input
import Internal.Tools.Hashdict
import Internal.Tools.Json as Json
import Internal.Tools.Mashdict
import Internal.Tools.Timestamp
import Internal.Values.Context
import Internal.Values.Envelope
import Internal.Values.Event
import Internal.Values.Settings
import Internal.Values.StateManager
import Json.Decode as D
import Route exposing (Route(..))
import Task
import Url
import Widget
import Widget.Material as Material
main : Program () Model Msg
@ -27,16 +42,50 @@ main =
}
coders : Dict String ( Json.Docs, String -> Result String String )
coders =
Dict.fromList
[ ( "Context", shapeCoder <| Internal.Values.Context.coder )
, ( "Envelope", shapeCoder <| Internal.Values.Envelope.coder Json.value )
, ( "Event", shapeCoder <| Internal.Values.Event.coder )
, ( "Hashdict", shapeCoder <| Internal.Tools.Hashdict.coder .eventId Internal.Values.Event.coder )
, ( "Mashdict", shapeCoder <| Internal.Tools.Mashdict.coder .stateKey Internal.Values.Event.coder )
, ( "Settings", shapeCoder <| Internal.Values.Settings.coder )
, ( "StateManager", shapeCoder <| Internal.Values.StateManager.coder )
, ( "Timestamp", shapeCoder <| Internal.Tools.Timestamp.coder )
]
shapeCoder : Json.Coder a -> ( Json.Docs, String -> Result String String )
shapeCoder coder =
( Json.toDocs coder
, decoder coder
)
decoder : Json.Coder a -> String -> Result String String
decoder coder value =
D.decodeString (Json.decode coder) value
|> Result.mapError D.errorToString
|> Result.map Debug.toString
|> Result.map ((++) "Success! JSON decoded to Elm value: ")
type alias Model =
{ key : Navigation.Key
, page : Route.Route
, input : String
, valid : Maybe (Result String String)
}
type Msg
= OnTableSwitch ( String, Bool )
= OnDecodeString
| OnObjectClick String
| OnScreenMoved Bool
| OnUrlChange Url.Url
| OnUrlRequest Browser.UrlRequest
| OnWriteJSON String
@ -47,6 +96,8 @@ init : () -> Url.Url -> Navigation.Key -> ( Model, Cmd Msg )
init () url key =
( { key = key
, page = Route.toRoute url
, input = ""
, valid = Nothing
}
, Cmd.none
)
@ -59,7 +110,37 @@ init () url key =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
OnTableSwitch _ ->
OnDecodeString ->
case model.page of
ViewObject o ->
( { model
| valid =
coders
|> Dict.get o
|> Maybe.map Tuple.second
|> Maybe.map ((|>) model.input)
}
, Cmd.none
)
_ ->
( model, Cmd.none )
OnObjectClick name ->
( model
, Dom.getElement name
|> Task.andThen
(\data ->
Dom.setViewport
data.element.x
data.element.y
)
|> Task.map (always True)
|> Task.onError (\_ -> Task.succeed False)
|> Task.perform OnScreenMoved
)
OnScreenMoved _ ->
( model, Cmd.none )
OnUrlChange url ->
@ -71,6 +152,9 @@ update msg model =
OnUrlRequest (Browser.External url) ->
( model, Navigation.load url )
OnWriteJSON text ->
( { model | input = text }, Cmd.none )
-- SUBSCRIPTIONS
@ -89,12 +173,131 @@ view : Model -> Browser.Document Msg
view model =
{ title = Route.toString model.page ++ " | Elm Matrix SDK Docs"
, body =
case model.page of
[ Widget.menuBar (Material.menuBar <| C.defaultPalette C.stdPicker)
{ title =
Element.link []
{ url = "/"
, label =
"Elm Matrix SDK Docs"
|> Element.text
|> Element.el
[ C.font C.stdPicker.light.white
]
}
, deviceClass = Element.Phone
, openLeftSheet = Nothing
, openRightSheet = Nothing
, openTopSheet = Nothing
, primaryActions = []
, search = Nothing
}
, (case model.page of
ViewObject o ->
Element.column [ Element.spacing 10 ]
[ coders
|> Dict.get o
|> Maybe.map (Tuple.first >> showDocs)
|> Maybe.withDefault (Element.text "This object doesn't exist!")
, Element.column
[ Element.width Element.fill
, Element.height <| Element.minimum 100 <| Element.fill
]
[ Input.multiline
[ case model.valid of
Just (Err _) ->
C.background C.stdPicker.light.secondary
Just (Ok _) ->
C.background C.stdPicker.light.quaternary
Nothing ->
Element.width Element.fill
, Element.width Element.fill
]
{ onChange = OnWriteJSON
, text = model.input
, placeholder =
"Insert a test JSON object..."
|> Element.text
|> Input.placeholder []
|> Just
, label = Input.labelHidden "Test input JSON"
, spellcheck = False
}
, Widget.button
(Material.outlinedButton <| C.defaultPalette C.stdPicker)
{ text = "Check JSON"
, icon = always Element.none
, onPress = Just OnDecodeString
}
, case model.valid of
Nothing ->
Element.none
Just (Ok msg) ->
msg
|> Element.text
|> List.singleton
|> Element.paragraph
[ C.font <| C.stdPicker.dark.quaternary ]
Just (Err msg) ->
msg
|> Element.text
|> List.singleton
|> Element.paragraph
[ C.font <| C.stdPicker.dark.secondary ]
]
]
Home ->
Element.column [ Element.spacing 10 ]
(List.append
[ Element.paragraph []
[ Element.text "This is the Home of the Elm Matrix SDK JSON documentation tool."
]
, Element.paragraph []
[ Element.text "This tool helps you debug and explore JSON data types that are used by the Elm Matrix SDK."
]
]
(coders
|> Dict.keys
|> List.map
(\name ->
Element.link
[ C.font <| C.stdPicker.medium.primary
, Font.underline
]
{ url = "/object/" ++ name
, label = Element.text name
}
)
)
)
_ ->
Internal.Values.StateManager.coder
|> Json.toDocs
|> Display.render Dict.empty
|> Element.map OnTableSwitch
|> Element.layout []
|> showDocs
)
|> Element.el
[ Element.paddingXY 120 120
, Element.height Element.fill
]
]
|> Element.column
[ Element.width Element.fill
, Element.height Element.fill
, Element.alignTop
]
|> Element.layout
[ C.background <| C.stdPicker.dark.white
, C.font <| C.stdPicker.dark.black
]
|> List.singleton
}
showDocs : Json.Docs -> Element Msg
showDocs =
Display.render >> Element.map OnObjectClick

View File

@ -18,6 +18,19 @@ toRoute url =
P.parse routeParser url |> Maybe.withDefault NotFound
toPath : Route -> String
toPath route =
case route of
Home ->
"/"
NotFound ->
"/"
ViewObject o ->
"/object/" ++ o
toString : Route -> String
toString route =
case route of
@ -41,7 +54,7 @@ routeParser =
, P.s "index"
|> P.map Home
, P.s "dev"
</> (P.s "Main.elm")
</> P.s "Main.elm"
|> P.map Home
, P.s "object"
</> P.string