{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Fetch.ResponseStream
  ( request,
    forEach,
    single,
    ResponseStream,
    GQLClient,
    withHeaders,
  )
where

import Control.Monad.IO.Unlift (MonadUnliftIO)
import Data.Morpheus.Client.Fetch (Args)
import Data.Morpheus.Client.Fetch.GQLClient
import Data.Morpheus.Client.Fetch.Http (httpRequest)
import Data.Morpheus.Client.Fetch.RequestType
  ( ClientTypeConstraint,
    Request (..),
    isSubscription,
  )
import Data.Morpheus.Client.Fetch.Types
import Data.Morpheus.Client.Fetch.WebSockets
  ( endSession,
    receiveResponse,
    responseStream,
    sendInitialRequest,
    sendRequest,
    useWS,
  )
import qualified Data.Text as T
import Relude hiding (ByteString)
import Text.URI (URI, mkURI)

parseURI :: MonadFail m => String -> m URI
parseURI :: forall (m :: * -> *). MonadFail m => String -> m URI
parseURI String
url = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid Endpoint: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show String
url forall a. Semigroup a => a -> a -> a
<> String
"!")) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *). MonadThrow m => Text -> m URI
mkURI (String -> Text
T.pack String
url))

requestSingle :: ResponseStream a -> IO (Either (FetchError a) a)
requestSingle :: forall a. ResponseStream a -> IO (Either (FetchError a) a)
requestSingle ResponseStream {Headers
URI
Request a
_headers :: forall a. ResponseStream a -> Headers
_uri :: forall a. ResponseStream a -> URI
_req :: forall a. ResponseStream a -> Request a
_headers :: Headers
_uri :: URI
_req :: Request a
..}
  | forall a. RequestType a => Request a -> Bool
isSubscription Request a
_req = forall (m :: * -> *) a.
(MonadFail m, MonadIO m, MonadUnliftIO m) =>
URI -> Headers -> (Connection -> m a) -> m a
useWS URI
_uri Headers
_headers forall {m :: * -> *} {a}.
(MonadIO m, FromJSON a) =>
Connection -> m (GQLClientResult a)
wsApp
  | Bool
otherwise = forall a.
(FromJSON a, RequestType a, ToJSON (RequestArgs a)) =>
URI -> Request a -> Headers -> IO (GQLClientResult a)
httpRequest URI
_uri Request a
_req Headers
_headers
  where
    wsApp :: Connection -> m (GQLClientResult a)
wsApp Connection
conn = do
      let sid :: Text
sid = Text
"0243134"
      forall (m :: * -> *). MonadIO m => Connection -> m ()
sendInitialRequest Connection
conn
      forall a (m :: * -> *).
(RequestType a, ToJSON (RequestArgs a), MonadIO m) =>
Connection -> Text -> Request a -> m ()
sendRequest Connection
conn Text
sid Request a
_req
      GQLClientResult a
x <- forall {m :: * -> *} {a}.
(MonadIO m, FromJSON a) =>
Connection -> m (GQLClientResult a)
receiveResponse Connection
conn
      forall (m :: * -> *). MonadIO m => Connection -> Text -> m ()
endSession Connection
conn Text
sid
      forall (f :: * -> *) a. Applicative f => a -> f a
pure GQLClientResult a
x

requestMany :: (MonadIO m, MonadUnliftIO m, MonadFail m) => (GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany GQLClientResult a -> m ()
f ResponseStream {Headers
URI
Request a
_headers :: Headers
_uri :: URI
_req :: Request a
_headers :: forall a. ResponseStream a -> Headers
_uri :: forall a. ResponseStream a -> URI
_req :: forall a. ResponseStream a -> Request a
..}
  | forall a. RequestType a => Request a -> Bool
isSubscription Request a
_req = forall (m :: * -> *) a.
(MonadFail m, MonadIO m, MonadUnliftIO m) =>
URI -> Headers -> (Connection -> m a) -> m a
useWS URI
_uri Headers
_headers Connection -> m ()
appWS
  | Bool
otherwise = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a.
(FromJSON a, RequestType a, ToJSON (RequestArgs a)) =>
URI -> Request a -> Headers -> IO (GQLClientResult a)
httpRequest URI
_uri Request a
_req Headers
_headers) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GQLClientResult a -> m ()
f
  where
    appWS :: Connection -> m ()
appWS Connection
conn = do
      let sid :: Text
sid = Text
"0243134"
      forall (m :: * -> *). MonadIO m => Connection -> m ()
sendInitialRequest Connection
conn
      forall a (m :: * -> *).
(RequestType a, ToJSON (RequestArgs a), MonadIO m) =>
Connection -> Text -> Request a -> m ()
sendRequest Connection
conn Text
sid Request a
_req
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GQLClientResult a -> m ()
f) (forall a (m :: * -> *).
(FromJSON a, MonadIO m) =>
Connection -> [m (GQLClientResult a)]
responseStream Connection
conn)
      forall (m :: * -> *). MonadIO m => Connection -> Text -> m ()
endSession Connection
conn Text
sid

-- PUBLIC API
data ResponseStream a = ClientTypeConstraint a =>
  ResponseStream
  { forall a. ResponseStream a -> Request a
_req :: Request a,
    forall a. ResponseStream a -> URI
_uri :: URI,
    forall a. ResponseStream a -> Headers
_headers :: Headers
    -- _wsConnection :: Connection
  }

request :: (ClientTypeConstraint a, MonadFail m) => GQLClient -> Args a -> m (ResponseStream a)
request :: forall a (m :: * -> *).
(ClientTypeConstraint a, MonadFail m) =>
GQLClient -> Args a -> m (ResponseStream a)
request GQLClient {String
clientURI :: GQLClient -> String
clientURI :: String
clientURI, Headers
clientHeaders :: GQLClient -> Headers
clientHeaders :: Headers
clientHeaders} Args a
requestArgs = do
  URI
_uri <- forall (m :: * -> *). MonadFail m => String -> m URI
parseURI String
clientURI
  let _req :: Request a
_req = Request {Args a
requestArgs :: RequestArgs a
requestArgs :: Args a
requestArgs}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseStream {Request a
_req :: Request a
_req :: Request a
_req, URI
_uri :: URI
_uri :: URI
_uri, _headers :: Headers
_headers = Headers
clientHeaders}

-- | returns first response from the server
single :: MonadIO m => ResponseStream a -> m (GQLClientResult a)
single :: forall (m :: * -> *) a.
MonadIO m =>
ResponseStream a -> m (GQLClientResult a)
single = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ResponseStream a -> IO (Either (FetchError a) a)
requestSingle

-- | returns loop listening subscription events forever. if you want to run it in background use `forkIO`
forEach :: (MonadIO m, MonadUnliftIO m, MonadFail m) => (GQLClientResult a -> m ()) -> ResponseStream a -> m ()
forEach :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
forEach = forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany