{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Client.Internal.Utils ( removeDuplicates, isEnum, getSource, handleResult, getFile, omitNulls, emptyTypeError, takeValueType, ) where import Control.Monad.Except (MonadError (catchError)) import Data.Aeson (Object) import Data.Aeson.Types (Pair, Parser, Value (..), object) import qualified Data.ByteString.Lazy.Char8 as L import Data.FileEmbed (makeRelativeToProject) import Data.List (isSuffixOf) import Data.Morpheus.Client.Internal.Types ( SchemaSource (..), ) import Data.Morpheus.CodeGen.Internal.AST (CodeGenConstructor (..), CodeGenTypeName (..), getFullName) import Data.Morpheus.Error (gqlWarnings, renderGQLErrors) import Data.Morpheus.Internal.Ext (GQLResult, Result (..)) import Data.Morpheus.Internal.Utils (IsMap (lookup)) import Data.Morpheus.Types.Internal.AST (Msg (msg), internal) import qualified Data.Text as T 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 :: [CodeGenConstructor] -> Bool isEnum :: [CodeGenConstructor] -> 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 . CodeGenConstructor -> [CodeGenField] constructorFields) getSource :: FilePath -> Q SchemaSource getSource :: [Char] -> Q SchemaSource getSource [Char] p | [Char] ".json" forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` [Char] p = ByteString -> SchemaSource JSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. ([Char] -> IO a) -> [Char] -> Q a readWith [Char] -> IO ByteString L.readFile [Char] p | [Char] ".gql" forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` [Char] p Bool -> Bool -> Bool || [Char] ".graphql" forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` [Char] p = ByteString -> SchemaSource GQL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. ([Char] -> IO a) -> [Char] -> Q a readWith [Char] -> IO ByteString L.readFile [Char] p | Bool otherwise = forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] "Unsupported file format! The input should have one of the following extensions: json, gql, graphql" getFile :: FilePath -> Q Text getFile :: [Char] -> Q Text getFile = forall a. ([Char] -> IO a) -> [Char] -> Q a readWith [Char] -> IO Text TIO.readFile readWith :: (FilePath -> IO a) -> FilePath -> Q a readWith :: forall a. ([Char] -> IO a) -> [Char] -> Q a readWith [Char] -> IO a f [Char] path = do [Char] p <- [Char] -> Q [Char] makeRelativeToProject [Char] path forall (m :: * -> *). Quasi m => [Char] -> m () qAddDependentFile [Char] p Either [Char] 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 . [Char] -> IO a f) [Char] 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 [Char] a file of Left [Char] x -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] 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 => [Char] -> m a fail (NonEmpty GQLError -> [Char] 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 omitNulls :: [Pair] -> Value omitNulls :: [Pair] -> Value omitNulls = [Pair] -> Value object forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. (a -> Bool) -> [a] -> [a] filter forall {a}. (a, Value) -> Bool notNull where notNull :: (a, Value) -> Bool notNull (a _, Value Null) = Bool False notNull (a, Value) _ = Bool True emptyTypeError :: MonadFail m => CodeGenTypeName -> m a emptyTypeError :: forall (m :: * -> *) a. MonadFail m => CodeGenTypeName -> m a emptyTypeError CodeGenTypeName name = forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail forall a b. (a -> b) -> a -> b $ forall b a. (Show a, IsString b) => a -> b show forall a b. (a -> b) -> a -> b $ GQLError -> GQLError internal (GQLError "Type " forall a. Semigroup a => a -> a -> a <> forall a. Msg a => a -> GQLError msg (CodeGenTypeName -> TypeName getFullName CodeGenTypeName name) forall a. Semigroup a => a -> a -> a <> GQLError " Should Have at least one Constructor") takeValueType :: ((String, Object) -> Parser a) -> Value -> Parser a takeValueType :: forall a. (([Char], Object) -> Parser a) -> Value -> Parser a takeValueType ([Char], Object) -> Parser a f (Object Object hMap) = case forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a lookup Key "__typename" Object hMap of Maybe Value Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] "key \"__typename\" not found on object" Just (String Text x) -> ([Char], Object) -> Parser a f (Text -> [Char] T.unpack Text x, Object hMap) Just Value val -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail forall a b. (a -> b) -> a -> b $ [Char] "key \"__typename\" should be string but found: " forall a. Semigroup a => a -> a -> a <> forall b a. (Show a, IsString b) => a -> b show Value val takeValueType ([Char], Object) -> Parser a _ Value _ = forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] "expected Object"