{-# LANGUAGE ExplicitNamespaces #-}

-- | 'Emitter' wraps a producer destructor.
--
-- "Every Thought emits a Dice Throw" ~ Stéphane Mallarmé
module Box.Emitter
  ( Emitter (..),
    type CoEmitter,
    toListM,
    witherE,
    filterE,
    readE,
    unlistE,
    takeE,
    takeUntilE,
    dropE,
    pop,
  )
where

import Box.Functor
import Control.Applicative
import Control.Monad
import Control.Monad.Codensity
import Control.Monad.State.Lazy
import Data.Bool
import Data.DList qualified as D
import Data.Sequence qualified as Seq
import Data.Text (Text, pack, unpack)
import Prelude

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Prelude
-- >>> import Box
-- >>> import Data.Bool
-- >>> import Data.Text (Text)

-- | An `Emitter` `emit`s values of type 'Maybe' a. Source and producer are similar metaphors. An Emitter reaches into itself for the value to emit, where itself is an opaque thing from the pov of usage.
--
-- >>> e = Emitter (pure (Just "I'm emitted"))
-- >>> emit e
-- Just "I'm emitted"
--
-- >>> emit mempty
-- Nothing
newtype Emitter m a = Emitter
  { forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit :: m (Maybe a)
  }

-- | An 'Emitter' continuation.
type CoEmitter m a = Codensity m (Emitter m a)

instance FFunctor Emitter where
  foist :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Emitter f a -> Emitter g a
foist forall x. f x -> g x
nat (Emitter f (Maybe a)
e) = g (Maybe a) -> Emitter g a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (f (Maybe a) -> g (Maybe a)
forall x. f x -> g x
nat f (Maybe a)
e)

instance (Functor m) => Functor (Emitter m) where
  fmap :: forall a b. (a -> b) -> Emitter m a -> Emitter m b
fmap a -> b
f Emitter m a
m = m (Maybe b) -> Emitter m b
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter ((Maybe a -> Maybe b) -> m (Maybe a) -> m (Maybe b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
m))

instance (Applicative m) => Applicative (Emitter m) where
  pure :: forall a. a -> Emitter m a
pure a
r = m (Maybe a) -> Emitter m a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r))

  Emitter m (a -> b)
mf <*> :: forall a b. Emitter m (a -> b) -> Emitter m a -> Emitter m b
<*> Emitter m a
mx = m (Maybe b) -> Emitter m b
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (Maybe (a -> b) -> Maybe a -> Maybe b
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (Maybe (a -> b) -> Maybe a -> Maybe b)
-> m (Maybe (a -> b)) -> m (Maybe a -> Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emitter m (a -> b) -> m (Maybe (a -> b))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m (a -> b)
mf m (Maybe a -> Maybe b) -> m (Maybe a) -> m (Maybe b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
mx)

instance (Monad m) => Monad (Emitter m) where
  return :: forall a. a -> Emitter m a
return = a -> Emitter m a
forall a. a -> Emitter m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  Emitter m a
m >>= :: forall a b. Emitter m a -> (a -> Emitter m b) -> Emitter m b
>>= a -> Emitter m b
f =
    m (Maybe b) -> Emitter m b
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (m (Maybe b) -> Emitter m b) -> m (Maybe b) -> Emitter m b
forall a b. (a -> b) -> a -> b
$ do
      Maybe a
ma <- Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
m
      case Maybe a
ma of
        Maybe a
Nothing -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
        Just a
a -> Emitter m b -> m (Maybe b)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit (a -> Emitter m b
f a
a)

instance (Monad m, Alternative m) => Alternative (Emitter m) where
  empty :: forall a. Emitter m a
empty = m (Maybe a) -> Emitter m a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

  Emitter m a
x <|> :: forall a. Emitter m a -> Emitter m a -> Emitter m a
<|> Emitter m a
y =
    m (Maybe a) -> Emitter m a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (m (Maybe a) -> Emitter m a) -> m (Maybe a) -> Emitter m a
forall a b. (a -> b) -> a -> b
$ do
      (Emitter m a
i, Maybe a
ma) <- (Maybe a -> (Emitter m a, Maybe a))
-> m (Maybe a) -> m (Emitter m a, Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Emitter m a
y) (Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
x) m (Emitter m a, Maybe a)
-> m (Emitter m a, Maybe a) -> m (Emitter m a, Maybe a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe a -> (Emitter m a, Maybe a))
-> m (Maybe a) -> m (Emitter m a, Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Emitter m a
x) (Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
y)
      case Maybe a
ma of
        Maybe a
Nothing -> Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
i
        Just a
a -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

  -- Zero or more.
  many :: forall a. Emitter m a -> Emitter m [a]
many Emitter m a
e = m (Maybe [a]) -> Emitter m [a]
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (m (Maybe [a]) -> Emitter m [a]) -> m (Maybe [a]) -> Emitter m [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> m [a] -> m (Maybe [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emitter m a -> m [a]
forall (m :: * -> *) a. Monad m => Emitter m a -> m [a]
toListM Emitter m a
e

instance (Alternative m, Monad m) => MonadPlus (Emitter m) where
  mzero :: forall a. Emitter m a
mzero = Emitter m a
forall a. Emitter m a
forall (f :: * -> *) a. Alternative f => f a
empty

  mplus :: forall a. Emitter m a -> Emitter m a -> Emitter m a
mplus = Emitter m a -> Emitter m a -> Emitter m a
forall a. Emitter m a -> Emitter m a -> Emitter m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance (Alternative m, Monad m) => Semigroup (Emitter m a) where
  <> :: Emitter m a -> Emitter m a -> Emitter m a
(<>) = Emitter m a -> Emitter m a -> Emitter m a
forall a. Emitter m a -> Emitter m a -> Emitter m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance (Alternative m, Monad m) => Monoid (Emitter m a) where
  mempty :: Emitter m a
mempty = Emitter m a
forall a. Emitter m a
forall (f :: * -> *) a. Alternative f => f a
empty

  mappend :: Emitter m a -> Emitter m a -> Emitter m a
mappend = Emitter m a -> Emitter m a -> Emitter m a
forall a. Semigroup a => a -> a -> a
(<>)

-- | This fold completes on the first Nothing emitted, which may not be what you want.
instance FoldableM Emitter where
  foldrM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Emitter m a -> m b
foldrM a -> m b -> m b
acc m b
begin Emitter m a
e =
    m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
begin (\a
a' -> (a -> m b -> m b) -> m b -> Emitter m a -> m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Emitter m a -> m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(FoldableM t, Monad m) =>
(a -> m b -> m b) -> m b -> t m a -> m b
foldrM a -> m b -> m b
acc (a -> m b -> m b
acc a
a' m b
begin) Emitter m a
e) (Maybe a -> m b) -> m (Maybe a) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e

-- | Collect emits into a list, and close on the first Nothing.
--
-- >>> toListM <$|> qList [1..3]
-- [1,2,3]
toListM :: (Monad m) => Emitter m a -> m [a]
toListM :: forall (m :: * -> *) a. Monad m => Emitter m a -> m [a]
toListM Emitter m a
e = DList a -> [a]
forall a. DList a -> [a]
D.toList (DList a -> [a]) -> m (DList a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (DList a) -> m (DList a))
-> m (DList a) -> Emitter m a -> m (DList a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b -> m b) -> m b -> Emitter m a -> m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(FoldableM t, Monad m) =>
(a -> m b -> m b) -> m b -> t m a -> m b
foldrM (\a
a m (DList a)
acc -> (DList a -> DList a) -> m (DList a) -> m (DList a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DList a -> a -> DList a
forall a. DList a -> a -> DList a
`D.snoc` a
a) m (DList a)
acc) (DList a -> m (DList a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList a
forall a. DList a
D.empty) Emitter m a
e

-- | A monadic [Witherable](https://hackage.haskell.org/package/witherable)
--
-- >>> toListM <$|> witherE (\x -> bool (print x >> pure Nothing) (pure (Just x)) (even x)) <$> (qList [1..3])
-- 1
-- []
witherE :: (Monad m) => (a -> m (Maybe b)) -> Emitter m a -> Emitter m b
witherE :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Emitter m a -> Emitter m b
witherE a -> m (Maybe b)
f Emitter m a
e = m (Maybe b) -> Emitter m b
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter m (Maybe b)
go
  where
    go :: m (Maybe b)
go = do
      Maybe a
a <- Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e
      case Maybe a
a of
        Maybe a
Nothing -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
        Just a
a' -> do
          Maybe b
fa <- a -> m (Maybe b)
f a
a'
          case Maybe b
fa of
            Maybe b
Nothing -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
            Just b
fa' -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Maybe b
forall a. a -> Maybe a
Just b
fa')

-- | Like witherE but does not emit Nothing on filtering.
--
-- >>> toListM <$|> filterE (\x -> bool (print x >> pure Nothing) (pure (Just x)) (even x)) <$> (qList [1..3])
-- 1
-- 3
-- [2]
filterE :: (Monad m) => (a -> m (Maybe b)) -> Emitter m a -> Emitter m b
filterE :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Emitter m a -> Emitter m b
filterE a -> m (Maybe b)
f Emitter m a
e = m (Maybe b) -> Emitter m b
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter m (Maybe b)
go
  where
    go :: m (Maybe b)
go = do
      Maybe a
a <- Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e
      case Maybe a
a of
        Maybe a
Nothing -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
        Just a
a' -> do
          Maybe b
fa <- a -> m (Maybe b)
f a
a'
          case Maybe b
fa of
            Maybe b
Nothing -> m (Maybe b)
go
            Just b
fa' -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Maybe b
forall a. a -> Maybe a
Just b
fa')

-- | Read parse 'Emitter', returning the original text on error
--
-- >>> (toListM . readE) <$|> (qList ["1","2","3","four"]) :: IO [Either Text Int]
-- [Right 1,Right 2,Right 3,Left "four"]
readE ::
  (Functor m, Read a) =>
  Emitter m Text ->
  Emitter m (Either Text a)
readE :: forall (m :: * -> *) a.
(Functor m, Read a) =>
Emitter m Text -> Emitter m (Either Text a)
readE = (Text -> Either Text a)
-> Emitter m Text -> Emitter m (Either Text a)
forall a b. (a -> b) -> Emitter m a -> Emitter m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Either Text a)
 -> Emitter m Text -> Emitter m (Either Text a))
-> (Text -> Either Text a)
-> Emitter m Text
-> Emitter m (Either Text a)
forall a b. (a -> b) -> a -> b
$ String -> Either Text a
forall {b}. Read b => String -> Either Text b
parsed (String -> Either Text a)
-> (Text -> String) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
  where
    parsed :: String -> Either Text b
parsed String
str =
      case ReadS b
forall a. Read a => ReadS a
reads String
str of
        [(b
a, String
"")] -> b -> Either Text b
forall a b. b -> Either a b
Right b
a
        [(b, String)]
_err -> Text -> Either Text b
forall a b. a -> Either a b
Left (String -> Text
pack String
str)

-- | Convert a list emitter to a (Stateful) element emitter.
--
-- >>> import Control.Monad.State.Lazy
-- >>> flip runStateT [] . toListM . unlistE <$|> (qList [[0..3],[5..7]])
-- ([0,1,2,3,5,6,7],[])
unlistE :: (Monad m) => Emitter m [a] -> Emitter (StateT [a] m) a
unlistE :: forall (m :: * -> *) a.
Monad m =>
Emitter m [a] -> Emitter (StateT [a] m) a
unlistE Emitter m [a]
es = StateT [a] m (Maybe a) -> Emitter (StateT [a] m) a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter StateT [a] m (Maybe a)
unlists
  where
    -- unlists :: (Monad m) => StateT [a] m (Maybe a)
    unlists :: StateT [a] m (Maybe a)
unlists = do
      [a]
rs <- StateT [a] m [a]
forall s (m :: * -> *). MonadState s m => m s
get
      case [a]
rs of
        [] -> do
          Maybe [a]
xs <- m (Maybe [a]) -> StateT [a] m (Maybe [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 (Maybe [a]) -> StateT [a] m (Maybe [a]))
-> m (Maybe [a]) -> StateT [a] m (Maybe [a])
forall a b. (a -> b) -> a -> b
$ Emitter m [a] -> m (Maybe [a])
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m [a]
es
          case Maybe [a]
xs of
            Maybe [a]
Nothing -> Maybe a -> StateT [a] m (Maybe a)
forall a. a -> StateT [a] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
            Just [a]
xs' -> do
              [a] -> StateT [a] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [a]
xs'
              StateT [a] m (Maybe a)
unlists
        (a
x : [a]
rs') -> do
          [a] -> StateT [a] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [a]
rs'
          Maybe a -> StateT [a] m (Maybe a)
forall a. a -> StateT [a] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x)

-- | Take n emits.
--
-- >>> import Control.Monad.State.Lazy
-- >>> flip evalStateT 0 <$|> toListM . takeE 4 <$> qList [0..]
-- [0,1,2,3]
takeE :: (Monad m) => Int -> Emitter m a -> Emitter (StateT Int m) a
takeE :: forall (m :: * -> *) a.
Monad m =>
Int -> Emitter m a -> Emitter (StateT Int m) a
takeE Int
n (Emitter m (Maybe a)
e) =
  StateT Int m (Maybe a) -> Emitter (StateT Int m) a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (StateT Int m (Maybe a) -> Emitter (StateT Int m) a)
-> StateT Int m (Maybe a) -> Emitter (StateT Int m) a
forall a b. (a -> b) -> a -> b
$ StateT Int m Int
forall s (m :: * -> *). MonadState s m => m s
get StateT Int m Int
-> (Int -> StateT Int m (Maybe a)) -> StateT Int m (Maybe a)
forall a b.
StateT Int m a -> (a -> StateT Int m b) -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n' -> StateT Int m (Maybe a)
-> StateT Int m (Maybe a) -> Bool -> StateT Int m (Maybe a)
forall a. a -> a -> Bool -> a
bool (Maybe a -> StateT Int m (Maybe a)
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) (Int -> StateT Int m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) StateT Int m () -> StateT Int m (Maybe a) -> StateT Int m (Maybe a)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Maybe a) -> StateT Int m (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe a)
e) (Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n)

-- | Drop n emits.
--
-- >>> import Control.Monad.State.Lazy
-- >>> toListM <$|> (dropE 2 =<< qList [0..3])
-- [2,3]
dropE :: (Monad m) => Int -> Emitter m a -> CoEmitter m a
dropE :: forall (m :: * -> *) a.
Monad m =>
Int -> Emitter m a -> CoEmitter m a
dropE Int
n Emitter m a
e = (forall b. (Emitter m a -> m b) -> m b)
-> Codensity m (Emitter m a)
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (Emitter m a -> m b) -> m b)
 -> Codensity m (Emitter m a))
-> (forall b. (Emitter m a -> m b) -> m b)
-> Codensity m (Emitter m a)
forall a b. (a -> b) -> a -> b
$ \Emitter m a -> m b
k -> do
  Int -> m (Maybe a) -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e)
  Emitter m a -> m b
k Emitter m a
e

-- | Take from an emitter until a predicate.
--
-- >>> (toListM . takeUntilE (==3)) <$|> (qList [0..])
-- [0,1,2]
takeUntilE :: (Monad m) => (a -> Bool) -> Emitter m a -> Emitter m a
takeUntilE :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Emitter m a -> Emitter m a
takeUntilE a -> Bool
p Emitter m a
e = m (Maybe a) -> Emitter m a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (m (Maybe a) -> Emitter m a) -> m (Maybe a) -> Emitter m a
forall a b. (a -> b) -> a -> b
$ do
  Maybe a
x <- Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e
  case Maybe a
x of
    Maybe a
Nothing -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just a
x' ->
      m (Maybe a) -> m (Maybe a) -> Bool -> m (Maybe a)
forall a. a -> a -> Bool -> a
bool (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x')) (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) (a -> Bool
p a
x')

-- | Pop from a State sequence.
--
-- >>> import qualified Data.Sequence as Seq
-- >>> import Control.Monad.State.Lazy (evalStateT)
-- >>> flip evalStateT (Seq.fromList [1..3]) $ toListM pop
-- [1,2,3]
pop :: (Monad m) => Emitter (StateT (Seq.Seq a) m) a
pop :: forall (m :: * -> *) a. Monad m => Emitter (StateT (Seq a) m) a
pop = StateT (Seq a) m (Maybe a) -> Emitter (StateT (Seq a) m) a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (StateT (Seq a) m (Maybe a) -> Emitter (StateT (Seq a) m) a)
-> StateT (Seq a) m (Maybe a) -> Emitter (StateT (Seq a) m) a
forall a b. (a -> b) -> a -> b
$ do
  Seq a
xs <- StateT (Seq a) m (Seq a)
forall s (m :: * -> *). MonadState s m => m s
get
  case Seq a
xs of
    Seq a
Seq.Empty -> Maybe a -> StateT (Seq a) m (Maybe a)
forall a. a -> StateT (Seq a) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    (a
x Seq.:<| Seq a
xs') -> do
      Seq a -> StateT (Seq a) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Seq a
xs'
      Maybe a -> StateT (Seq a) m (Maybe a)
forall a. a -> StateT (Seq a) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x)