Complete basic JSON docs explorer

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

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 Element exposing (Element)
-import Internal.Tools.Json as Json
+import Element.Border as Border
-import Internal.Tools.Json as Json
+import Element.Events as Events
-import FastDict as Dict exposing (Dict)
+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.column
-                    [ Element.el Typography.h3
+                    [ Element.width Element.fill
-                        ( Element.text dobject.name )
+                    , 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
+                    , toTable dobject
-                        |> Element.map (Tuple.pair dobject.name)
                     ]
             )
         |> List.append
             [ Element.paragraph []
                 [ Element.text "This coder decodes to "
-                , Element.el
+                , toString docs
-                    [ Font.family [ Font.monospace ]
-                    , C.background C.stdPicker.medium.white
                 ]
-                    ( 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 =
+toTable : DObject -> Element String
-    Widget.sortTableV2 (Material.sortTable <| C.defaultPalette C.stdPicker)
+toTable dobject =
-        { content = dobject.keys
+    let
-        , columns =
+        toCell : Element String -> Int -> Element String
-            [ Widget.stringColumnV2
+        toCell content i =
-                { title = "Field"
+            Element.el
-                , value = .field
+                [ if (i |> modBy 2) == 0 then
-                , toString = identity
+                    C.background C.stdPicker.light.white
-                , width = Element.fillPortion 1
+
-                }
+                  else
-            , Widget.customColumnV2
+                    C.background C.stdPicker.medium.white
-                { title = "Type"
+                , Element.padding 3
-                , value =
+                ]
-                    (\item ->
+                content
-                        item.content
+
-                            |> toString
+        header : String -> Element msg
+        header t =
+            t
                 |> Element.text
                 |> Element.el
-                                [ Font.family [Font.monospace]
+                    [ Element.height Element.fill
-                                , C.background C.stdPicker.dark.white
+                    , Element.width Element.fill
-                                , Element.padding 3
+                    , Font.bold
-                                , Element.centerX
                     ]
-                    )
+    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
+            , { header = header "Type"
-                { title = "Description"
+              , width = Element.fillPortion 1
-                , value = showDescription
+              , view = \i item -> toCell (toString item.content) i
-                , width = Element.fillPortion 5
+              }
+            , { 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 : Int -> { a | content : Docs, description : List String, required : Json.RequiredField } -> Element msg
-showDescription { description, required } =
+showDescription i { content, description, required } =
-    case description of
+    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.el [ Font.bold ] <| Element.text "WARNING: "
-                                |> Element.text
+                    , Element.text "This field has no documentation yet!"
-                            ]
-                    
-                    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
+                Element.column [ Element.width Element.fill ]
+                    (List.append
+                        [ Element.paragraph []
+                            [ Element.el [ Font.bold ] <|
+                                Element.text
+                                    (case required of
                                         Json.RequiredField ->
-                    ( Element.paragraph []
+                                            "Required: "
-                        [ Element.el [ Font.bold ] (Element.text "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.map
-                        |> List.append (List.map (Element.text >> List.singleton >> Element.paragraph []) description)
+                            (Element.text
-                        |> Element.column []
+                                >> 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 -> Element String
-toString docs =
+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 } ->
+                DocsMap { name, content } ->
-            "f(" ++ (toString 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 } ->
+                DocsRiskyMap { name, content } ->
-            "f(" ++ (toString 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
+            ]

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 Colors as C
-import Url
+import Dict exposing (Dict)
-import FastDict as Dict
 import DocsDisplay as Display
-import Internal.Values.StateManager
+import Element exposing (Element)
-import 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
+                    |> showDocs
-                    |> Element.map OnTableSwitch
+          )
-                    |> Element.layout []
+            |> 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

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