{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Internal.Utils
  ( removeDuplicates,
    isEnum,
    getSource,
    handleResult,
    getFile,
  )
where

import Control.Monad.Except (MonadError (catchError))
import qualified Data.ByteString.Lazy.Char8 as L
import Data.FileEmbed (makeRelativeToProject)
import Data.List (isSuffixOf)
import Data.Morpheus.Client.Internal.Types
  ( ClientConstructorDefinition (cFields),
    SchemaSource (..),
  )
import Data.Morpheus.Error (gqlWarnings, renderGQLErrors)
import Data.Morpheus.Internal.Ext (GQLResult, Result (..))
import qualified Data.Text.IO as TIO
import Language.Haskell.TH (Q, runIO)
import Language.Haskell.TH.Syntax (qAddDependentFile)
import Relude

removeDuplicates :: Eq a => [a] -> [a]
removeDuplicates :: forall a. Eq a => [a] -> [a]
removeDuplicates = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> ([a], [a])
splitDuplicates

splitDuplicates :: Eq a => [a] -> ([a], [a])
splitDuplicates :: forall a. Eq a => [a] -> ([a], [a])
splitDuplicates = forall a. Eq a => ([a], [a]) -> [a] -> ([a], [a])
collectElems ([], [])
  where
    collectElems :: Eq a => ([a], [a]) -> [a] -> ([a], [a])
    collectElems :: forall a. Eq a => ([a], [a]) -> [a] -> ([a], [a])
collectElems ([a], [a])
collected [] = ([a], [a])
collected
    collectElems ([a]
collected, [a]
errors) (a
x : [a]
xs)
      | a
x forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [a]
collected = forall a. Eq a => ([a], [a]) -> [a] -> ([a], [a])
collectElems ([a]
collected, [a]
errors forall a. Semigroup a => a -> a -> a
<> [a
x]) [a]
xs
      | Bool
otherwise = forall a. Eq a => ([a], [a]) -> [a] -> ([a], [a])
collectElems ([a]
collected forall a. Semigroup a => a -> a -> a
<> [a
x], [a]
errors) [a]
xs

isEnum :: [ClientConstructorDefinition] -> Bool
isEnum :: [ClientConstructorDefinition] -> Bool
isEnum = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientConstructorDefinition -> [FieldDefinition ANY VALID]
cFields)

getSource :: FilePath -> Q SchemaSource
getSource :: FilePath -> Q SchemaSource
getSource FilePath
p
  | FilePath
".json" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
p = ByteString -> SchemaSource
JSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (FilePath -> IO a) -> FilePath -> Q a
readWith FilePath -> IO ByteString
L.readFile FilePath
p
  | FilePath
".gql" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
p Bool -> Bool -> Bool
|| FilePath
".graphql" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
p = ByteString -> SchemaSource
GQL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (FilePath -> IO a) -> FilePath -> Q a
readWith FilePath -> IO ByteString
L.readFile FilePath
p
  | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Unsupported file format! The input should have one of the following extensions: json, gql, graphql"

getFile :: FilePath -> Q Text
getFile :: FilePath -> Q Text
getFile = forall a. (FilePath -> IO a) -> FilePath -> Q a
readWith FilePath -> IO Text
TIO.readFile

readWith :: (FilePath -> IO a) -> FilePath -> Q a
readWith :: forall a. (FilePath -> IO a) -> FilePath -> Q a
readWith FilePath -> IO a
f FilePath
path = do
  FilePath
p <- FilePath -> Q FilePath
makeRelativeToProject FilePath
path
  forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
p
  Either FilePath a
file <- forall a. IO a -> Q a
runIO (forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO a
f) FilePath
p) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show))
  case Either FilePath a
file of
    Left FilePath
x -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
x
    Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

handleResult :: GQLResult t -> (t -> Q a) -> Q a
handleResult :: forall t a. GQLResult t -> (t -> Q a) -> Q a
handleResult GQLResult t
x t -> Q a
f = case GQLResult t
x of
  Failure NonEmpty GQLError
errors -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (NonEmpty GQLError -> FilePath
renderGQLErrors NonEmpty GQLError
errors)
  Success
    { t
result :: forall err a. Result err a -> a
result :: t
result,
      [GQLError]
warnings :: forall err a. Result err a -> [err]
warnings :: [GQLError]
warnings
    } -> [GQLError] -> Q ()
gqlWarnings [GQLError]
warnings forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> Q a
f t
result