{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client
  ( gql,
    Fetch (..),
    defineQuery,
    defineByDocument,
    defineByDocumentFile,
    defineByIntrospection,
    defineByIntrospectionFile,
    ScalarValue (..),
    GQLScalar (..),
    ID (..),
  )
where

import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as L
  ( readFile,
  )
import Data.Morpheus.Client.Build
  ( defineQuery,
  )
import Data.Morpheus.Client.Fetch
  ( Fetch (..),
  )
import Data.Morpheus.Client.JSONSchema.Parse
  ( decodeIntrospection,
  )
import Data.Morpheus.Core
  ( parseFullGQLDocument,
  )
import Data.Morpheus.QuasiQuoter (gql)
import Data.Morpheus.Types.GQLScalar (GQLScalar (..))
import Data.Morpheus.Types.ID (ID (..))
import Data.Morpheus.Types.Internal.AST
  ( GQLQuery,
    ScalarValue (..),
    Schema,
    VALID,
  )
import Data.Morpheus.Types.Internal.Resolving
  ( Eventless,
  )
import Language.Haskell.TH
import Relude hiding (ByteString)

defineByDocumentFile :: FilePath -> (GQLQuery, String) -> Q [Dec]
defineByDocumentFile :: FilePath -> (GQLQuery, FilePath) -> Q [Dec]
defineByDocumentFile = IO ByteString -> (GQLQuery, FilePath) -> Q [Dec]
defineByDocument (IO ByteString -> (GQLQuery, FilePath) -> Q [Dec])
-> (FilePath -> IO ByteString)
-> FilePath
-> (GQLQuery, FilePath)
-> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
L.readFile

defineByIntrospectionFile :: FilePath -> (GQLQuery, String) -> Q [Dec]
defineByIntrospectionFile :: FilePath -> (GQLQuery, FilePath) -> Q [Dec]
defineByIntrospectionFile = IO ByteString -> (GQLQuery, FilePath) -> Q [Dec]
defineByIntrospection (IO ByteString -> (GQLQuery, FilePath) -> Q [Dec])
-> (FilePath -> IO ByteString)
-> FilePath
-> (GQLQuery, FilePath)
-> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
L.readFile

defineByDocument :: IO ByteString -> (GQLQuery, String) -> Q [Dec]
defineByDocument :: IO ByteString -> (GQLQuery, FilePath) -> Q [Dec]
defineByDocument IO ByteString
doc = IO (Eventless (Schema VALID)) -> (GQLQuery, FilePath) -> Q [Dec]
defineQuery (IO ByteString -> IO (Eventless (Schema VALID))
schemaByDocument IO ByteString
doc)

schemaByDocument :: IO ByteString -> IO (Eventless (Schema VALID))
schemaByDocument :: IO ByteString -> IO (Eventless (Schema VALID))
schemaByDocument IO ByteString
documentGQL = ByteString -> Eventless (Schema VALID)
parseFullGQLDocument (ByteString -> Eventless (Schema VALID))
-> IO ByteString -> IO (Eventless (Schema VALID))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
documentGQL

defineByIntrospection :: IO ByteString -> (GQLQuery, String) -> Q [Dec]
defineByIntrospection :: IO ByteString -> (GQLQuery, FilePath) -> Q [Dec]
defineByIntrospection IO ByteString
json = IO (Eventless (Schema VALID)) -> (GQLQuery, FilePath) -> Q [Dec]
defineQuery (ByteString -> Eventless (Schema VALID)
decodeIntrospection (ByteString -> Eventless (Schema VALID))
-> IO ByteString -> IO (Eventless (Schema VALID))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
json)