Mark Eibes
2023-06-19T11:45:49Z

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