-- | Stuff for streaming search results.
module Overeasy.Streams
  ( chooseWith
  , choose
  , Stream
  , streamAll
  ) where

import Control.Applicative (Alternative (..))
import Control.Monad (MonadPlus)
import Control.Monad.Logic (LogicT, MonadLogic, observeAllT)
import Control.Monad.Reader (MonadReader (..), ReaderT (..))
import Control.Monad.State.Strict (MonadState (..), State, runState)

newtype M r s a = M { forall r s a. M r s a -> ReaderT r (State s) a
unM :: ReaderT r (State s) a }
  deriving newtype (
    forall a b. a -> M r s b -> M r s a
forall a b. (a -> b) -> M r s a -> M r s b
forall r s a b. a -> M r s b -> M r s a
forall r s a b. (a -> b) -> M r s a -> M r s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> M r s b -> M r s a
$c<$ :: forall r s a b. a -> M r s b -> M r s a
fmap :: forall a b. (a -> b) -> M r s a -> M r s b
$cfmap :: forall r s a b. (a -> b) -> M r s a -> M r s b
Functor, forall a. a -> M r s a
forall r s. Functor (M r s)
forall a b. M r s a -> M r s b -> M r s a
forall a b. M r s a -> M r s b -> M r s b
forall a b. M r s (a -> b) -> M r s a -> M r s b
forall r s a. a -> M r s a
forall a b c. (a -> b -> c) -> M r s a -> M r s b -> M r s c
forall r s a b. M r s a -> M r s b -> M r s a
forall r s a b. M r s a -> M r s b -> M r s b
forall r s a b. M r s (a -> b) -> M r s a -> M r s b
forall r s a b c. (a -> b -> c) -> M r s a -> M r s b -> M r s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. M r s a -> M r s b -> M r s a
$c<* :: forall r s a b. M r s a -> M r s b -> M r s a
*> :: forall a b. M r s a -> M r s b -> M r s b
$c*> :: forall r s a b. M r s a -> M r s b -> M r s b
liftA2 :: forall a b c. (a -> b -> c) -> M r s a -> M r s b -> M r s c
$cliftA2 :: forall r s a b c. (a -> b -> c) -> M r s a -> M r s b -> M r s c
<*> :: forall a b. M r s (a -> b) -> M r s a -> M r s b
$c<*> :: forall r s a b. M r s (a -> b) -> M r s a -> M r s b
pure :: forall a. a -> M r s a
$cpure :: forall r s a. a -> M r s a
Applicative, forall a. a -> M r s a
forall r s. Applicative (M r s)
forall a b. M r s a -> M r s b -> M r s b
forall a b. M r s a -> (a -> M r s b) -> M r s b
forall r s a. a -> M r s a
forall r s a b. M r s a -> M r s b -> M r s b
forall r s a b. M r s a -> (a -> M r s b) -> M r s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> M r s a
$creturn :: forall r s a. a -> M r s a
>> :: forall a b. M r s a -> M r s b -> M r s b
$c>> :: forall r s a b. M r s a -> M r s b -> M r s b
>>= :: forall a b. M r s a -> (a -> M r s b) -> M r s b
$c>>= :: forall r s a b. M r s a -> (a -> M r s b) -> M r s b
Monad,
    MonadReader r, MonadState s)

runM :: M r s a -> r -> s -> (a, s)
runM :: forall r s a. M r s a -> r -> s -> (a, s)
runM M r s a
m r
r = forall s a. State s a -> s -> (a, s)
runState (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall r s a. M r s a -> ReaderT r (State s) a
unM M r s a
m) r
r)

-- | Choose one of many alteratives and process it with the given function.
chooseWith :: (Foldable f, Alternative m) => f a -> (a -> m b) -> m b
chooseWith :: forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Alternative m) =>
f a -> (a -> m b) -> m b
chooseWith f a
fa a -> m b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f) forall (f :: * -> *) a. Alternative f => f a
empty f a
fa

-- | Choose one of many alteratives.
choose :: (Foldable f, Alternative m) => f a -> m a
choose :: forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f a -> m a
choose f a
fa = forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Alternative m) =>
f a -> (a -> m b) -> m b
chooseWith f a
fa forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | A stream of results. Just a wrapper around 'LogicT' to keep things tidy.
newtype Stream r s a = Stream { forall r s a. Stream r s a -> LogicT (M r s) a
unStream :: LogicT (M r s) a }
  deriving newtype (
    forall a b. a -> Stream r s b -> Stream r s a
forall a b. (a -> b) -> Stream r s a -> Stream r s b
forall r s a b. a -> Stream r s b -> Stream r s a
forall r s a b. (a -> b) -> Stream r s a -> Stream r s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Stream r s b -> Stream r s a
$c<$ :: forall r s a b. a -> Stream r s b -> Stream r s a
fmap :: forall a b. (a -> b) -> Stream r s a -> Stream r s b
$cfmap :: forall r s a b. (a -> b) -> Stream r s a -> Stream r s b
Functor, forall a. a -> Stream r s a
forall r s. Functor (Stream r s)
forall a b. Stream r s a -> Stream r s b -> Stream r s a
forall a b. Stream r s a -> Stream r s b -> Stream r s b
forall a b. Stream r s (a -> b) -> Stream r s a -> Stream r s b
forall r s a. a -> Stream r s a
forall a b c.
(a -> b -> c) -> Stream r s a -> Stream r s b -> Stream r s c
forall r s a b. Stream r s a -> Stream r s b -> Stream r s a
forall r s a b. Stream r s a -> Stream r s b -> Stream r s b
forall r s a b. Stream r s (a -> b) -> Stream r s a -> Stream r s b
forall r s a b c.
(a -> b -> c) -> Stream r s a -> Stream r s b -> Stream r s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Stream r s a -> Stream r s b -> Stream r s a
$c<* :: forall r s a b. Stream r s a -> Stream r s b -> Stream r s a
*> :: forall a b. Stream r s a -> Stream r s b -> Stream r s b
$c*> :: forall r s a b. Stream r s a -> Stream r s b -> Stream r s b
liftA2 :: forall a b c.
(a -> b -> c) -> Stream r s a -> Stream r s b -> Stream r s c
$cliftA2 :: forall r s a b c.
(a -> b -> c) -> Stream r s a -> Stream r s b -> Stream r s c
<*> :: forall a b. Stream r s (a -> b) -> Stream r s a -> Stream r s b
$c<*> :: forall r s a b. Stream r s (a -> b) -> Stream r s a -> Stream r s b
pure :: forall a. a -> Stream r s a
$cpure :: forall r s a. a -> Stream r s a
Applicative, forall a. a -> Stream r s a
forall r s. Applicative (Stream r s)
forall a b. Stream r s a -> Stream r s b -> Stream r s b
forall a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
forall r s a. a -> Stream r s a
forall r s a b. Stream r s a -> Stream r s b -> Stream r s b
forall r s a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Stream r s a
$creturn :: forall r s a. a -> Stream r s a
>> :: forall a b. Stream r s a -> Stream r s b -> Stream r s b
$c>> :: forall r s a b. Stream r s a -> Stream r s b -> Stream r s b
>>= :: forall a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
$c>>= :: forall r s a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
Monad,
    MonadReader r, MonadState s, forall a. Stream r s a -> Stream r s a
forall a. Stream r s a -> Stream r s (Maybe (a, Stream r s a))
forall a. Stream r s a -> Stream r s ()
forall a. Stream r s a -> Stream r s a -> Stream r s a
forall r s. Monad (Stream r s)
forall {r} {s}. Alternative (Stream r s)
forall a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
forall a b.
Stream r s a -> (a -> Stream r s b) -> Stream r s b -> Stream r s b
forall r s a. Stream r s a -> Stream r s a
forall r s a. Stream r s a -> Stream r s (Maybe (a, Stream r s a))
forall r s a. Stream r s a -> Stream r s ()
forall r s a. Stream r s a -> Stream r s a -> Stream r s a
forall r s a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
forall r s a b.
Stream r s a -> (a -> Stream r s b) -> Stream r s b -> Stream r s b
forall (m :: * -> *).
Monad m
-> Alternative m
-> (forall a. m a -> m (Maybe (a, m a)))
-> (forall a. m a -> m a -> m a)
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a. m a -> m a)
-> (forall a. m a -> m ())
-> (forall a b. m a -> (a -> m b) -> m b -> m b)
-> MonadLogic m
ifte :: forall a b.
Stream r s a -> (a -> Stream r s b) -> Stream r s b -> Stream r s b
$cifte :: forall r s a b.
Stream r s a -> (a -> Stream r s b) -> Stream r s b -> Stream r s b
lnot :: forall a. Stream r s a -> Stream r s ()
$clnot :: forall r s a. Stream r s a -> Stream r s ()
once :: forall a. Stream r s a -> Stream r s a
$conce :: forall r s a. Stream r s a -> Stream r s a
>>- :: forall a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
$c>>- :: forall r s a b. Stream r s a -> (a -> Stream r s b) -> Stream r s b
interleave :: forall a. Stream r s a -> Stream r s a -> Stream r s a
$cinterleave :: forall r s a. Stream r s a -> Stream r s a -> Stream r s a
msplit :: forall a. Stream r s a -> Stream r s (Maybe (a, Stream r s a))
$cmsplit :: forall r s a. Stream r s a -> Stream r s (Maybe (a, Stream r s a))
MonadLogic,
    forall a. Stream r s a
forall a. Stream r s a -> Stream r s [a]
forall a. Stream r s a -> Stream r s a -> Stream r s a
forall r s. Applicative (Stream r s)
forall r s a. Stream r s a
forall r s a. Stream r s a -> Stream r s [a]
forall r s a. Stream r s a -> Stream r s a -> Stream r s a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Stream r s a -> Stream r s [a]
$cmany :: forall r s a. Stream r s a -> Stream r s [a]
some :: forall a. Stream r s a -> Stream r s [a]
$csome :: forall r s a. Stream r s a -> Stream r s [a]
<|> :: forall a. Stream r s a -> Stream r s a -> Stream r s a
$c<|> :: forall r s a. Stream r s a -> Stream r s a -> Stream r s a
empty :: forall a. Stream r s a
$cempty :: forall r s a. Stream r s a
Alternative, forall a. Stream r s a
forall a. Stream r s a -> Stream r s a -> Stream r s a
forall r s. Monad (Stream r s)
forall {r} {s}. Alternative (Stream r s)
forall r s a. Stream r s a
forall r s a. Stream r s a -> Stream r s a -> Stream r s a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Stream r s a -> Stream r s a -> Stream r s a
$cmplus :: forall r s a. Stream r s a -> Stream r s a -> Stream r s a
mzero :: forall a. Stream r s a
$cmzero :: forall r s a. Stream r s a
MonadPlus, NonEmpty (Stream r s a) -> Stream r s a
Stream r s a -> Stream r s a -> Stream r s a
forall b. Integral b => b -> Stream r s a -> Stream r s a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall r s a. NonEmpty (Stream r s a) -> Stream r s a
forall r s a. Stream r s a -> Stream r s a -> Stream r s a
forall r s a b. Integral b => b -> Stream r s a -> Stream r s a
stimes :: forall b. Integral b => b -> Stream r s a -> Stream r s a
$cstimes :: forall r s a b. Integral b => b -> Stream r s a -> Stream r s a
sconcat :: NonEmpty (Stream r s a) -> Stream r s a
$csconcat :: forall r s a. NonEmpty (Stream r s a) -> Stream r s a
<> :: Stream r s a -> Stream r s a -> Stream r s a
$c<> :: forall r s a. Stream r s a -> Stream r s a -> Stream r s a
Semigroup, Stream r s a
[Stream r s a] -> Stream r s a
Stream r s a -> Stream r s a -> Stream r s a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall r s a. Semigroup (Stream r s a)
forall r s a. Stream r s a
forall r s a. [Stream r s a] -> Stream r s a
forall r s a. Stream r s a -> Stream r s a -> Stream r s a
mconcat :: [Stream r s a] -> Stream r s a
$cmconcat :: forall r s a. [Stream r s a] -> Stream r s a
mappend :: Stream r s a -> Stream r s a -> Stream r s a
$cmappend :: forall r s a. Stream r s a -> Stream r s a -> Stream r s a
mempty :: Stream r s a
$cmempty :: forall r s a. Stream r s a
Monoid)

-- | Produces all results from the stream.
streamAll :: Stream r s a -> r -> s -> [a]
streamAll :: forall r s a. Stream r s a -> r -> s -> [a]
streamAll Stream r s a
stream r
env s
st = forall a b. (a, b) -> a
fst (forall r s a. M r s a -> r -> s -> (a, s)
runM (forall (m :: * -> *) a. Applicative m => LogicT m a -> m [a]
observeAllT (forall r s a. Stream r s a -> LogicT (M r s) a
unStream Stream r s a
stream)) r
env s
st)