From b01278b32f12c005b557a994267e20909af56290 Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 23 Jan 2024 18:45:19 +0100 Subject: [PATCH] Complete basic JSON docs explorer --- dev/Colors.elm | 22 +++ dev/DocsDisplay.elm | 466 ++++++++++++++++++++++++++++---------------- dev/Main.elm | 227 +++++++++++++++++++-- dev/Route.elm | 15 +- 4 files changed, 551 insertions(+), 179 deletions(-) diff --git a/dev/Colors.elm b/dev/Colors.elm index aff1ccc..af26538 100644 --- a/dev/Colors.elm +++ b/dev/Colors.elm @@ -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 diff --git a/dev/DocsDisplay.elm b/dev/DocsDisplay.elm index d625134..56d0fbb 100644 --- a/dev/DocsDisplay.elm +++ b/dev/DocsDisplay.elm @@ -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,228 +23,363 @@ 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.text dobject.name ) + 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 - ] - ( Element.text <| toString docs ) + , toString docs ] + , showFunctions (getFunctions docs) ] - |> Element.column [] + |> Element.column + [ Element.spacing 20 + , Element.width Element.fill + ] + findObjects : Docs -> List DObject findObjects docs = bfs [ docs ] [] + bfs : List Docs -> List DObject -> List DObject bfs queue acc = case queue of [] -> acc - + head :: tail -> case head of DocsBool -> bfs tail acc - + DocsDict d -> bfs (d :: tail) acc - + DocsFloat -> bfs tail acc - + DocsInt -> bfs tail acc - + DocsLazy f -> bfs (f () :: tail) acc - + DocsList d -> bfs (d :: tail) acc - + DocsMap { content } -> bfs (content :: tail) 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)) (List.append acc [ dobject ]) - + DocsOptional d -> bfs (d :: tail) acc - + DocsRiskyMap { content } -> bfs (content :: tail) acc - + DocsString -> bfs tail acc - + DocsValue -> bfs tail acc -toTable : Bool -> DObject -> Element Bool -toTable asc dobject = - Widget.sortTableV2 (Material.sortTable <| C.defaultPalette C.stdPicker) - { content = dobject.keys + +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 + [ Element.height Element.fill + , Element.width Element.fill + , Font.bold + ] + in + Element.indexedTable + [ C.background <| C.stdPicker.light.white ] + { data = dobject.keys , columns = - [ Widget.stringColumnV2 - { title = "Field" - , value = .field - , toString = identity - , width = Element.fillPortion 1 - } - , Widget.customColumnV2 - { title = "Type" - , value = - (\item -> - item.content - |> toString - |> Element.text - |> Element.el - [ Font.family [Font.monospace] - , C.background C.stdPicker.dark.white - , Element.padding 3 - , Element.centerX - ] - ) - , width = Element.fillPortion 1 - } - , Widget.customColumnV2 - { title = "Description" - , value = showDescription - , width = Element.fillPortion 5 - } + [ { header = header "Field" + , width = Element.fillPortion 1 + , view = \i item -> toCell (Element.text item.field) i + } + , { 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 - [] -> - Element.column [] - [ Element.paragraph [] - [ "WARNING: " +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.paragraph [] + [ Element.el [ Font.bold ] <| Element.text "WARNING: " + , Element.text "This field has no documentation yet!" + ] + + head :: tail -> + Element.column [ Element.width Element.fill ] + (List.append + [ Element.paragraph [] + [ Element.el [ Font.bold ] <| + Element.text + (case required of + Json.RequiredField -> + "Required: " + + _ -> + "" + ) + , Element.text head + ] + ] + (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 ] - , "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 - ] - ] - - head :: tail -> - case required of - Json.RequiredField -> - ( Element.paragraph [] - [ Element.el [ Font.bold ] (Element.text "Required: ") - , Element.text head - ] + ) + :: List.map + (Element.text + >> List.singleton + >> Element.paragraph [] + ) + f.description ) - :: - ( 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 [] + ) + |> 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 = - case docs of - DocsBool -> - "bool" - - DocsDict d -> - "{string:" ++ (toString d) ++ "}" - - DocsFloat -> - "float" - - DocsInt -> - "int" - - DocsLazy f -> - toString (f ()) - - DocsList d -> - "[" ++ (toString d) ++ "]" - - DocsMap { content } -> - "f(" ++ (toString content) ++ ")" - - DocsObject { name } -> - name - - DocsOptional d -> - toString d +toString : Docs -> Element String +toString = + let + go : Docs -> List (Element String) + go docs = + case docs of + DocsBool -> + [ Element.text "bool" ] - DocsRiskyMap { content } -> - "f(" ++ (toString content) ++ ")" - - DocsString -> - "string" - - DocsValue -> - "" + DocsDict d -> + List.concat + [ [ Element.text "{string:" ] + , go d + , [ Element.text "}" ] + ] + + DocsFloat -> + [ Element.text "float" ] + + DocsInt -> + [ Element.text "int" ] + + DocsLazy f -> + go (f ()) + + DocsList d -> + List.concat + [ [ Element.text "[" ] + , go d + , [ Element.text "]" ] + ] + + 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 -> + go d + + DocsRiskyMap { name, content } -> + List.concat + [ [ Element.text name, Element.text "(" ] + , go content + , [ Element.text ")" ] + ] + + DocsString -> + [ Element.text "string" ] + + DocsValue -> + [ Element.text "JSON" ] + in + go + >> Element.paragraph + [ Font.family [ Font.monospace ] + , C.background C.stdPicker.dark.white + ] diff --git a/dev/Main.elm b/dev/Main.elm index 49491c0..19b049c 100644 --- a/dev/Main.elm +++ b/dev/Main.elm @@ -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 [] - |> List.singleton + |> 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 diff --git a/dev/Route.elm b/dev/Route.elm index 06fed1a..708b08b 100644 --- a/dev/Route.elm +++ b/dev/Route.elm @@ -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