{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

-- | `emit`
module Box.Emitter
  ( Emitter (..),
    mapE,
    readE,
    readE_,
    parseE,
    parseE_,
    premapE,
    postmapE,
    postmapM,
    toListE,
    unlistE,
    stateE,
    takeE,
    takeUntilE,
    filterE,
  )
where

import Control.Applicative
import Control.Monad.Morph
import Control.Monad.State.Lazy
import qualified Data.Attoparsec.Text as A
import Data.Bool
import Data.Foldable
import qualified Data.Sequence as Seq
import Data.Text (Text, pack, unpack)
import Prelude

-- | an `Emitter` "emits" values of type a. A Source & a Producer (of a's) are the two other alternative but overloaded metaphors out there.
--
-- An Emitter "reaches into itself" for the value to emit, where itself is an opaque thing from the pov of usage.  An Emitter is named for its main action: it emits.
newtype Emitter m a = Emitter
  { Emitter m a -> m (Maybe a)
emit :: m (Maybe a)
  }

instance MFunctor Emitter where
  hoist :: (forall a. m a -> n a) -> Emitter m b -> Emitter n b
hoist forall a. m a -> n a
nat (Emitter m (Maybe b)
e) = n (Maybe b) -> Emitter n b
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (m (Maybe b) -> n (Maybe b)
forall a. m a -> n a
nat m (Maybe b)
e)

instance (Functor m) => Functor (Emitter m) where
  fmap :: (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r))

  Emitter m (a -> b)
mf <*> :: 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 (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 (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 :: a -> Emitter m a
return a
r = m (Maybe a) -> Emitter m a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r))

  Emitter m a
m >>= :: 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 (m :: * -> *) a. Monad m => a -> m a
return 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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

  Emitter m a
x <|> :: 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 (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

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

  mplus :: Emitter m a -> Emitter m a -> Emitter m a
mplus = 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 (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 (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
(<>)

-- | like a monadic mapMaybe. (See [witherable](https://hackage.haskell.org/package/witherable))
mapE :: (Monad m) => (a -> m (Maybe b)) -> Emitter m a -> Emitter m b
mapE :: (a -> m (Maybe b)) -> Emitter m a -> Emitter m b
mapE 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Maybe b
forall a. a -> Maybe a
Just b
fa')

-- | parse emitter which returns the original text on failure
parseE :: (Functor m) => A.Parser a -> Emitter m Text -> Emitter m (Either Text a)
parseE :: Parser a -> Emitter m Text -> Emitter m (Either Text a)
parseE Parser a
parser Emitter m Text
e = (\Text
t -> (String -> Either Text a)
-> (a -> Either Text a) -> Either String a -> Either Text a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Text a -> String -> Either Text a
forall a b. a -> b -> a
const (Either Text a -> String -> Either Text a)
-> Either Text a -> String -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left Text
t) a -> Either Text a
forall a b. b -> Either a b
Right (Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser a
parser Text
t)) (Text -> Either Text a)
-> Emitter m Text -> Emitter m (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emitter m Text
e

-- | no error-reporting parsing
parseE_ :: (Monad m) => A.Parser a -> Emitter m Text -> Emitter m a
parseE_ :: Parser a -> Emitter m Text -> Emitter m a
parseE_ Parser a
parser = (Either Text a -> m (Maybe a))
-> Emitter m (Either Text a) -> Emitter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Emitter m a -> Emitter m b
mapE (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a))
-> (Either Text a -> Maybe a) -> Either Text a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe a) -> (a -> Maybe a) -> Either Text a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> Text -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just) (Emitter m (Either Text a) -> Emitter m a)
-> (Emitter m Text -> Emitter m (Either Text a))
-> Emitter m Text
-> Emitter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Emitter m Text -> Emitter m (Either Text a)
forall (m :: * -> *) a.
Functor m =>
Parser a -> Emitter m Text -> Emitter m (Either Text a)
parseE Parser a
parser

-- | read parse emitter, returning the original string on error
readE ::
  (Functor m, Read a) =>
  Emitter m Text ->
  Emitter m (Either Text a)
readE :: Emitter m Text -> Emitter m (Either Text a)
readE = (Text -> Either Text a)
-> Emitter m Text -> Emitter m (Either Text a)
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)

-- | no error-reporting reading
readE_ ::
  (Monad m, Read a) =>
  Emitter m Text ->
  Emitter m a
readE_ :: Emitter m Text -> Emitter m a
readE_ = (Either Text a -> m (Maybe a))
-> Emitter m (Either Text a) -> Emitter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Emitter m a -> Emitter m b
mapE (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a))
-> (Either Text a -> Maybe a) -> Either Text a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe a) -> (a -> Maybe a) -> Either Text a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> Text -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just) (Emitter m (Either Text a) -> Emitter m a)
-> (Emitter m Text -> Emitter m (Either Text a))
-> Emitter m Text
-> Emitter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Emitter m Text -> Emitter m (Either Text a)
forall (m :: * -> *) a.
(Functor m, Read a) =>
Emitter m Text -> Emitter m (Either Text a)
readE

-- | adds a pre-emit monadic action to the emitter
premapE ::
  (Applicative m) =>
  (Emitter m a -> m ()) ->
  Emitter m a ->
  Emitter m a
premapE :: (Emitter m a -> m ()) -> Emitter m a -> Emitter m a
premapE Emitter m a -> m ()
f 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
$ Emitter m a -> m ()
f Emitter m a
e m () -> m (Maybe a) -> m (Maybe a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e

-- | adds a post-emit monadic action to the emitter
postmapE ::
  (Monad m) =>
  (Emitter m a -> m ()) ->
  Emitter m a ->
  Emitter m a
postmapE :: (Emitter m a -> m ()) -> Emitter m a -> Emitter m a
postmapE Emitter m a -> m ()
f 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
r <- Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e
  Emitter m a -> m ()
f Emitter m a
e
  Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
r

-- | add a post-emit monadic action on the emitted value (if there was any)
postmapM ::
  (Monad m) =>
  (a -> m ()) ->
  Emitter m a ->
  Emitter m a
postmapM :: (a -> m ()) -> Emitter m a -> Emitter m a
postmapM a -> m ()
f 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
r <- Emitter m a -> m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter m a
e
  case Maybe a
r of
    Maybe a
Nothing -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just a
r' -> do
      a -> m ()
f a
r'
      Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
r')

-- | turn an emitter into a list
toListE :: (Monad m) => Emitter m a -> m [a]
toListE :: Emitter m a -> m [a]
toListE Emitter m a
e = Seq a -> Emitter m a -> m [a]
forall (m :: * -> *) a. Monad m => Seq a -> Emitter m a -> m [a]
go Seq a
forall a. Seq a
Seq.empty Emitter m a
e
  where
    go :: Seq a -> Emitter m a -> m [a]
go Seq a
xs Emitter m a
e' = 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 -> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs)
        Just a
x' -> Seq a -> Emitter m a -> m [a]
go (Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.:|> a
x') Emitter m a
e'

-- | emit from a StateT Seq
--
-- FIXME: This compiles but is an infinite "a" emitter:
--
-- let e1 = hoist (flip evalStateT (Seq.fromList ["a", "b"::Text])) stateE :: Emitter IO Text
stateE :: (Monad m) => Emitter (StateT (Seq.Seq a) m) a
stateE :: Emitter (StateT (Seq a) m) a
stateE = 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> StateT (Seq a) m (Maybe a))
-> Maybe a -> StateT (Seq a) m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x

-- | convert a list emitter to a Stateful element emitter
unlistE :: (Monad m) => Emitter m [a] -> Emitter (StateT [a] m) a
unlistE :: Emitter m [a] -> Emitter (StateT [a] m) a
unlistE Emitter m [a]
es = ([a] -> StateT [a] m (Maybe a))
-> Emitter (StateT [a] m) [a] -> Emitter (StateT [a] m) a
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Emitter m a -> Emitter m b
mapE [a] -> StateT [a] m (Maybe a)
forall (m :: * -> *) a. MonadState [a] m => [a] -> m (Maybe a)
unlistS ((forall a. m a -> StateT [a] m a)
-> Emitter m [a] -> Emitter (StateT [a] m) [a]
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> StateT [a] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Emitter m [a]
es)
  where
    unlistS :: [a] -> m (Maybe a)
unlistS [a]
xs = do
      [a]
rs <- m [a]
forall s (m :: * -> *). MonadState s m => m s
get
      case [a]
rs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
xs of
        [] -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        (a
x : [a]
xs') -> do
          [a] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [a]
xs'
          Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x)

-- | Stop an 'Emitter' after n 'emit's
takeE :: (Monad m) => Int -> Emitter m a -> Emitter (StateT Int m) a
takeE :: Int -> Emitter m a -> Emitter (StateT Int m) a
takeE Int
n Emitter m 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
$ do
  Maybe a
x <- Emitter (StateT Int m) a -> StateT Int m (Maybe a)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit ((forall a. m a -> StateT Int m a)
-> Emitter m a -> Emitter (StateT Int m) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Emitter m a
e)
  case Maybe a
x of
    Maybe a
Nothing -> Maybe a -> StateT Int m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just a
x' -> do
      Int
n' <- StateT Int m Int
forall s (m :: * -> *). MonadState s m => m s
get
      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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) (Int -> StateT Int m (Maybe a)
emit' Int
n') (Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n)
      where
        emit' :: Int -> StateT Int m (Maybe a)
emit' Int
n' = do
          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)
          Maybe a -> StateT Int m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> StateT Int m (Maybe a))
-> Maybe a -> StateT Int m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x'

-- | Take from an emitter until predicate
takeUntilE :: (Monad m) => (a -> Bool) -> Emitter m a -> Emitter m a
takeUntilE :: (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) (a -> Bool
p a
x')

-- | Filter emissions according to a predicate.
filterE :: (Monad m) => (a -> Bool) -> Emitter m a -> Emitter m a
filterE :: (a -> Bool) -> Emitter m a -> Emitter m a
filterE 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)
go
  where
    go :: m (Maybe a)
go = 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 (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 m (Maybe a)
go (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x')) (a -> Bool
p a
x')