Fundeps.purs

module GraphQL.FunDeps where

import Prelude

import Data.Either (Either(..))
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Semigroup.Foldable (intercalateMap)
import Data.String as String
import Data.Symbol (class IsSymbol, reflectSymbol)
import Effect.Aff (Aff, attempt, error, throwError)
import Effect.Class.Console as Log
import Fetch (Method(..), fetch)
import Type.Proxy (Proxy(..))
import Type.Row.Homogeneous (class Homogeneous)
import Yoga.JSON (class ReadForeign)
import Yoga.JSON as JSON
import Yoga.JSON.Error (renderHumanError)
import Yoga.JSON.Generics (genericReadForeignUntaggedSum)

data GraphQL

data Gql (operation ∷ GraphQL) = Gql

class
  GraphQLReqRes
    (operation ∷ GraphQL)
    (gql ∷ Symbol)
    (i ∷ Row Type)
    (o ∷ Row Type)
  | operation → gql i o

type Endpoint = String

type GraphQLClient'
  (operation ∷ GraphQL)
  (gql ∷ Symbol)
  (i ∷ Row Type)
  (o ∷ Row Type) =
  GraphQLReqRes operation gql i o ⇒
  IsSymbol gql ⇒
  JSON.WriteForeign { | i } ⇒
  JSON.ReadForeign { | o } ⇒
  Gql operation →
  Record i →
  Aff { | o }

type GraphQLClient =
  ∀ (operation ∷ GraphQL) (gql ∷ Symbol) (i ∷ Row Type) (o ∷ Row Type).
  GraphQLClient' operation gql i o

type GraphQLResponse d =
  { data ∷ Maybe d
  , errors ∷ Maybe (Array GraphQLError)
  }

type GraphQLError =
  { message ∷ String
  , locations ∷ Maybe (Array { line ∷ Int, column ∷ Int })
  , path ∷ Maybe (Array StringOrInt)
  }

data StringOrInt = AString String | AnInt Int

derive instance Generic StringOrInt _
instance ReadForeign StringOrInt where
  readImpl = genericReadForeignUntaggedSum

instance Show StringOrInt where
  show (AString s) = show s
  show (AnInt i) = show i

graphQL ∷ ∀ r. Homogeneous r String ⇒ Endpoint → { | r } → GraphQLClient
graphQL endpoint headers = go
  where
  go ∷
    ∀ (operation ∷ GraphQL) (gql ∷ Symbol) (i ∷ Row Type) (o ∷ Row Type).
    GraphQLReqRes operation gql i o ⇒
    IsSymbol gql ⇒
    JSON.WriteForeign { | i } ⇒
    JSON.ReadForeign { | o } ⇒
    Gql operation →
    Record i →
    Aff { | o }
  go _ variables = do
    let
      input =
        { variables
        , query: String.replaceAll (String.Pattern "\n")
            (String.Replacement " ")
            ( String.replaceAll (String.Pattern "\r\n") (String.Replacement " ")
                (reflectSymbol (Proxy ∷ Proxy gql))
            )
        }
      requestBody = JSON.writeJSON input
    res ← attempt $ fetch endpoint { method: POST, headers, body: requestBody }
    case res of
      Left err → do
        Log.info $ "GraphQL request to " <> endpoint <> " failed"
        throwError (error $ show err)
      Right { status, text } | status /= 200 → do
        body ← text
        Log.info $ "GraphQL request to " <> endpoint <> " failed with status "
          <> show status
        throwError (error $ body)
      Right { json } → do
        fgn ← json
        case JSON.read fgn ∷ Either _ (GraphQLResponse { | o }) of
          Left err → do
            let
              errorsʔ :: Maybe { errors :: Array GraphQLError }
              errorsʔ = JSON.read_ fgn
            let errors = (errorsʔ <#> _.errors) <#> foldMap show
            let
              msg = "GraphQL request to " <> endpoint
                <> " failed with invalid response "
                <> intercalateMap ", " renderHumanError err
                <> (errors # foldMap (" and errors: " <> _))
            Log.info msg
            throwError (error msg)
          Right { data: Nothing, errors: Nothing } → do
            Log.error "GraphQL response is missing both data and errors"
            throwError
              (error $ "GraphQL response is missing both data and errors")
          Right { data: Nothing, errors: Just errors } → do
            Log.error $ "GraphQL response contains errors: " <> show errors
            throwError
              (error $ "GraphQL response contains only errors: " <> show errors)
          Right { data: Just d, errors: Just errors } → do
            Log.warn $ "GraphQL response contains some errors: " <> show errors
            pure d
          Right { data: Just d, errors: Nothing } → do
            pure d