WIP

src/Main.elm

@@ -1,5 +1,7 @@
 module Main exposing (main)
 
+-- import Html.Lazy as HLazy
+
 import Browser
 import Dict
 import Html as H exposing (Attribute, Html)
@@ -9,9 +11,9 @@ import Http
 import Json.Decode as J exposing (Decoder)
 import Json.Encode as Encode
 import OrderedDict exposing (OrderedDict)
-import Url
 
 
+main : Program () Model Msg
 main =
     Browser.element
         { init = init
@@ -166,44 +168,98 @@ view model =
 
 header : Model -> Html Msg
 header model =
-    H.header (styleGroup [ ( "display", "flex" ), ( "align-items", "center" ) ])
+    H.header
-        [ H.h1 (styleGroup [ ( "font-size", "inherit" ), ( "padding", "0.5em" ), ( "width", "100%" ), ( "white-space", "nowrap" ), ( "flex", "1" ) ]) [ H.text "GraphQL Introspector" ]
+        (styleGroup [ ( "display", "flex" ), ( "align-items", "center" ) ])
-        , H.input
+        [ H.h1
-            (styleGroup [ ( "width", "100%" ), ( "padding", "0.5em" ), ( "margin", "0.25em 0 0.25em 0" ) ]
+            (styleGroup
-                ++ [ A.value model.introspectUrl, Ev.onInput UpdateIntrospectUrl, A.placeholder "https://your-graphql-endpoint.example.com/graphql" ]
+                [ ( "font-size", "inherit" )
+                , ( "padding", "0.5em" )
+                , ( "width", "100%" )
+                , ( "white-space", "nowrap" )
+                , ( "flex", "1" )
+                ]
             )
-            []
+            [ H.text "GraphQL Introspector" ]
-        , H.button (Ev.onClick RequestIntrospection :: styleGroup [ ( "padding", "0.5em" ), ( "margin", "0.25em" ) ]) [ H.text "Add" ]
+        , H.form
+            (Ev.onSubmit RequestIntrospection
+                :: styleGroup
+                    [ ( "width", "100%" )
+                    , ( "display", "flex" )
+                    , ( "align-items", "center" )
+                    ]
+            )
+            [ H.input
+                (styleGroup
+                    [ ( "width", "100%" )
+                    , ( "padding", "0.5em" )
+                    , ( "margin", "0.25em 0 0.25em 0" )
+                    ]
+                    ++ [ A.value model.introspectUrl
+                       , Ev.onInput UpdateIntrospectUrl
+                       , A.placeholder "https://your-graphql-endpoint.example.com/graphql"
+                       ]
+                )
+                []
+            , H.button
+                (Ev.onClick RequestIntrospection
+                    :: styleGroup
+                        [ ( "padding", "0.5em" )
+                        , ( "margin", "0.25em" )
+                        ]
+                )
+                [ H.text "Add" ]
+            ]
         ]
 
 
 introspectionResultView : String -> Maybe IntrospectionResult -> Maybe (Html Msg)
 introspectionResultView url mir =
-    case mir of
+    Maybe.map
-        Just ir ->
+        (\ir ->
-            Just
+            H.li
-                (H.li []
+                (styleGroup
-                    ([ H.text url ]
+                    [ ( "background-color", lighten )
-                        ++ (case ir of
+                    , ( "padding", "0.5em" )
-                                Loading ->
+                    , ( "border-radius", "0.5em" )
-                                    [ H.text "Loading..." ]
+                    , ( "margin", "0 0.25em 0.25em 0.25em" )
-
+                    ]
-                                Error e ->
-                                    [ H.text ("Error: " ++ httpErrorToString e) ]
-
-                                Success i ->
-                                    [ introspectionView i ]
-                           )
-                    )
                 )
+                (H.header (styleGroup [ ( "margin-bottom", "0.5em" ), ( "border-bottom", "solid 1px #888" ), ( "padding-bottom", "0.75em" ) ])
+                    [ H.text ""
+                    , H.a
+                        [ A.href url
+                        , A.target "_blank"
+                        , A.title (Debug.toString mir)
+                        ]
+                        [ H.text url ]
+                    ]
+                    :: (case ir of
+                            Loading ->
+                                [ H.text "Loading..." ]
 
-        Nothing ->
+                            Error e ->
-            Nothing
+                                [ H.text ("Error: " ++ httpErrorToString e) ]
+
+                            Success i ->
+                                [ introspectionView i ]
+                       )
+                )
+        )
+        mir
 
 
 introspectionView : Introspection -> Html Msg
 introspectionView i =
     let
+        types =
+            keyBy .name i.types
+
+        queryTypes =
+            List.filter (\t -> Just t.name == i.queryType) i.types
+
+        mutationTypes =
+            List.filter (\t -> Just t.name == i.mutationType) i.types
+
         allTypes =
             List.filter
                 (\t ->
@@ -211,20 +267,118 @@ introspectionView i =
                         (List.member t.name <|
                             List.filterMap identity [ i.mutationType, i.queryType ]
                         )
+                        && not (String.startsWith "__" t.kind)
                 )
                 i.types
+
+        sg =
+            styleGroup [ ( "margin", "1em 0" ) ]
     in
-    H.div [] (List.map typeView allTypes)
+    H.div []
+        (List.filterMap
+            identity
+            [ i.queryType
+                |> Maybe.andThen
+                    (\q ->
+                        Dict.get q types.dict
+                            |> Maybe.andThen
+                                (\t ->
+                                    Maybe.andThen t.fields (\f -> H.div [] (List.map fieldView f))
+                                )
+                    )
+            , H.div sg
+                [ H.h2 [] [ H.text "Query Fields" ]
+                , H.div [] (List.map typeView queryTypes)
+                ]
+            , H.div sg
+                [ H.h2 [] [ H.text "Mutations" ]
+                , H.div [] (List.map typeView mutationTypes)
+                ]
+            , H.div sg
+                [ H.h2 [] [ H.text "All Types" ]
+                , H.div [] (List.map typeView allTypes)
+                ]
+            ]
+        )
+
+
+kindColor : String -> String
+kindColor s =
+    case s of
+        "OBJECT" ->
+            "#0af"
+
+        "SCALAR" ->
+            "#fa0"
+
+        "ENUM" ->
+            "#f0a"
+
+        "INTERFACE" ->
+            "#af0"
+
+        "UNION" ->
+            "#0fa"
+
+        "INPUT_OBJECT" ->
+            "#a0f"
+
+        _ ->
+            "#fff"
 
 
 typeView : QLType -> Html Msg
 typeView qt =
     H.div []
-        [ H.text (qt.name ++ ": " ++ qt.kind) ]
+        ([ H.div
+            (styleGroup
+                [ ( "display", "flex" )
+                , ( "align-items", "center" )
+                , ( "font-size", "16px" )
+                , ( "margin", "0.25em 0" )
+                ]
+            )
+            [ H.code
+                (styleGroup
+                    [ ( "margin-right", "0.5em" )
+                    , ( "color", "#111" )
+                    , ( "font-size", "75%" )
+                    , ( "display", "inline-block" )
+                    , ( "padding", "0.25em" )
+                    , ( "border-radius", "0.25em" )
+                    , ( "line-height", "1" )
+                    , ( "background-color", kindColor qt.kind )
+                    ]
+                )
+                [ H.text qt.kind ]
+            , H.code [ A.title (Debug.toString qt) ] [ H.text qt.name ]
+            ]
+         ]
+            ++ (case qt.description of
+                    Just s ->
+                        [ H.p (styleGroup [ ( "margin-left", "2em" ) ]) [ H.text s ] ]
+
+                    Nothing ->
+                        []
+               )
+            ++ (case qt.fields of
+                    Just fields ->
+                        [ H.div (styleGroup [ ( "margin-left", "4em" ) ]) <| List.map fieldView fields ]
+
+                    Nothing ->
+                        []
+               )
+        )
+
+
+fieldView : Field -> Html Msg
+fieldView f =
+    H.li [ A.title <| Debug.toString f ] [ H.text f.name ]
 
 
 httpErrorToString : Http.Error -> String
 httpErrorToString e =
+    -- TODO: refactor as expect function
     case e of
         Http.BadUrl s ->
             "Bad URL: " ++ s
@@ -248,8 +402,8 @@ decodeIntrospection =
         (J.field "__schema"
             (J.map5 Introspection
                 (J.field "directives" (J.list decodeDirective))
-                (J.maybe (J.field "queryType" (J.field "name" J.string)))
                 (J.maybe (J.field "mutationType" (J.field "name" J.string)))
+                (J.maybe (J.field "queryType" (J.field "name" J.string)))
                 (J.maybe (J.field "subscriptionType" (J.field "name" J.string)))
                 (J.field "types" (J.list decodeType))
             )
@@ -280,14 +434,17 @@ decodeField =
         (J.maybe (J.field "deprecationReason" J.string))
 
 
+decodePossibleType : Decoder PossibleType
 decodePossibleType =
     decodeArgType
 
 
+decodeEnumValue : Decoder J.Value
 decodeEnumValue =
     J.value
 
 
+decodeInterface : Decoder J.Value
 decodeInterface =
     J.value
 
@@ -310,6 +467,7 @@ decodeArg =
         (J.field "type" decodeArgType)
 
 
+decodeFieldType : Decoder ArgType
 decodeFieldType =
     J.map3 ArgType
         (J.field "kind" J.string)
@@ -333,9 +491,24 @@ decodeLazyArgType =
 introspectionQuery : Http.Body
 introspectionQuery =
     -- this query was copied from the one graphiql made
-    Http.jsonBody (Encode.object [ ( "query", Encode.string "query IntrospectionQuery { __schema { queryType { name } mutationType { name } subscriptionType { name } types { ...FullType } directives { name description args { ...InputValue }}}} fragment FullType on __Type { kind name description fields(includeDeprecated: true) { name description args { ...InputValue } type { ...TypeRef } isDeprecated deprecationReason } inputFields { ...InputValue } interfaces { ...TypeRef } enumValues(includeDeprecated: true) { name description isDeprecated deprecationReason } possibleTypes { ...TypeRef }}fragment InputValue on __InputValue { name description type { ...TypeRef } defaultValue}fragment TypeRef on __Type { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name }}}}}}}}" ) ])
+    Http.jsonBody (Encode.object [ ( "query", Encode.string "query IntrospectionQuery { __schema { queryType { name } mutationType { name } subscriptionType { name } types { ...FullType } directives { name description args { ...InputValue }}}} fragment FullType on __Type { kind name description fields(includeDeprecated: true) { name description args { ...InputValue } type { ...TypeRef } isDeprecated deprecationReason } inputFields { ...InputValue } interfaces { ...TypeRef } enumValues(includeDeprecated: true) { name description isDeprecated deprecationReason } possibleTypes { ...TypeRef }} fragment InputValue on __InputValue { name description type { ...TypeRef } defaultValue} fragment TypeRef on __Type { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name ofType { kind name }}}}}}}}" ) ])
 
 
 styleGroup : List ( String, String ) -> List (Attribute Msg)
 styleGroup l =
     List.map (\( k, v ) -> A.style k v) l
+
+
+lighten : String
+lighten =
+    "rgba(255, 255, 255, 0.05)"
+
+
+keyBy : (a -> comparable) -> List a -> OrderedDict comparable a
+keyBy f l =
+    List.foldl (\t -> \d -> OrderedDict.insert (f t) t d) OrderedDict.empty l
+
+
+getByKey : comparable -> OrderedDict comparable v -> Maybe v
+getByKey k d =
+    Dict.get k d.dict

src/index.html

@@ -1,6 +1,7 @@
 <html>
 	<head>
 		<meta charset="utf-8" />
+		<meta name="viewport" content="width=device-width, initial-scale=1">
 		<title>GraphQL Introspector</title>
 		<link rel="stylesheet" href="./styles.css" />
 	</head>

src/styles.styl

@@ -1,11 +1,14 @@
-#app
+html, body
 	background #111
 	color #fff
-	font-family Iosevka, monospace
+
-	display flex
+#app
-	flex-direction column
+	font-family sans-serif
-	justify-content space-between
+	font-size 16px
-	min-height 100vh
+	line-height 1.6em
+
+	pre, code
+		font-family monospace
 
 	a
 		color #0af
@@ -15,6 +18,7 @@
 
 	input, select, button
 		font inherit
+		color inherit
 		border 0
 		background #333
 		border-radius 0.25em