-- | Positioned elements
--
-- Intended for qualified import.
--
-- > import Network.GRPC.Common.StreamElem qualified as StreamElem
--
-- "Network.GRPC.Common" (intended for unqualified import) exports
-- @StreamElem(..)@, but none of the operations on 'StreamElem'.
module Network.GRPC.Common.StreamElem (
    StreamElem(..)
    -- * Conversion
  , value
    -- * Iteration
    -- * Iteration
  , mapM_
  , forM_
  , whileNext_
  , collect
  , whenDefinitelyFinal
  ) where

import Prelude hiding (mapM_)

import Control.Monad.State (StateT, runStateT, lift, modify)
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Tuple (swap)

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | An element positioned in a stream
data StreamElem b a =
    -- | Element in the stream
    --
    -- The final element in a stream may or may not be marked as final; if it is
    -- not, we will only discover /after/ receiving the final element that it
    -- was in fact final. Moreover, we do not know ahead of time whether or not
    -- the final element will be marked.
    --
    -- When we receive an element and it is not marked final, this might
    -- therefore mean one of two things, without being able to tell which:
    --
    -- * We are dealing with a stream in which the final element is not marked.
    --
    --   In this case, the element may or may not be the final element; if it
    --   is, the next value will be 'NoMoreElems' (but waiting for the next
    --   value might mean a blocking call).
    --
    -- * We are dealing with a stream in which the final element /is/ marked.
    --
    --   In this case, this element is /not/ final (and the final element, when
    --   we receive it, will be tagged as 'Final').
    StreamElem !a

    -- | We received the final element
    --
    -- The final element is annotated with some additional information.
  | FinalElem !a !b

    -- | There are no more elements
    --
    -- This is used in two situations:
    --
    -- * The stream didn't contain any elements at all.
    -- * The final element was not marked as final.
    --   See 'StreamElem' for detailed additional discussion.
  | NoMoreElems !b
  deriving stock (Int -> StreamElem b a -> ShowS
[StreamElem b a] -> ShowS
StreamElem b a -> String
(Int -> StreamElem b a -> ShowS)
-> (StreamElem b a -> String)
-> ([StreamElem b a] -> ShowS)
-> Show (StreamElem b a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall b a. (Show a, Show b) => Int -> StreamElem b a -> ShowS
forall b a. (Show a, Show b) => [StreamElem b a] -> ShowS
forall b a. (Show a, Show b) => StreamElem b a -> String
$cshowsPrec :: forall b a. (Show a, Show b) => Int -> StreamElem b a -> ShowS
showsPrec :: Int -> StreamElem b a -> ShowS
$cshow :: forall b a. (Show a, Show b) => StreamElem b a -> String
show :: StreamElem b a -> String
$cshowList :: forall b a. (Show a, Show b) => [StreamElem b a] -> ShowS
showList :: [StreamElem b a] -> ShowS
Show, StreamElem b a -> StreamElem b a -> Bool
(StreamElem b a -> StreamElem b a -> Bool)
-> (StreamElem b a -> StreamElem b a -> Bool)
-> Eq (StreamElem b a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall b a.
(Eq a, Eq b) =>
StreamElem b a -> StreamElem b a -> Bool
$c== :: forall b a.
(Eq a, Eq b) =>
StreamElem b a -> StreamElem b a -> Bool
== :: StreamElem b a -> StreamElem b a -> Bool
$c/= :: forall b a.
(Eq a, Eq b) =>
StreamElem b a -> StreamElem b a -> Bool
/= :: StreamElem b a -> StreamElem b a -> Bool
Eq, (forall a b. (a -> b) -> StreamElem b a -> StreamElem b b)
-> (forall a b. a -> StreamElem b b -> StreamElem b a)
-> Functor (StreamElem b)
forall a b. a -> StreamElem b b -> StreamElem b a
forall a b. (a -> b) -> StreamElem b a -> StreamElem b b
forall b a b. a -> StreamElem b b -> StreamElem b a
forall b a b. (a -> b) -> StreamElem b a -> StreamElem b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall b a b. (a -> b) -> StreamElem b a -> StreamElem b b
fmap :: forall a b. (a -> b) -> StreamElem b a -> StreamElem b b
$c<$ :: forall b a b. a -> StreamElem b b -> StreamElem b a
<$ :: forall a b. a -> StreamElem b b -> StreamElem b a
Functor, (forall m. Monoid m => StreamElem b m -> m)
-> (forall m a. Monoid m => (a -> m) -> StreamElem b a -> m)
-> (forall m a. Monoid m => (a -> m) -> StreamElem b a -> m)
-> (forall a b. (a -> b -> b) -> b -> StreamElem b a -> b)
-> (forall a b. (a -> b -> b) -> b -> StreamElem b a -> b)
-> (forall b a. (b -> a -> b) -> b -> StreamElem b a -> b)
-> (forall b a. (b -> a -> b) -> b -> StreamElem b a -> b)
-> (forall a. (a -> a -> a) -> StreamElem b a -> a)
-> (forall a. (a -> a -> a) -> StreamElem b a -> a)
-> (forall a. StreamElem b a -> [a])
-> (forall a. StreamElem b a -> Bool)
-> (forall a. StreamElem b a -> Int)
-> (forall a. Eq a => a -> StreamElem b a -> Bool)
-> (forall a. Ord a => StreamElem b a -> a)
-> (forall a. Ord a => StreamElem b a -> a)
-> (forall a. Num a => StreamElem b a -> a)
-> (forall a. Num a => StreamElem b a -> a)
-> Foldable (StreamElem b)
forall a. Eq a => a -> StreamElem b a -> Bool
forall a. Num a => StreamElem b a -> a
forall a. Ord a => StreamElem b a -> a
forall m. Monoid m => StreamElem b m -> m
forall a. StreamElem b a -> Bool
forall a. StreamElem b a -> Int
forall a. StreamElem b a -> [a]
forall a. (a -> a -> a) -> StreamElem b a -> a
forall b a. Eq a => a -> StreamElem b a -> Bool
forall b a. Num a => StreamElem b a -> a
forall b a. Ord a => StreamElem b a -> a
forall b m. Monoid m => StreamElem b m -> m
forall m a. Monoid m => (a -> m) -> StreamElem b a -> m
forall b a. StreamElem b a -> Bool
forall b a. StreamElem b a -> Int
forall b a. StreamElem b a -> [a]
forall b a. (b -> a -> b) -> b -> StreamElem b a -> b
forall a b. (a -> b -> b) -> b -> StreamElem b a -> b
forall b a. (a -> a -> a) -> StreamElem b a -> a
forall b m a. Monoid m => (a -> m) -> StreamElem b a -> m
forall b b a. (b -> a -> b) -> b -> StreamElem b a -> b
forall b a b. (a -> b -> b) -> b -> StreamElem b a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall b m. Monoid m => StreamElem b m -> m
fold :: forall m. Monoid m => StreamElem b m -> m
$cfoldMap :: forall b m a. Monoid m => (a -> m) -> StreamElem b a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> StreamElem b a -> m
$cfoldMap' :: forall b m a. Monoid m => (a -> m) -> StreamElem b a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> StreamElem b a -> m
$cfoldr :: forall b a b. (a -> b -> b) -> b -> StreamElem b a -> b
foldr :: forall a b. (a -> b -> b) -> b -> StreamElem b a -> b
$cfoldr' :: forall b a b. (a -> b -> b) -> b -> StreamElem b a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> StreamElem b a -> b
$cfoldl :: forall b b a. (b -> a -> b) -> b -> StreamElem b a -> b
foldl :: forall b a. (b -> a -> b) -> b -> StreamElem b a -> b
$cfoldl' :: forall b b a. (b -> a -> b) -> b -> StreamElem b a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> StreamElem b a -> b
$cfoldr1 :: forall b a. (a -> a -> a) -> StreamElem b a -> a
foldr1 :: forall a. (a -> a -> a) -> StreamElem b a -> a
$cfoldl1 :: forall b a. (a -> a -> a) -> StreamElem b a -> a
foldl1 :: forall a. (a -> a -> a) -> StreamElem b a -> a
$ctoList :: forall b a. StreamElem b a -> [a]
toList :: forall a. StreamElem b a -> [a]
$cnull :: forall b a. StreamElem b a -> Bool
null :: forall a. StreamElem b a -> Bool
$clength :: forall b a. StreamElem b a -> Int
length :: forall a. StreamElem b a -> Int
$celem :: forall b a. Eq a => a -> StreamElem b a -> Bool
elem :: forall a. Eq a => a -> StreamElem b a -> Bool
$cmaximum :: forall b a. Ord a => StreamElem b a -> a
maximum :: forall a. Ord a => StreamElem b a -> a
$cminimum :: forall b a. Ord a => StreamElem b a -> a
minimum :: forall a. Ord a => StreamElem b a -> a
$csum :: forall b a. Num a => StreamElem b a -> a
sum :: forall a. Num a => StreamElem b a -> a
$cproduct :: forall b a. Num a => StreamElem b a -> a
product :: forall a. Num a => StreamElem b a -> a
Foldable, Functor (StreamElem b)
Foldable (StreamElem b)
(Functor (StreamElem b), Foldable (StreamElem b)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> StreamElem b a -> f (StreamElem b b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    StreamElem b (f a) -> f (StreamElem b a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> StreamElem b a -> m (StreamElem b b))
-> (forall (m :: * -> *) a.
    Monad m =>
    StreamElem b (m a) -> m (StreamElem b a))
-> Traversable (StreamElem b)
forall b. Functor (StreamElem b)
forall b. Foldable (StreamElem b)
forall b (m :: * -> *) a.
Monad m =>
StreamElem b (m a) -> m (StreamElem b a)
forall b (f :: * -> *) a.
Applicative f =>
StreamElem b (f a) -> f (StreamElem b a)
forall b (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StreamElem b a -> m (StreamElem b b)
forall b (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StreamElem b a -> f (StreamElem b b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
StreamElem b (m a) -> m (StreamElem b a)
forall (f :: * -> *) a.
Applicative f =>
StreamElem b (f a) -> f (StreamElem b a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StreamElem b a -> m (StreamElem b b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StreamElem b a -> f (StreamElem b b)
$ctraverse :: forall b (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StreamElem b a -> f (StreamElem b b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StreamElem b a -> f (StreamElem b b)
$csequenceA :: forall b (f :: * -> *) a.
Applicative f =>
StreamElem b (f a) -> f (StreamElem b a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
StreamElem b (f a) -> f (StreamElem b a)
$cmapM :: forall b (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StreamElem b a -> m (StreamElem b b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StreamElem b a -> m (StreamElem b b)
$csequence :: forall b (m :: * -> *) a.
Monad m =>
StreamElem b (m a) -> m (StreamElem b a)
sequence :: forall (m :: * -> *) a.
Monad m =>
StreamElem b (m a) -> m (StreamElem b a)
Traversable)

instance Bifunctor StreamElem where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> StreamElem a c -> StreamElem b d
bimap a -> b
g c -> d
f (FinalElem   c
a a
b) = d -> b -> StreamElem b d
forall b a. a -> b -> StreamElem b a
FinalElem   (c -> d
f c
a) (a -> b
g a
b)
  bimap a -> b
g c -> d
_ (NoMoreElems   a
b) = b -> StreamElem b d
forall b a. b -> StreamElem b a
NoMoreElems       (a -> b
g a
b)
  bimap a -> b
_ c -> d
f (StreamElem  c
a  ) = d -> StreamElem b d
forall b a. a -> StreamElem b a
StreamElem  (c -> d
f c
a)

instance Bifoldable StreamElem where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> StreamElem a b -> m
bifoldMap a -> m
g b -> m
f (FinalElem   b
a a
b) = b -> m
f b
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
g a
b
  bifoldMap a -> m
g b -> m
_ (NoMoreElems   a
b) =        a -> m
g a
b
  bifoldMap a -> m
_ b -> m
f (StreamElem  b
a  ) = b -> m
f b
a

instance Bitraversable StreamElem where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> StreamElem a b -> f (StreamElem c d)
bitraverse a -> f c
g b -> f d
f (FinalElem   b
a a
b) = d -> c -> StreamElem c d
forall b a. a -> b -> StreamElem b a
FinalElem   (d -> c -> StreamElem c d) -> f d -> f (c -> StreamElem c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
f b
a f (c -> StreamElem c d) -> f c -> f (StreamElem c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f c
g a
b
  bitraverse a -> f c
g b -> f d
_ (NoMoreElems   a
b) = c -> StreamElem c d
forall b a. b -> StreamElem b a
NoMoreElems (c -> StreamElem c d) -> f c -> f (StreamElem c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>         a -> f c
g a
b
  bitraverse a -> f c
_ b -> f d
f (StreamElem  b
a  ) = d -> StreamElem c d
forall b a. a -> StreamElem b a
StreamElem  (d -> StreamElem c d) -> f d -> f (StreamElem c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
f b
a

{-------------------------------------------------------------------------------
  Conversion
-------------------------------------------------------------------------------}

-- | Value of the element, if one is present
--
-- Returns 'Nothing' in case of 'NoMoreElems'
--
-- Using this function loses the information whether the item was the final
-- item; this information can be recovered using 'whenDefinitelyFinal'.
value :: StreamElem b a -> Maybe a
value :: forall b a. StreamElem b a -> Maybe a
value = \case
    StreamElem a
a   -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    FinalElem  a
a b
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    NoMoreElems  b
_ -> Maybe a
forall a. Maybe a
Nothing

{-------------------------------------------------------------------------------
  Iteration
-------------------------------------------------------------------------------}

-- | Invoke the callback for each element
--
-- The final element is marked using 'FinalElem'; the callback is only invoked
-- on 'NoMoreElems' if the list is empty.
--
-- >    mapM_ f ([1,2,3], b)
-- > == do f (StreamElem 1)
-- >       f (StreamElem 2)
-- >       f (FinalElem 3 b)
-- >
-- >    mapM_ f ([], b)
-- > == do f (NoMoreElems b)
mapM_ :: forall m a b. Monad m => (StreamElem b a -> m ()) -> [a] -> b -> m ()
mapM_ :: forall (m :: * -> *) a b.
Monad m =>
(StreamElem b a -> m ()) -> [a] -> b -> m ()
mapM_ StreamElem b a -> m ()
f = [a] -> b -> m ()
go
  where
    go :: [a] -> b -> m ()
    go :: [a] -> b -> m ()
go []     b
b = StreamElem b a -> m ()
f (b -> StreamElem b a
forall b a. b -> StreamElem b a
NoMoreElems b
b)
    go [a
a]    b
b = StreamElem b a -> m ()
f (a -> b -> StreamElem b a
forall b a. a -> b -> StreamElem b a
FinalElem a
a b
b)
    go (a
a:[a]
as) b
b = StreamElem b a -> m ()
f (a -> StreamElem b a
forall b a. a -> StreamElem b a
StreamElem a
a) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> b -> m ()
go [a]
as b
b

-- | Like 'mapM_', but with the arguments in opposite order
forM_ :: Monad m => [a] -> b -> (StreamElem b a -> m ()) -> m ()
forM_ :: forall (m :: * -> *) a b.
Monad m =>
[a] -> b -> (StreamElem b a -> m ()) -> m ()
forM_ [a]
as b
b StreamElem b a -> m ()
f = (StreamElem b a -> m ()) -> [a] -> b -> m ()
forall (m :: * -> *) a b.
Monad m =>
(StreamElem b a -> m ()) -> [a] -> b -> m ()
mapM_ StreamElem b a -> m ()
f [a]
as b
b

-- | Invoke a function on each 'NextElem', until 'FinalElem' or 'NoMoreElems'
whileNext_ :: forall m a b. Monad m => m (StreamElem b a) -> (a -> m ()) -> m b
whileNext_ :: forall (m :: * -> *) a b.
Monad m =>
m (StreamElem b a) -> (a -> m ()) -> m b
whileNext_ m (StreamElem b a)
f a -> m ()
g = m b
go
  where
    go :: m b
    go :: m b
go = do
        ma <- m (StreamElem b a)
f
        case ma of
          StreamElem  a
a   -> a -> m ()
g a
a m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
go
          FinalElem   a
a b
b -> a -> m ()
g a
a m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
          NoMoreElems   b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

-- | Invoke the callback until 'FinalElem' or 'NoMoreElems', collecting results
collect :: forall m b a. Monad m => m (StreamElem b a) -> m ([a], b)
collect :: forall (m :: * -> *) b a.
Monad m =>
m (StreamElem b a) -> m ([a], b)
collect m (StreamElem b a)
f =
    ([a] -> [a]) -> ([a], b) -> ([a], b)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [a] -> [a]
forall a. [a] -> [a]
reverse (([a], b) -> ([a], b))
-> ((b, [a]) -> ([a], b)) -> (b, [a]) -> ([a], b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, [a]) -> ([a], b)
forall a b. (a, b) -> (b, a)
swap ((b, [a]) -> ([a], b)) -> m (b, [a]) -> m ([a], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT [a] m b -> [a] -> m (b, [a]))
-> [a] -> StateT [a] m b -> m (b, [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [a] m b -> [a] -> m (b, [a])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT [] StateT [a] m b
aux
  where
    aux :: StateT [a] m b
    aux :: StateT [a] m b
aux = StateT [a] m (StreamElem b a)
-> (a -> StateT [a] m ()) -> StateT [a] m b
forall (m :: * -> *) a b.
Monad m =>
m (StreamElem b a) -> (a -> m ()) -> m b
whileNext_ (m (StreamElem b a) -> StateT [a] m (StreamElem b a)
forall (m :: * -> *) a. Monad m => m a -> StateT [a] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (StreamElem b a)
f) ((a -> StateT [a] m ()) -> StateT [a] m b)
-> (a -> StateT [a] m ()) -> StateT [a] m b
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> StateT [a] m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([a] -> [a]) -> StateT [a] m ())
-> (a -> [a] -> [a]) -> a -> StateT [a] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)

-- | Do we have evidence that this element is the final one?
--
-- The callback is not called on 'StreamElem'; this does /not/ mean that the
-- element was not final; see 'StreamElem' for detailed discussion.
whenDefinitelyFinal :: Applicative m => StreamElem b a -> (b -> m ()) -> m ()
whenDefinitelyFinal :: forall (m :: * -> *) b a.
Applicative m =>
StreamElem b a -> (b -> m ()) -> m ()
whenDefinitelyFinal StreamElem b a
msg b -> m ()
k =
    case StreamElem b a
msg of
      StreamElem  a
_   -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      FinalElem   a
_ b
b -> b -> m ()
k b
b
      NoMoreElems   b
b -> b -> m ()
k b
b