{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Client.CodeGen.Utils ( getSource, handleResult, getFile, readSchemaSource, ) 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.Fetch.Types ( 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 readSchemaSource :: FilePath -> IO SchemaSource readSchemaSource :: [Char] -> IO SchemaSource readSchemaSource [Char] p | [Char] ".json" [Char] -> [Char] -> Bool forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` [Char] p = ByteString -> SchemaSource JSON (ByteString -> SchemaSource) -> IO ByteString -> IO SchemaSource forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Char] -> IO ByteString L.readFile [Char] p | [Char] ".gql" [Char] -> [Char] -> Bool forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` [Char] p Bool -> Bool -> Bool || [Char] ".graphql" [Char] -> [Char] -> Bool forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` [Char] p = ByteString -> SchemaSource GQL (ByteString -> SchemaSource) -> IO ByteString -> IO SchemaSource forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Char] -> IO ByteString L.readFile [Char] p | Bool otherwise = [Char] -> IO SchemaSource forall a. [Char] -> IO a 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" getSource :: FilePath -> Q SchemaSource getSource :: [Char] -> Q SchemaSource getSource = ([Char] -> IO SchemaSource) -> [Char] -> Q SchemaSource forall a. ([Char] -> IO a) -> [Char] -> Q a readWith [Char] -> IO SchemaSource readSchemaSource getFile :: FilePath -> Q Text getFile :: [Char] -> Q Text getFile = ([Char] -> IO Text) -> [Char] -> Q Text 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 [Char] -> Q () forall (m :: * -> *). Quasi m => [Char] -> m () qAddDependentFile [Char] p Either [Char] a file <- IO (Either [Char] a) -> Q (Either [Char] a) forall a. IO a -> Q a runIO (IO (Either [Char] a) -> (IOException -> IO (Either [Char] a)) -> IO (Either [Char] a) forall a. IO a -> (IOException -> IO a) -> IO a forall e (m :: * -> *) a. MonadError e m => m a -> (e -> m a) -> m a catchError (((a -> Either [Char] a) -> IO a -> IO (Either [Char] a) forall a b. (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Either [Char] a forall a b. b -> Either a b Right (IO a -> IO (Either [Char] a)) -> ([Char] -> IO a) -> [Char] -> IO (Either [Char] a) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> IO a f) [Char] p) (Either [Char] a -> IO (Either [Char] a) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Either [Char] a -> IO (Either [Char] a)) -> (IOException -> Either [Char] a) -> IOException -> IO (Either [Char] a) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> Either [Char] a forall a b. a -> Either a b Left ([Char] -> Either [Char] a) -> (IOException -> [Char]) -> IOException -> Either [Char] a forall b c a. (b -> c) -> (a -> b) -> a -> c . IOException -> [Char] forall b a. (Show a, IsString b) => a -> b show)) case Either [Char] a file of Left [Char] x -> [Char] -> Q a forall a. [Char] -> Q a forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] x Right a x -> a -> Q a forall a. a -> Q a 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 -> [Char] -> Q a forall a. [Char] -> Q a forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail (NonEmpty GQLError -> [Char] renderGQLErrors NonEmpty GQLError errors) Success { t result :: t result :: forall err a. Result err a -> a result, [GQLError] warnings :: [GQLError] warnings :: forall err a. Result err a -> [err] warnings } -> [GQLError] -> Q () gqlWarnings [GQLError] warnings Q () -> Q a -> Q a forall a b. Q a -> Q b -> Q b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> t -> Q a f t result