{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}
-- |
-- Module: Network.Greskell.WebSocket.Client.Impl
-- Description: 
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __Internal module__. It's like
-- "Network.Greskell.WebSocket.Connection.Impl".
module Network.Greskell.WebSocket.Client.Impl
       where

import Control.Applicative ((<$>), (<*>))
import Control.Concurrent.STM
  ( STM, atomically,
    TVar, newTVarIO, readTVar, writeTVar
  )
import Control.Exception.Safe
  ( throw, Typeable, Exception, SomeException, catch
  )
import Data.Aeson (Object)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson (Parser)
import Data.Greskell.Greskell (ToGreskell(GreskellReturn), toGremlin)
import Data.Greskell.GraphSON (GraphSON, gsonValue, GValue, FromGraphSON(..), parseEither)
import Data.Greskell.AsIterator (AsIterator(IteratorItem))
import Data.Monoid (mempty)
import Data.Vector (Vector, (!))
import Data.Text (Text)
import Data.Traversable (traverse)
import Data.Vector (Vector)

import Network.Greskell.WebSocket.Client.Options (Options)
import qualified Network.Greskell.WebSocket.Client.Options as Opt
import Network.Greskell.WebSocket.Connection
  ( Host, Port, Connection, ResponseHandle
  )
import qualified Network.Greskell.WebSocket.Connection as Conn
import qualified Network.Greskell.WebSocket.Request.Standard as ReqStd
import Network.Greskell.WebSocket.Response (ResponseCode, ResponseMessage)
import qualified Network.Greskell.WebSocket.Response as Res
import Network.Greskell.WebSocket.Util (slurp, drain)


-- | A client that establishes a connection to the Gremlin Server. You
-- can send Gremlin expression for evaluation by 'submit' function.
data Client =
  Client
  { Client -> Options
clientOpts :: Options,
    Client -> Connection GValue
clientConn :: Connection GValue
  }

-- | Create a 'Client' to a Gremlin Server, with the default 'Options'.
connect :: Host -> Port -> IO Client
connect :: Host -> Port -> IO Client
connect = Options -> Host -> Port -> IO Client
connectWith Options
Opt.defOptions

-- | Create a 'Client' to a Gremlin Server.
connectWith :: Options -> Host -> Port -> IO Client
connectWith :: Options -> Host -> Port -> IO Client
connectWith Options
opts Host
host Port
port = do
  Connection GValue
conn <- Settings GValue -> Host -> Port -> IO (Connection GValue)
forall s. Settings s -> Host -> Port -> IO (Connection s)
Conn.connect (Options -> Settings GValue
Opt.connectionSettings Options
opts) Host
host Port
port
  Client -> IO Client
forall (m :: * -> *) a. Monad m => a -> m a
return (Client -> IO Client) -> Client -> IO Client
forall a b. (a -> b) -> a -> b
$ Client :: Options -> Connection GValue -> Client
Client { $sel:clientOpts:Client :: Options
clientOpts = Options
opts,
                    $sel:clientConn:Client :: Connection GValue
clientConn = Connection GValue
conn
                  }

-- | Close the connection to the server and release other resources of
-- the 'Client'.
close :: Client -> IO ()
close :: Client -> IO ()
close Client
c = Connection GValue -> IO ()
forall s. Connection s -> IO ()
Conn.close (Connection GValue -> IO ()) -> Connection GValue -> IO ()
forall a b. (a -> b) -> a -> b
$ Client -> Connection GValue
clientConn Client
c

data HandleState =
    HandleOpen
  | HandleClose
  | HandleError SomeException
  deriving (Port -> HandleState -> ShowS
[HandleState] -> ShowS
HandleState -> Host
(Port -> HandleState -> ShowS)
-> (HandleState -> Host)
-> ([HandleState] -> ShowS)
-> Show HandleState
forall a.
(Port -> a -> ShowS) -> (a -> Host) -> ([a] -> ShowS) -> Show a
showList :: [HandleState] -> ShowS
$cshowList :: [HandleState] -> ShowS
show :: HandleState -> Host
$cshow :: HandleState -> Host
showsPrec :: Port -> HandleState -> ShowS
$cshowsPrec :: Port -> HandleState -> ShowS
Show)

-- | A handle to receive the result of evaluation of a Gremlin script
-- from the server.
data ResultHandle v =
  ResultHandle
  { ResultHandle v -> ResponseHandle GValue
rhResHandle :: ResponseHandle GValue,
    ResultHandle v -> GValue -> Either Host (Vector v)
rhParseGValue :: GValue -> Either String (Vector v),
    ResultHandle v -> TVar (Vector v)
rhResultCache :: TVar (Vector v),
    ResultHandle v -> TVar Port
rhNextResultIndex :: TVar Int,
    ResultHandle v -> TVar HandleState
rhState :: TVar HandleState
  }

submitBase :: FromGraphSON r => Client -> Text -> Maybe Object -> IO (ResultHandle r)
submitBase :: Client -> Text -> Maybe Object -> IO (ResultHandle r)
submitBase Client
client Text
script Maybe Object
bindings = do
  ResponseHandle GValue
rh <- Connection GValue -> OpEval -> IO (ResponseHandle GValue)
forall o s.
Operation o =>
Connection s -> o -> IO (ResponseHandle s)
Conn.sendRequest Connection GValue
conn OpEval
op
  (TVar (Vector r)
cache, TVar Port
index, TVar HandleState
state) <- (,,) (TVar (Vector r)
 -> TVar Port
 -> TVar HandleState
 -> (TVar (Vector r), TVar Port, TVar HandleState))
-> IO (TVar (Vector r))
-> IO
     (TVar Port
      -> TVar HandleState
      -> (TVar (Vector r), TVar Port, TVar HandleState))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector r -> IO (TVar (Vector r))
forall a. a -> IO (TVar a)
newTVarIO Vector r
forall a. Monoid a => a
mempty IO
  (TVar Port
   -> TVar HandleState
   -> (TVar (Vector r), TVar Port, TVar HandleState))
-> IO (TVar Port)
-> IO
     (TVar HandleState
      -> (TVar (Vector r), TVar Port, TVar HandleState))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Port -> IO (TVar Port)
forall a. a -> IO (TVar a)
newTVarIO Port
0 IO
  (TVar HandleState
   -> (TVar (Vector r), TVar Port, TVar HandleState))
-> IO (TVar HandleState)
-> IO (TVar (Vector r), TVar Port, TVar HandleState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HandleState -> IO (TVar HandleState)
forall a. a -> IO (TVar a)
newTVarIO HandleState
HandleOpen
  ResultHandle r -> IO (ResultHandle r)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultHandle r -> IO (ResultHandle r))
-> ResultHandle r -> IO (ResultHandle r)
forall a b. (a -> b) -> a -> b
$ ResultHandle :: forall v.
ResponseHandle GValue
-> (GValue -> Either Host (Vector v))
-> TVar (Vector v)
-> TVar Port
-> TVar HandleState
-> ResultHandle v
ResultHandle { $sel:rhResHandle:ResultHandle :: ResponseHandle GValue
rhResHandle = ResponseHandle GValue
rh,
                          $sel:rhParseGValue:ResultHandle :: GValue -> Either Host (Vector r)
rhParseGValue = GValue -> Either Host (Vector r)
forall a. FromGraphSON a => GValue -> Either Host a
parseEither,
                          $sel:rhResultCache:ResultHandle :: TVar (Vector r)
rhResultCache = TVar (Vector r)
cache,
                          $sel:rhNextResultIndex:ResultHandle :: TVar Port
rhNextResultIndex = TVar Port
index,
                          $sel:rhState:ResultHandle :: TVar HandleState
rhState = TVar HandleState
state
                        }
  where
    conn :: Connection GValue
conn = Client -> Connection GValue
clientConn Client
client
    opts :: Options
opts = Client -> Options
clientOpts Client
client
    op :: OpEval
op = OpEval :: Maybe Port
-> Text
-> Maybe Object
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Port
-> OpEval
ReqStd.OpEval { $sel:batchSize:OpEval :: Maybe Port
ReqStd.batchSize = Options -> Maybe Port
Opt.batchSize Options
opts,
                         $sel:gremlin:OpEval :: Text
ReqStd.gremlin = Text
script,
                         $sel:bindings:OpEval :: Maybe Object
ReqStd.bindings = Maybe Object
bindings,
                         $sel:language:OpEval :: Maybe Text
ReqStd.language = Options -> Maybe Text
Opt.language Options
opts,
                         $sel:aliases:OpEval :: Maybe (HashMap Text Text)
ReqStd.aliases = Options -> Maybe (HashMap Text Text)
Opt.aliases Options
opts,
                         $sel:scriptEvaluationTimeout:OpEval :: Maybe Port
ReqStd.scriptEvaluationTimeout = Options -> Maybe Port
Opt.scriptEvaluationTimeout Options
opts
                       }

-- | Submit a Gremlin script to the server. You can get its results by
-- 'ResultHandle'. The result type @v@ is determined by the script
-- type @g@.
-- 
-- Usually this function does not throw any exception. Exceptions
-- about sending requests are reported when you operate on
-- 'ResultHandle'.
submit :: (ToGreskell g, r ~ GreskellReturn g, AsIterator r, v ~ IteratorItem r, FromGraphSON v)
       => Client
       -> g -- ^ Gremlin script
       -> Maybe Object -- ^ bindings
       -> IO (ResultHandle v)
submit :: Client -> g -> Maybe Object -> IO (ResultHandle v)
submit Client
client g
greskell Maybe Object
bindings = Client -> Text -> Maybe Object -> IO (ResultHandle v)
forall r.
FromGraphSON r =>
Client -> Text -> Maybe Object -> IO (ResultHandle r)
submitBase Client
client (g -> Text
forall a. ToGreskell a => a -> Text
toGremlin g
greskell) Maybe Object
bindings

-- | Submit a pair of Gremlin script and variable binding. It's just a
-- simple wrapper around 'submit'.
--
-- @since 0.1.2.0
submitPair :: (ToGreskell g, r ~ GreskellReturn g, AsIterator r, v ~ IteratorItem r, FromGraphSON v)
           => Client
           -> (g, Object)
           -> IO (ResultHandle v)
submitPair :: Client -> (g, Object) -> IO (ResultHandle v)
submitPair Client
c (g
g, Object
b) = Client -> g -> Maybe Object -> IO (ResultHandle v)
forall g r v.
(ToGreskell g, r ~ GreskellReturn g, AsIterator r,
 v ~ IteratorItem r, FromGraphSON v) =>
Client -> g -> Maybe Object -> IO (ResultHandle v)
submit Client
c g
g (Object -> Maybe Object
forall a. a -> Maybe a
Just Object
b)

-- | Less type-safe version of 'submit'.
submitRaw :: Client
          -> Text -- ^ Gremlin script
          -> Maybe Object -- ^ bindings
          -> IO (ResultHandle GValue)
submitRaw :: Client -> Text -> Maybe Object -> IO (ResultHandle GValue)
submitRaw = Client -> Text -> Maybe Object -> IO (ResultHandle GValue)
forall r.
FromGraphSON r =>
Client -> Text -> Maybe Object -> IO (ResultHandle r)
submitBase

-- | Exception about 'submit' operation and getting its result.
data SubmitException =
    ResponseError (ResponseMessage GValue)
    -- ^ The server returns a 'ResponseMessage' with error 'ResponseCode'.
  | ParseError (ResponseMessage GValue) String
    -- ^ The client fails to parse the \"data\" field of the
    -- 'ResponseMessage'. The error message is kept in the 'String'
    -- field.
  deriving (Port -> SubmitException -> ShowS
[SubmitException] -> ShowS
SubmitException -> Host
(Port -> SubmitException -> ShowS)
-> (SubmitException -> Host)
-> ([SubmitException] -> ShowS)
-> Show SubmitException
forall a.
(Port -> a -> ShowS) -> (a -> Host) -> ([a] -> ShowS) -> Show a
showList :: [SubmitException] -> ShowS
$cshowList :: [SubmitException] -> ShowS
show :: SubmitException -> Host
$cshow :: SubmitException -> Host
showsPrec :: Port -> SubmitException -> ShowS
$cshowsPrec :: Port -> SubmitException -> ShowS
Show,Typeable)

instance Exception SubmitException


-- | Get the next value from the 'ResultHandle'. If you have got all
-- values, it returns 'Nothing'.  This function may block for a new
-- response to come.
--
-- On error, it may throw all sorts of exceptions including
-- 'SubmitException' and 'Conn.RequestException'. For example, if the
-- submitted Gremlin script throws an exception, 'nextResult' throws
-- 'ResponseError' with 'ResponseCode' of 'Res.ScriptEvaluationError'.
nextResult :: ResultHandle v -> IO (Maybe v)
nextResult :: ResultHandle v -> IO (Maybe v)
nextResult = STM (Maybe v) -> IO (Maybe v)
forall a. STM a -> IO a
atomically (STM (Maybe v) -> IO (Maybe v))
-> (ResultHandle v -> STM (Maybe v))
-> ResultHandle v
-> IO (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultHandle v -> STM (Maybe v)
forall v. ResultHandle v -> STM (Maybe v)
nextResultSTM

-- | 'STM' version of 'nextResult'.
nextResultSTM :: ResultHandle v -> STM (Maybe v)
nextResultSTM :: ResultHandle v -> STM (Maybe v)
nextResultSTM ResultHandle v
rh = do
  HandleState
cur_state <- TVar HandleState -> STM HandleState
forall a. TVar a -> STM a
readTVar (TVar HandleState -> STM HandleState)
-> TVar HandleState -> STM HandleState
forall a b. (a -> b) -> a -> b
$ ResultHandle v -> TVar HandleState
forall v. ResultHandle v -> TVar HandleState
rhState ResultHandle v
rh
  case HandleState
cur_state of
   HandleError SomeException
err -> SomeException -> STM (Maybe v)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw SomeException
err
   HandleState
HandleClose -> Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
   HandleState
HandleOpen -> STM (Maybe v)
doNext STM (Maybe v) -> (SomeException -> STM ()) -> STM (Maybe v)
forall (m :: * -> *) e a a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`withExceptionSTM` SomeException -> STM ()
gotoError
  where
    doNext :: STM (Maybe v)
doNext = do
      Maybe v
mret <- STM (Maybe v)
getNext
      case Maybe v
mret of
       Maybe v
Nothing -> TVar HandleState -> HandleState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResultHandle v -> TVar HandleState
forall v. ResultHandle v -> TVar HandleState
rhState ResultHandle v
rh) HandleState
HandleClose
       Maybe v
_ -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
mret
    getNext :: STM (Maybe v)
getNext = do
      Maybe v
mnext <- ResultHandle v -> STM (Maybe v)
forall v. ResultHandle v -> STM (Maybe v)
getNextCachedResult ResultHandle v
rh
      case Maybe v
mnext of
       Just v
v -> Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe v -> STM (Maybe v)) -> Maybe v -> STM (Maybe v)
forall a b. (a -> b) -> a -> b
$ v -> Maybe v
forall a. a -> Maybe a
Just v
v
       Maybe v
Nothing -> ResultHandle v -> STM (Maybe v)
forall v. ResultHandle v -> STM (Maybe v)
loadResponse ResultHandle v
rh
    -- 'withException' function is for MonadMask and STM is not a
    -- MonadMask. So we use catch-and-rethrow by hand.
    withExceptionSTM :: m a -> (e -> m a) -> m a
withExceptionSTM m a
main e -> m a
finish =
      m a
main m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\e
ex -> e -> m a
finish e
ex m a -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw e
ex)
    gotoError :: SomeException -> STM ()
gotoError SomeException
ex = TVar HandleState -> HandleState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResultHandle v -> TVar HandleState
forall v. ResultHandle v -> TVar HandleState
rhState ResultHandle v
rh) (HandleState -> STM ()) -> HandleState -> STM ()
forall a b. (a -> b) -> a -> b
$ SomeException -> HandleState
HandleError SomeException
ex
    

getNextCachedResult :: ResultHandle v -> STM (Maybe v)
getNextCachedResult :: ResultHandle v -> STM (Maybe v)
getNextCachedResult ResultHandle v
rh = do
  (Vector v
cache, Port
index) <- (,) (Vector v -> Port -> (Vector v, Port))
-> STM (Vector v) -> STM (Port -> (Vector v, Port))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TVar (Vector v) -> STM (Vector v)
forall a. TVar a -> STM a
readTVar (TVar (Vector v) -> STM (Vector v))
-> TVar (Vector v) -> STM (Vector v)
forall a b. (a -> b) -> a -> b
$ ResultHandle v -> TVar (Vector v)
forall v. ResultHandle v -> TVar (Vector v)
rhResultCache ResultHandle v
rh) STM (Port -> (Vector v, Port)) -> STM Port -> STM (Vector v, Port)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TVar Port -> STM Port
forall a. TVar a -> STM a
readTVar (TVar Port -> STM Port) -> TVar Port -> STM Port
forall a b. (a -> b) -> a -> b
$ ResultHandle v -> TVar Port
forall v. ResultHandle v -> TVar Port
rhNextResultIndex ResultHandle v
rh)
  if Port
index Port -> Port -> Bool
forall a. Ord a => a -> a -> Bool
< Vector v -> Port
forall (t :: * -> *) a. Foldable t => t a -> Port
length Vector v
cache
    then Vector v -> Port -> STM (Maybe v)
fromCache Vector v
cache Port
index
    else Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
  where
    fromCache :: Vector v -> Port -> STM (Maybe v)
fromCache Vector v
cache Port
index = do
      TVar Port -> Port -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResultHandle v -> TVar Port
forall v. ResultHandle v -> TVar Port
rhNextResultIndex ResultHandle v
rh) (Port -> STM ()) -> Port -> STM ()
forall a b. (a -> b) -> a -> b
$ Port
index Port -> Port -> Port
forall a. Num a => a -> a -> a
+ Port
1
      Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe v -> STM (Maybe v)) -> Maybe v -> STM (Maybe v)
forall a b. (a -> b) -> a -> b
$ v -> Maybe v
forall a. a -> Maybe a
Just (Vector v
cache Vector v -> Port -> v
forall a. Vector a -> Port -> a
! Port
index)

loadResponse :: ResultHandle v -> STM (Maybe v)
loadResponse :: ResultHandle v -> STM (Maybe v)
loadResponse ResultHandle v
rh = Maybe (ResponseMessage GValue) -> STM (Maybe v)
parseResponse (Maybe (ResponseMessage GValue) -> STM (Maybe v))
-> STM (Maybe (ResponseMessage GValue)) -> STM (Maybe v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ResponseHandle GValue -> STM (Maybe (ResponseMessage GValue))
forall s. ResponseHandle s -> STM (Maybe (ResponseMessage s))
Conn.nextResponseSTM (ResponseHandle GValue -> STM (Maybe (ResponseMessage GValue)))
-> ResponseHandle GValue -> STM (Maybe (ResponseMessage GValue))
forall a b. (a -> b) -> a -> b
$ ResultHandle v -> ResponseHandle GValue
forall v. ResultHandle v -> ResponseHandle GValue
rhResHandle ResultHandle v
rh)
  where
    parseResponse :: Maybe (ResponseMessage GValue) -> STM (Maybe v)
parseResponse Maybe (ResponseMessage GValue)
Nothing = Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
    parseResponse (Just ResponseMessage GValue
res) = 
      case ResponseStatus -> ResponseCode
Res.code (ResponseStatus -> ResponseCode) -> ResponseStatus -> ResponseCode
forall a b. (a -> b) -> a -> b
$ ResponseMessage GValue -> ResponseStatus
forall s. ResponseMessage s -> ResponseStatus
Res.status ResponseMessage GValue
res of
       ResponseCode
Res.Success -> ResponseMessage GValue -> STM (Maybe v)
parseData ResponseMessage GValue
res
       ResponseCode
Res.NoContent -> Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
       ResponseCode
Res.PartialContent -> ResponseMessage GValue -> STM (Maybe v)
parseData ResponseMessage GValue
res
       ResponseCode
_ -> SubmitException -> STM (Maybe v)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (SubmitException -> STM (Maybe v))
-> SubmitException -> STM (Maybe v)
forall a b. (a -> b) -> a -> b
$ ResponseMessage GValue -> SubmitException
ResponseError ResponseMessage GValue
res -- TODO: handle Authenticate code
    parseData :: ResponseMessage GValue -> STM (Maybe v)
parseData ResponseMessage GValue
res =
      case ResultHandle v -> GValue -> Either Host (Vector v)
forall v. ResultHandle v -> GValue -> Either Host (Vector v)
rhParseGValue ResultHandle v
rh (GValue -> Either Host (Vector v))
-> GValue -> Either Host (Vector v)
forall a b. (a -> b) -> a -> b
$ ResponseResult GValue -> GValue
forall s. ResponseResult s -> s
Res.resultData (ResponseResult GValue -> GValue)
-> ResponseResult GValue -> GValue
forall a b. (a -> b) -> a -> b
$ ResponseMessage GValue -> ResponseResult GValue
forall s. ResponseMessage s -> ResponseResult s
Res.result ResponseMessage GValue
res of
       Left Host
err -> SubmitException -> STM (Maybe v)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (SubmitException -> STM (Maybe v))
-> SubmitException -> STM (Maybe v)
forall a b. (a -> b) -> a -> b
$ ResponseMessage GValue -> Host -> SubmitException
ParseError ResponseMessage GValue
res Host
err
       Right Vector v
parsed -> do
         TVar (Vector v) -> Vector v -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResultHandle v -> TVar (Vector v)
forall v. ResultHandle v -> TVar (Vector v)
rhResultCache ResultHandle v
rh) Vector v
parsed
         if Vector v -> Port
forall (t :: * -> *) a. Foldable t => t a -> Port
length Vector v
parsed Port -> Port -> Bool
forall a. Eq a => a -> a -> Bool
== Port
0
           then do
             TVar Port -> Port -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResultHandle v -> TVar Port
forall v. ResultHandle v -> TVar Port
rhNextResultIndex ResultHandle v
rh) Port
0
             Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
           else do
             TVar Port -> Port -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResultHandle v -> TVar Port
forall v. ResultHandle v -> TVar Port
rhNextResultIndex ResultHandle v
rh) Port
1
             Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe v -> STM (Maybe v)) -> Maybe v -> STM (Maybe v)
forall a b. (a -> b) -> a -> b
$ v -> Maybe v
forall a. a -> Maybe a
Just (Vector v
parsed Vector v -> Port -> v
forall a. Vector a -> Port -> a
! Port
0)

-- | Get all remaining results from 'ResultHandle'.
slurpResults :: ResultHandle v -> IO (Vector v)
slurpResults :: ResultHandle v -> IO (Vector v)
slurpResults ResultHandle v
h = IO (Maybe v) -> IO (Vector v)
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m (Vector a)
slurp (IO (Maybe v) -> IO (Vector v)) -> IO (Maybe v) -> IO (Vector v)
forall a b. (a -> b) -> a -> b
$ ResultHandle v -> IO (Maybe v)
forall v. ResultHandle v -> IO (Maybe v)
nextResult ResultHandle v
h

-- | Similar to 'slurpResults', but this function discards the
-- results. Useful to execute a script whose side-effect is the only
-- thing you care.
--
-- @since 0.1.1.0
drainResults :: ResultHandle v -> IO ()
drainResults :: ResultHandle v -> IO ()
drainResults ResultHandle v
h = IO (Maybe v) -> IO ()
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m ()
drain (IO (Maybe v) -> IO ()) -> IO (Maybe v) -> IO ()
forall a b. (a -> b) -> a -> b
$ ResultHandle v -> IO (Maybe v)
forall v. ResultHandle v -> IO (Maybe v)
nextResult ResultHandle v
h