{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Data.GraphQL.Monad (
MonadGraphQLQuery (..),
runQuery,
runQuerySafeIO,
GraphQLSettings (..),
defaultGraphQLSettings,
GraphQLManager,
initGraphQLManager,
GraphQLQueryT,
runGraphQLQueryT,
) where
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.IO.Unlift (MonadUnliftIO (..))
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Control.Monad.Trans.Class (MonadTrans)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Schema (Object)
import Network.HTTP.Client (
Manager,
ManagerSettings,
Request (..),
RequestBody (..),
httpLbs,
newManager,
parseUrlThrow,
responseBody,
)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types (hContentType)
import Data.GraphQL.Monad.Class
import Data.GraphQL.Query (GraphQLQuery (..))
import Data.GraphQL.Result (GraphQLResult)
data GraphQLSettings = GraphQLSettings
{ GraphQLSettings -> ManagerSettings
managerSettings :: ManagerSettings
, GraphQLSettings -> String
url :: String
, GraphQLSettings -> Request -> Request
modifyReq :: Request -> Request
}
defaultGraphQLSettings :: GraphQLSettings
defaultGraphQLSettings :: GraphQLSettings
defaultGraphQLSettings =
GraphQLSettings
{ managerSettings :: ManagerSettings
managerSettings = ManagerSettings
tlsManagerSettings
, url :: String
url = forall a. HasCallStack => String -> a
error String
"No URL is provided"
, modifyReq :: Request -> Request
modifyReq = forall a. a -> a
id
}
data GraphQLManager = GraphQLManager
{ GraphQLManager -> Manager
manager :: Manager
, GraphQLManager -> Request
baseReq :: Request
}
initGraphQLManager :: GraphQLSettings -> IO GraphQLManager
initGraphQLManager :: GraphQLSettings -> IO GraphQLManager
initGraphQLManager GraphQLSettings{String
ManagerSettings
Request -> Request
modifyReq :: Request -> Request
url :: String
managerSettings :: ManagerSettings
modifyReq :: GraphQLSettings -> Request -> Request
url :: GraphQLSettings -> String
managerSettings :: GraphQLSettings -> ManagerSettings
..} = do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
managerSettings
Request
baseReq <- Request -> Request
modifyReq forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
modifyReq' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
url
forall (m :: * -> *) a. Monad m => a -> m a
return GraphQLManager{Request
Manager
baseReq :: Request
manager :: Manager
baseReq :: Request
manager :: Manager
..}
where
modifyReq' :: Request -> Request
modifyReq' Request
req =
Request
req
{ method :: Method
method = Method
"POST"
, requestHeaders :: RequestHeaders
requestHeaders = (HeaderName
hContentType, Method
"application/json") forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req
}
runQuerySafeIO ::
(GraphQLQuery query, schema ~ ResultSchema query) =>
GraphQLManager ->
query ->
IO (GraphQLResult (Object schema))
runQuerySafeIO :: forall query (schema :: Schema).
(GraphQLQuery query, schema ~ ResultSchema query) =>
GraphQLManager -> query -> IO (GraphQLResult (Object schema))
runQuerySafeIO GraphQLManager{Request
Manager
baseReq :: Request
manager :: Manager
baseReq :: GraphQLManager -> Request
manager :: GraphQLManager -> Manager
..} query
query = Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response ByteString -> IO (GraphQLResult (Object schema))
decodeBody
where
request :: Request
request =
Request
baseReq
{ requestBody :: RequestBody
requestBody =
ByteString -> RequestBody
RequestBodyLBS forall a b. (a -> b) -> a -> b
$
forall a. ToJSON a => a -> ByteString
Aeson.encode forall a b. (a -> b) -> a -> b
$
[Pair] -> Value
Aeson.object
[ Key
"query" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall query. GraphQLQuery query => query -> Text
getQueryText query
query
, Key
"variables" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall query. GraphQLQuery query => query -> Value
getArgs query
query
]
}
decodeBody :: Response ByteString -> IO (GraphQLResult (Object schema))
decodeBody = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody
newtype GraphQLQueryT m a = GraphQLQueryT {forall (m :: * -> *) a.
GraphQLQueryT m a -> ReaderT GraphQLManager m a
unGraphQLQueryT :: ReaderT GraphQLManager m a}
deriving
( forall a b. a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall a b. (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall (m :: * -> *) a b.
Functor m =>
a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GraphQLQueryT m b -> GraphQLQueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> GraphQLQueryT m b -> GraphQLQueryT m a
fmap :: forall a b. (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
Functor
, forall a. a -> GraphQLQueryT m a
forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall a b.
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall a b c.
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (GraphQLQueryT m)
forall (m :: * -> *) a. Applicative m => a -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
<* :: forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
*> :: forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
<*> :: forall a b.
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
pure :: forall a. a -> GraphQLQueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> GraphQLQueryT m a
Applicative
, forall a. a -> GraphQLQueryT m a
forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall a b.
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
forall {m :: * -> *}. Monad m => Applicative (GraphQLQueryT m)
forall (m :: * -> *) a. Monad m => a -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> GraphQLQueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> GraphQLQueryT m a
>> :: forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
>>= :: forall a b.
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
Monad
, forall a. IO a -> GraphQLQueryT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (GraphQLQueryT m)
forall (m :: * -> *) a. MonadIO m => IO a -> GraphQLQueryT m a
liftIO :: forall a. IO a -> GraphQLQueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> GraphQLQueryT m a
MonadIO
, forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
MonadTrans
)
instance MonadUnliftIO m => MonadUnliftIO (GraphQLQueryT m) where
withRunInIO :: forall b.
((forall a. GraphQLQueryT m a -> IO a) -> IO b)
-> GraphQLQueryT m b
withRunInIO (forall a. GraphQLQueryT m a -> IO a) -> IO b
inner = forall (m :: * -> *) a.
ReaderT GraphQLManager m a -> GraphQLQueryT m a
GraphQLQueryT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT GraphQLManager m a -> IO a
run -> (forall a. GraphQLQueryT m a -> IO a) -> IO b
inner (forall a. ReaderT GraphQLManager m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
GraphQLQueryT m a -> ReaderT GraphQLManager m a
unGraphQLQueryT)
instance MonadIO m => MonadGraphQLQuery (GraphQLQueryT m) where
runQuerySafe :: forall query (schema :: Schema).
(GraphQLQuery query, schema ~ ResultSchema query) =>
query -> GraphQLQueryT m (GraphQLResult (Object schema))
runQuerySafe query
query = do
GraphQLManager
manager <- forall (m :: * -> *) a.
ReaderT GraphQLManager m a -> GraphQLQueryT m a
GraphQLQueryT forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall query (schema :: Schema).
(GraphQLQuery query, schema ~ ResultSchema query) =>
GraphQLManager -> query -> IO (GraphQLResult (Object schema))
runQuerySafeIO GraphQLManager
manager query
query
runGraphQLQueryT :: MonadIO m => GraphQLSettings -> GraphQLQueryT m a -> m a
runGraphQLQueryT :: forall (m :: * -> *) a.
MonadIO m =>
GraphQLSettings -> GraphQLQueryT m a -> m a
runGraphQLQueryT GraphQLSettings
settings GraphQLQueryT m a
m = do
GraphQLManager
manager <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ GraphQLSettings -> IO GraphQLManager
initGraphQLManager GraphQLSettings
settings
(forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` GraphQLManager
manager) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
GraphQLQueryT m a -> ReaderT GraphQLManager m a
unGraphQLQueryT forall a b. (a -> b) -> a -> b
$ GraphQLQueryT m a
m