-- For constraints generated by componentized fixtures, which we don't care to
-- have to restate.
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

-- | Test that naming conventions source customization applies correctly to
-- various names generated by the system.
module Test.NamingConventionsSpec (spec) where

import Data.Aeson (Value)
import Harness.GraphqlEngine (postGraphql)
import Harness.Quoter.Graphql (graphql)
import Harness.Quoter.Yaml (interpolateYaml)
import Harness.Schema (Table (..), table)
import Harness.Schema qualified as Schema
import Harness.Services.Composed
import Harness.TestEnvironment (GlobalTestEnvironment)
import Harness.Yaml
import Hasura.Prelude
import Test.Hspec

spec :: SpecWith GlobalTestEnvironment
spec =
  withHge
    ( emptyHgeConfig
        { hgeConfigEnvironmentVars =
            [ ("HASURA_GRAPHQL_EXPERIMENTAL_FEATURES", "naming_convention"),
              ("HASURA_FF_NAMING_CONVENTION_SEP_2023", "True")
            ]
        }
    )
    $ tests

withNamingConvention ::
  (_) =>
  NamingConvention ->
  SpecWith
    ( Schema.SchemaName,
      (PostgresSource, testEnvironment)
    ) ->
  SpecWith testEnvironment
withNamingConvention namingConvention =
  withPostgresSourceCustomized
    "postgres-source"
    PostgresSourceCustomization
      { pscNamingConvention = Just namingConvention
      }
    . withSchemaName "test_schema"
    . withPostgresSchema schema
    . describe ("Naming convention " <> show namingConvention)

--------------------------------------------------------------------------------
-- Schema

schema :: [Schema.Table]
schema =
  [ (table "foo")
      { tableColumns =
          [ Schema.column "foo_column_a" Schema.TInt,
            Schema.column "FooColumnB" Schema.TStr
          ],
        tablePrimaryKey = ["foo_column_a"]
      }
  ]

setupFunction :: (_) => testEnvironment -> IO ()
setupFunction testEnvironment = do
  void
    $ hgePostV2Query
      testEnvironment
      [interpolateYaml|
       type: run_sql
       args:
         source: postgres-source
         sql: |
           CREATE or REPLACE FUNCTION test_schema.foo_function(foo_arg_a int, "FooArgB" int)
             RETURNS SETOF test_schema.foo AS
             $$
             SELECT * FROM test_schema.foo
             $$ LANGUAGE SQL;
    |]

  void
    $ hgePostMetadata
      testEnvironment
      [interpolateYaml|
       type: pg_track_function
       args:
        source: postgres-source
        function:
          schema: test_schema
          name: foo_function
    |]

setupTypes :: (_) => testEnvironment -> IO ()
setupTypes testEnvironment = do
  void
    $ hgePostV2Query
      testEnvironment
      [interpolateYaml|
       type: run_sql
       args:
         source: postgres-source
         sql: |
           CREATE TYPE test_schema.an_interesting_type AS (some_field int, anotherField int);

           CREATE TABLE test_schema.an_interesting_table (
             scalar_col test_schema.an_interesting_type,
             array_col test_schema.an_interesting_type[],
             builtin_typed_column uuid
           );
    |]

  void
    $ hgePostMetadata
      testEnvironment
      [interpolateYaml|
       type: pg_track_table
       args:
        source: postgres-source
        table:
          schema: test_schema
          name: an_interesting_table
    |]

--------------------------------------------------------------------------------
-- Tests

tests ::
  forall testEnvironment.
  (_) =>
  SpecWith testEnvironment
tests = do
  updateColumnTests
  functionArgsTests
  typeTests

typeTests ::
  forall testEnvironment.
  (_) =>
  SpecWith testEnvironment
typeTests = do
  withNamingConvention GraphQLDefault $ do
    it "Affects scalar type names" \testEnvironment -> do
      setupTypes testEnvironment

      let expected :: Value
          expected =
            [interpolateYaml|
              data:
                __type:
                  fields:
                  - name: arrayCol
                    type:
                      kind: LIST
                      name: null
                      ofType:
                        kind: NON_NULL
                        name: null
                        ofType:
                          kind: SCALAR
                          name: AnInterestingType
                  - name: builtinTypedColumn
                    type:
                      kind: SCALAR
                      name: Uuid
                      ofType: null
                  - name: scalarCol
                    type:
                      kind: SCALAR
                      name: AnInterestingTypeScalar
                      ofType: null
                  kind: OBJECT
            |]

      actual <-
        postGraphql
          testEnvironment
          [graphql|
            query MyQuery {
              __type(name: "TestSchemaAnInterestingTable") {
                kind
                fields {
                  name
                  type {
                    name
                    kind
                    ofType {
                      name
                      kind
                      ofType {
                        name
                        kind
                      }
                    }
                  }
                }
              }
            }
          |]

      shouldBeYaml actual expected

  withNamingConvention HasuraDefault $ do
    it "Doesn't affect scalar type names" \testEnvironment -> do
      setupTypes testEnvironment

      let expected :: Value
          expected =
            [interpolateYaml|
              data:
                __type:
                  fields:
                  - name: array_col
                    type:
                      kind: LIST
                      name: null
                      ofType:
                        kind: NON_NULL
                        name: null
                        ofType:
                          kind: SCALAR
                          name: an_interesting_type
                  - name: builtin_typed_column
                    type:
                      kind: SCALAR
                      name: uuid
                      ofType: null
                  - name: scalar_col
                    type:
                      kind: SCALAR
                      name: an_interesting_type_scalar
                      ofType: null
                  kind: OBJECT
            |]

      actual <-
        postGraphql
          testEnvironment
          [graphql|
            query MyQuery {
              __type(name: "test_schema_an_interesting_table") {
                kind
                fields {
                  name
                  type {
                    name
                    kind
                    ofType {
                      name
                      kind
                      ofType {
                        name
                        kind
                      }
                    }
                  }
                }
              }
            }
          |]

      shouldBeYaml actual expected

functionArgsTests ::
  forall testEnvironment.
  (_) =>
  SpecWith testEnvironment
functionArgsTests = do
  withNamingConvention GraphQLDefault $ do
    it "Affects function argument names" \testEnvironment -> do
      setupFunction testEnvironment

      let expected :: Value
          expected =
            [interpolateYaml|
              data:
                __type:
                  inputFields:
                  - name: fooArgA
                  - name: fooArgB
                  kind: INPUT_OBJECT
            |]

      actual <-
        postGraphql
          testEnvironment
          [graphql|
            query MyQuery {
              __type(name: "TestSchemaFooFunctionArgs") {
                kind
                inputFields { name}
              }
            }
          |]

      shouldBeYaml actual expected

  withNamingConvention HasuraDefault $ do
    it "Doesn't affect function argument names" \testEnvironment -> do
      setupFunction testEnvironment

      let expected :: Value
          expected =
            [interpolateYaml|
              data:
                __type:
                  inputFields:
                  - name: FooArgB
                  - name: foo_arg_a
                  kind: INPUT_OBJECT
            |]

      actual <-
        postGraphql
          testEnvironment
          [graphql|
            query MyQuery {
              __type(name: "test_schema_foo_function_args") {
                kind
                inputFields { name}
              }
            }
          |]

      shouldBeYaml actual expected

updateColumnTests ::
  forall testEnvironment.
  (_) =>
  SpecWith testEnvironment
updateColumnTests = do
  withNamingConvention GraphQLDefault $ do
    it "Affects the UpdateColumn enum" \testEnvironment -> do
      let expected :: Value
          expected =
            [interpolateYaml|
              data:
                __type:
                  enumValues:
                  - name: fooColumnA
                  - name: fooColumnB
                  kind: ENUM
            |]

      actual <-
        postGraphql
          testEnvironment
          [graphql|
            query MyQuery {
              __type(name: "TestSchemaFooUpdateColumn") {
                kind
                enumValues {
                  name
                }
              }
            }
          |]

      shouldBeYaml actual expected

  withNamingConvention HasuraDefault $ do
    it "Doesn't affect the UpdateColumn enum" \testEnvironment -> do
      let expected :: Value
          expected =
            [interpolateYaml|
              data:
                __type:
                  enumValues:
                  - name: FooColumnB
                  - name: foo_column_a
                  kind: ENUM
            |]

      actual <-
        postGraphql
          testEnvironment
          [graphql|
            query MyQuery {
              __type(name: "test_schema_foo_update_column") {
                kind
                enumValues {
                  name
                }
              }
            }
          |]

      shouldBeYaml actual expected
