{-# 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