{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Fetch.GQLClient
  ( GQLClient (..),
    withHeaders,
    Headers,
    Header,
  )
where

import Relude hiding (ByteString)

type Headers = Map Text Text

type Header = (Text, Text)

data GQLClient = GQLClient
  { GQLClient -> Headers
clientHeaders :: Headers,
    GQLClient -> String
clientURI :: String
  }

instance IsString GQLClient where
  fromString :: String -> GQLClient
fromString String
clientURI =
    GQLClient
      { String
clientURI :: String
clientURI :: String
clientURI,
        clientHeaders :: Headers
clientHeaders = forall l. IsList l => [Item l] -> l
fromList [(Text
"Content-Type", Text
"application/json")]
      }

withHeaders :: GQLClient -> [Header] -> GQLClient
withHeaders :: GQLClient -> [Header] -> GQLClient
withHeaders GQLClient {String
Headers
clientURI :: String
clientHeaders :: Headers
clientURI :: GQLClient -> String
clientHeaders :: GQLClient -> Headers
..} [Header]
headers = GQLClient {clientHeaders :: Headers
clientHeaders = Headers
clientHeaders forall a. Semigroup a => a -> a -> a
<> forall l. IsList l => [Item l] -> l
fromList [Header]
headers, String
clientURI :: String
clientURI :: String
..}