342 lines
9.2 KiB
Elm
342 lines
9.2 KiB
Elm
module Main exposing (main)
|
|
|
|
import Browser
|
|
import Dict
|
|
import Html as H exposing (Attribute, Html)
|
|
import Html.Attributes as A
|
|
import Html.Events as Ev
|
|
import Http
|
|
import Json.Decode as J exposing (Decoder)
|
|
import Json.Encode as Encode
|
|
import OrderedDict exposing (OrderedDict)
|
|
import Url
|
|
|
|
|
|
main =
|
|
Browser.element
|
|
{ init = init
|
|
, update = update
|
|
, subscriptions = \_ -> Sub.none
|
|
, view = view
|
|
}
|
|
|
|
|
|
type alias ArgType =
|
|
{ kind : String
|
|
, name : Maybe String
|
|
, ofType : OfArgType
|
|
}
|
|
|
|
|
|
type alias FieldType =
|
|
ArgType
|
|
|
|
|
|
type OfArgType
|
|
= OfArgType (Maybe ArgType)
|
|
|
|
|
|
type alias Arg =
|
|
{ defaultValue : J.Value
|
|
, description : Maybe String
|
|
, name : String
|
|
, argType : ArgType
|
|
}
|
|
|
|
|
|
type alias Directive =
|
|
{ args : List Arg
|
|
, locations : Maybe (List String)
|
|
, description : Maybe String
|
|
, name : String
|
|
}
|
|
|
|
|
|
type alias Field =
|
|
{ name : String
|
|
, description : Maybe String
|
|
, args : List Arg
|
|
, fieldType : FieldType
|
|
, isDeprecated : Bool
|
|
, deprecationReason : Maybe String
|
|
}
|
|
|
|
|
|
type alias Interface =
|
|
J.Value
|
|
|
|
|
|
type alias EnumValue =
|
|
J.Value
|
|
|
|
|
|
type alias PossibleType =
|
|
ArgType
|
|
|
|
|
|
type alias QLType =
|
|
{ kind : String
|
|
, name : String
|
|
, description : Maybe String
|
|
, fields : Maybe (List Field)
|
|
, inputFields : Maybe (List Field)
|
|
, interfaces : Maybe (List Interface)
|
|
, enumValues : Maybe (List EnumValue)
|
|
, possibleTypes : Maybe (List PossibleType)
|
|
}
|
|
|
|
|
|
type alias Introspection =
|
|
{ directives : List Directive
|
|
, mutationType : Maybe String
|
|
, queryType : Maybe String
|
|
, subscriptionType : Maybe String
|
|
, types : List QLType
|
|
}
|
|
|
|
|
|
type IntrospectionResult
|
|
= Loading
|
|
| Error Http.Error
|
|
| Success Introspection
|
|
|
|
|
|
type alias Model =
|
|
{ introspectUrl : String
|
|
, introspections : OrderedDict String IntrospectionResult
|
|
}
|
|
|
|
|
|
init : () -> ( Model, Cmd Msg )
|
|
init _ =
|
|
( Model "https://www.graphqlhub.com/graphql" OrderedDict.empty, Cmd.none )
|
|
|
|
|
|
type Msg
|
|
= UpdateIntrospectUrl String
|
|
| RequestIntrospection
|
|
| IntrospectionRequest String (Result Http.Error Introspection)
|
|
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
|
update msg model =
|
|
case msg of
|
|
UpdateIntrospectUrl url ->
|
|
( { model | introspectUrl = url }, Cmd.none )
|
|
|
|
RequestIntrospection ->
|
|
( { model | introspections = OrderedDict.insert model.introspectUrl Loading model.introspections }, requestIntrospection model.introspectUrl )
|
|
|
|
IntrospectionRequest url result ->
|
|
let
|
|
val =
|
|
case result of
|
|
Ok i ->
|
|
Success i
|
|
|
|
Err e ->
|
|
Error e
|
|
in
|
|
( { model | introspections = OrderedDict.insert url val model.introspections }, Cmd.none )
|
|
|
|
|
|
requestIntrospection : String -> Cmd Msg
|
|
requestIntrospection url =
|
|
Http.post
|
|
{ url = url
|
|
, body = introspectionQuery
|
|
, expect = Http.expectJson (IntrospectionRequest url) decodeIntrospection
|
|
}
|
|
|
|
|
|
view : Model -> Html Msg
|
|
view model =
|
|
H.div [ A.id "app" ]
|
|
[ header model
|
|
, H.main_
|
|
[]
|
|
[ H.ul []
|
|
(List.filterMap
|
|
(\u -> introspectionResultView u (Dict.get u model.introspections.dict))
|
|
model.introspections.order
|
|
)
|
|
]
|
|
]
|
|
|
|
|
|
header : Model -> Html Msg
|
|
header model =
|
|
H.header (styleGroup [ ( "display", "flex" ), ( "align-items", "center" ) ])
|
|
[ H.h1 (styleGroup [ ( "font-size", "inherit" ), ( "padding", "0.5em" ), ( "width", "100%" ), ( "white-space", "nowrap" ), ( "flex", "1" ) ]) [ H.text "GraphQL Introspector" ]
|
|
, 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
|
|
Just ir ->
|
|
Just
|
|
(H.li []
|
|
([ H.text url ]
|
|
++ (case ir of
|
|
Loading ->
|
|
[ H.text "Loading..." ]
|
|
|
|
Error e ->
|
|
[ H.text ("Error: " ++ httpErrorToString e) ]
|
|
|
|
Success i ->
|
|
[ introspectionView i ]
|
|
)
|
|
)
|
|
)
|
|
|
|
Nothing ->
|
|
Nothing
|
|
|
|
|
|
introspectionView : Introspection -> Html Msg
|
|
introspectionView i =
|
|
let
|
|
allTypes =
|
|
List.filter
|
|
(\t ->
|
|
not
|
|
(List.member t.name <|
|
|
List.filterMap identity [ i.mutationType, i.queryType ]
|
|
)
|
|
)
|
|
i.types
|
|
in
|
|
H.div [] (List.map typeView allTypes)
|
|
|
|
|
|
typeView : QLType -> Html Msg
|
|
typeView qt =
|
|
H.div []
|
|
[ H.text (qt.name ++ ": " ++ qt.kind) ]
|
|
|
|
|
|
httpErrorToString : Http.Error -> String
|
|
httpErrorToString e =
|
|
case e of
|
|
Http.BadUrl s ->
|
|
"Bad URL: " ++ s
|
|
|
|
Http.Timeout ->
|
|
"Timeout"
|
|
|
|
Http.NetworkError ->
|
|
"Network Error"
|
|
|
|
Http.BadStatus n ->
|
|
"Bad Status: " ++ String.fromInt n
|
|
|
|
Http.BadBody s ->
|
|
"Bad Body: " ++ s
|
|
|
|
|
|
decodeIntrospection : Decoder Introspection
|
|
decodeIntrospection =
|
|
J.field "data"
|
|
(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 "subscriptionType" (J.field "name" J.string)))
|
|
(J.field "types" (J.list decodeType))
|
|
)
|
|
)
|
|
|
|
|
|
decodeType : Decoder QLType
|
|
decodeType =
|
|
J.map8 QLType
|
|
(J.field "kind" J.string)
|
|
(J.field "name" J.string)
|
|
(J.maybe (J.field "description" J.string))
|
|
(J.maybe (J.field "fields" (J.list decodeField)))
|
|
(J.maybe (J.field "inputFields" (J.list decodeField)))
|
|
(J.maybe (J.field "interfaces" (J.list decodeInterface)))
|
|
(J.maybe (J.field "enumValues" (J.list decodeEnumValue)))
|
|
(J.maybe (J.field "possibleTypes" (J.list decodePossibleType)))
|
|
|
|
|
|
decodeField : Decoder Field
|
|
decodeField =
|
|
J.map6 Field
|
|
(J.field "name" J.string)
|
|
(J.maybe (J.field "description" J.string))
|
|
(J.field "args" (J.list decodeArg))
|
|
(J.field "type" decodeFieldType)
|
|
(J.field "isDeprecated" J.bool)
|
|
(J.maybe (J.field "deprecationReason" J.string))
|
|
|
|
|
|
decodePossibleType =
|
|
decodeArgType
|
|
|
|
|
|
decodeEnumValue =
|
|
J.value
|
|
|
|
|
|
decodeInterface =
|
|
J.value
|
|
|
|
|
|
decodeDirective : Decoder Directive
|
|
decodeDirective =
|
|
J.map4 Directive
|
|
(J.field "args" (J.list decodeArg))
|
|
(J.maybe (J.field "locations" (J.list J.string)))
|
|
(J.maybe (J.field "description" J.string))
|
|
(J.field "name" J.string)
|
|
|
|
|
|
decodeArg : Decoder Arg
|
|
decodeArg =
|
|
J.map4 Arg
|
|
(J.field "defaultValue" J.value)
|
|
(J.maybe (J.field "description" J.string))
|
|
(J.field "name" J.string)
|
|
(J.field "type" decodeArgType)
|
|
|
|
|
|
decodeFieldType =
|
|
J.map3 ArgType
|
|
(J.field "kind" J.string)
|
|
(J.maybe (J.field "name" J.string))
|
|
(J.field "ofType" decodeLazyArgType)
|
|
|
|
|
|
decodeArgType : Decoder ArgType
|
|
decodeArgType =
|
|
J.map3 ArgType
|
|
(J.field "kind" J.string)
|
|
(J.maybe (J.field "name" J.string))
|
|
(J.field "ofType" decodeLazyArgType)
|
|
|
|
|
|
decodeLazyArgType : Decoder OfArgType
|
|
decodeLazyArgType =
|
|
J.map OfArgType (J.maybe (J.lazy (\_ -> decodeArgType)))
|
|
|
|
|
|
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 }}}}}}}}" ) ])
|
|
|
|
|
|
styleGroup : List ( String, String ) -> List (Attribute Msg)
|
|
styleGroup l =
|
|
List.map (\( k, v ) -> A.style k v) l
|