module Main exposing (main)

-- import Html.Lazy as HLazy

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)


main : Program () Model Msg
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
    , collapsedIntrospections : OrderedDict String Bool
    }


init : () -> ( Model, Cmd Msg )
init _ =
    ( Model "https://www.graphqlhub.com/graphql" OrderedDict.empty OrderedDict.empty, Cmd.none )


type Msg
    = UpdateIntrospectUrl String
    | RequestIntrospection
    | IntrospectionRequest String (Result Http.Error Introspection)
    | CollapseIntrospection String
    | UncollapseIntrospection String


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        CollapseIntrospection url ->
            ( { model | collapsedIntrospections = OrderedDict.insert url True model.collapsedIntrospections }, Cmd.none )

        UncollapseIntrospection url ->
            ( { model | collapsedIntrospections = OrderedDict.insert url False model.collapsedIntrospections }, Cmd.none )

        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
                        (Maybe.withDefault False (Dict.get u model.collapsedIntrospections.dict))
                        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.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 : Bool -> String -> Maybe IntrospectionResult -> Maybe (Html Msg)
introspectionResultView is_hidden url mir =
    Maybe.map
        (\ir ->
            H.li
                (styleGroup
                    [ ( "background-color", lighten )
                    , ( "padding", "0.5em" )
                    , ( "border-radius", "0.5em" )
                    , ( "margin", "0 0.25em 0.25em 0.25em" )
                    ]
                )
                (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 ]
                    , H.span
                        [ Ev.onClick ((if is_hidden then UncollapseIntrospection else CollapseIntrospection) url) ]
                        [ H.text (if is_hidden then "Show" else "Hide") ]
                    ]
                    :: (case ir of
                            Loading ->
                                [ H.text "Loading..." ]

                            Error e ->
                                [ H.text ("Error: " ++ httpErrorToString e) ]

                            Success i ->
                                if not is_hidden then
                                    [ introspectionView i ]
                                else
                                    [ collapsedIntrospectionView i url ]
                       )
                )
        )
        mir


collapsedIntrospectionView : Introspection -> String -> Html Msg
collapsedIntrospectionView i url = H.div [ Ev.onClick (UncollapseIntrospection url) ] [ H.text "Expand" ]

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 ->
                    not
                        (List.member t.name <|
                            List.filterMap identity [ i.mutationType, i.queryType ]
                        )
                        && not (String.startsWith "__" t.kind)
                )
                i.types

        sg =
            styleGroup [ ( "margin", "1em 0" ) ]

        rootQueryTypes = Debug.log "i.queryType" (
                i.queryType
                |> Maybe.andThen (\a -> Dict.get a types.dict)
                |> Maybe.andThen .fields
                |> Maybe.map (List.map fieldView)
                |> Maybe.withDefault []
            )
    in
    H.div []
        [ H.div sg 
            [ H.h2 [] [ H.text ("Query Types (" ++ (Maybe.withDefault "N/A" i.queryType) ++ ")") ]
            , H.div (styleGroup [ ( "margin-left", "2em" ) ]) rootQueryTypes
            ]
        , 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.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

        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 "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))
            )
        )


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 : Decoder PossibleType
decodePossibleType =
    decodeArgType


decodeEnumValue : Decoder J.Value
decodeEnumValue =
    J.value


decodeInterface : Decoder 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 : Decoder ArgType
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


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