{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}

#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#endif

module Control.Monad.Logic.Sequence
(   SeqT(..)
  , Seq
  , Queue
  , MSeq(..)
  , AsUnitLoop(..)
  , observeAllT
  , observeAll
  , observeT
  , observe
  , observeMaybeT
  , observeMaybe
  , module Control.Monad
  , module Control.Monad.Trans
)
where

import Control.Applicative
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.Identity (Identity(..))
import Control.Monad.Trans (MonadTrans(..))
import Control.Monad.Trans as Trans
import Control.Monad.Logic.Class
import Control.Monad.IO.Class ()
import Data.TASequence.FastCatQueue as TA
import Data.SequenceClass as S

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
#endif

#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif

import qualified Data.Foldable as F
import qualified Data.Traversable as T


-- | Based on the LogicT improvements in the paper, Reflection without
-- Remorse. Code is based on the code provided in:
-- https://github.com/atzeus/reflectionwithoutremorse
--
-- Note: that code is provided under an MIT license, so we use that as
-- well.

type Queue = MSeq FastTCQueue

data AsUnitLoop a b c where
  UL :: !a -> AsUnitLoop a () ()

newtype MSeq s a = MSeq { MSeq s a -> s (AsUnitLoop a) () ()
getMS :: s (AsUnitLoop a) () () }

newtype SeqT m a = SeqT (Queue (m (Maybe (a, SeqT m a))))

type Seq a = SeqT Identity a

instance TASequence s => Sequence (MSeq s) where
  empty :: MSeq s c
empty = s (AsUnitLoop c) () () -> MSeq s c
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x.
TASequence s =>
s c x x
tempty
  singleton :: c -> MSeq s c
singleton = s (AsUnitLoop c) () () -> MSeq s c
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq (s (AsUnitLoop c) () () -> MSeq s c)
-> (c -> s (AsUnitLoop c) () ()) -> c -> MSeq s c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsUnitLoop c () () -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x y.
TASequence s =>
c x y -> s c x y
tsingleton (AsUnitLoop c () () -> s (AsUnitLoop c) () ())
-> (c -> AsUnitLoop c () ()) -> c -> s (AsUnitLoop c) () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> AsUnitLoop c () ()
forall a. a -> AsUnitLoop a () ()
UL
  MSeq s c
l >< :: MSeq s c -> MSeq s c -> MSeq s c
>< MSeq s c
r = s (AsUnitLoop c) () () -> MSeq s c
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq (MSeq s c -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) a.
MSeq s a -> s (AsUnitLoop a) () ()
getMS MSeq s c
l s (AsUnitLoop c) () ()
-> s (AsUnitLoop c) () () -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x y
       z.
TASequence s =>
s c x y -> s c y z -> s c x z
TA.>< MSeq s c -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) a.
MSeq s a -> s (AsUnitLoop a) () ()
getMS MSeq s c
r)
  MSeq s c
l |> :: MSeq s c -> c -> MSeq s c
|> c
x = s (AsUnitLoop c) () () -> MSeq s c
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq (MSeq s c -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) a.
MSeq s a -> s (AsUnitLoop a) () ()
getMS MSeq s c
l s (AsUnitLoop c) () ()
-> AsUnitLoop c () () -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x y
       z.
TASequence s =>
s c x y -> c y z -> s c x z
TA.|> c -> AsUnitLoop c () ()
forall a. a -> AsUnitLoop a () ()
UL c
x)
  c
x <| :: c -> MSeq s c -> MSeq s c
<| MSeq s c
r = s (AsUnitLoop c) () () -> MSeq s c
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq (c -> AsUnitLoop c () ()
forall a. a -> AsUnitLoop a () ()
UL c
x AsUnitLoop c () ()
-> s (AsUnitLoop c) () () -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x y
       z.
TASequence s =>
c x y -> s c y z -> s c x z
TA.<| MSeq s c -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) a.
MSeq s a -> s (AsUnitLoop a) () ()
getMS MSeq s c
r)
  viewl :: MSeq s c -> ViewL (MSeq s) c
viewl MSeq s c
s = case s (AsUnitLoop c) () () -> TAViewL s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x y.
TASequence s =>
s c x y -> TAViewL s c x y
tviewl (MSeq s c -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) a.
MSeq s a -> s (AsUnitLoop a) () ()
getMS MSeq s c
s) of
    TAViewL s (AsUnitLoop c) () ()
TAEmptyL -> ViewL (MSeq s) c
forall (s :: * -> *) c. ViewL s c
EmptyL
    UL c
h TA.:< s (AsUnitLoop c) y1 ()
t -> c
h c -> MSeq s c -> ViewL (MSeq s) c
forall c (s :: * -> *). c -> s c -> ViewL s c
S.:< s (AsUnitLoop c) () () -> MSeq s c
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq s (AsUnitLoop c) y1 ()
s (AsUnitLoop c) () ()
t
  viewr :: MSeq s c -> ViewR (MSeq s) c
viewr MSeq s c
s = case s (AsUnitLoop c) () () -> TAViewR s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x y.
TASequence s =>
s c x y -> TAViewR s c x y
tviewr (MSeq s c -> s (AsUnitLoop c) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) a.
MSeq s a -> s (AsUnitLoop a) () ()
getMS MSeq s c
s) of
    TAViewR s (AsUnitLoop c) () ()
TAEmptyR -> ViewR (MSeq s) c
forall (s :: * -> *) c. ViewR s c
EmptyR
    s (AsUnitLoop c) () y1
p TA.:> UL c
l -> s (AsUnitLoop c) () () -> MSeq s c
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq s (AsUnitLoop c) () y1
s (AsUnitLoop c) () ()
p MSeq s c -> c -> ViewR (MSeq s) c
forall (s :: * -> *) c. s c -> c -> ViewR s c
S.:> c
l

instance TASequence s => Functor (MSeq s) where
  fmap :: (a -> b) -> MSeq s a -> MSeq s b
fmap a -> b
f = MSeq s a -> MSeq s b
go where
    go :: MSeq s a -> MSeq s b
go MSeq s a
q = case MSeq s a -> ViewL (MSeq s) a
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl MSeq s a
q of
      ViewL (MSeq s) a
EmptyL -> MSeq s b
forall (s :: * -> *) c. Sequence s => s c
S.empty
      a
h S.:< MSeq s a
t -> a -> b
f a
h b -> MSeq s b -> MSeq s b
forall (s :: * -> *) c. Sequence s => c -> s c -> s c
S.<| MSeq s a -> MSeq s b
go MSeq s a
t

instance TASequence s => F.Foldable (MSeq s) where
  foldMap :: (a -> m) -> MSeq s a -> m
foldMap a -> m
f = MSeq s a -> m
fm where
    fm :: MSeq s a -> m
fm MSeq s a
q = case MSeq s a -> ViewL (MSeq s) a
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl MSeq s a
q of
      ViewL (MSeq s) a
EmptyL -> m
forall a. Monoid a => a
mempty
      a
h S.:< MSeq s a
t -> a -> m
f a
h m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` MSeq s a -> m
fm MSeq s a
t

instance TASequence s => T.Traversable (MSeq s) where
  sequenceA :: MSeq s (f a) -> f (MSeq s a)
sequenceA MSeq s (f a)
q = case MSeq s (f a) -> ViewL (MSeq s) (f a)
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl MSeq s (f a)
q of
    ViewL (MSeq s) (f a)
EmptyL -> MSeq s a -> f (MSeq s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSeq s a
forall (s :: * -> *) c. Sequence s => s c
S.empty
    f a
h S.:< MSeq s (f a)
t -> (a -> MSeq s a -> MSeq s a) -> f (a -> MSeq s a -> MSeq s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> MSeq s a -> MSeq s a
forall (s :: * -> *) c. Sequence s => c -> s c -> s c
(S.<|) f (a -> MSeq s a -> MSeq s a) -> f a -> f (MSeq s a -> MSeq s a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
h f (MSeq s a -> MSeq s a) -> f (MSeq s a) -> f (MSeq s a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MSeq s (f a) -> f (MSeq s a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA MSeq s (f a)
t

fromView :: m (Maybe (a, SeqT m a)) -> SeqT m a
fromView :: m (Maybe (a, SeqT m a)) -> SeqT m a
fromView = Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
forall (m :: * -> *) a. Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
SeqT (Queue (m (Maybe (a, SeqT m a))) -> SeqT m a)
-> (m (Maybe (a, SeqT m a)) -> Queue (m (Maybe (a, SeqT m a))))
-> m (Maybe (a, SeqT m a))
-> SeqT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe (a, SeqT m a)) -> Queue (m (Maybe (a, SeqT m a)))
forall (s :: * -> *) c. Sequence s => c -> s c
singleton

toView :: Monad m => SeqT m a -> m (Maybe (a, SeqT m a))
toView :: SeqT m a -> m (Maybe (a, SeqT m a))
toView (SeqT Queue (m (Maybe (a, SeqT m a)))
s) = case Queue (m (Maybe (a, SeqT m a)))
-> ViewL (MSeq FastTCQueue) (m (Maybe (a, SeqT m a)))
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl Queue (m (Maybe (a, SeqT m a)))
s of
  ViewL (MSeq FastTCQueue) (m (Maybe (a, SeqT m a)))
EmptyL -> Maybe (a, SeqT m a) -> m (Maybe (a, SeqT m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, SeqT m a)
forall a. Maybe a
Nothing
  m (Maybe (a, SeqT m a))
h S.:< Queue (m (Maybe (a, SeqT m a)))
t -> m (Maybe (a, SeqT m a))
h m (Maybe (a, SeqT m a))
-> (Maybe (a, SeqT m a) -> m (Maybe (a, SeqT m a)))
-> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (a, SeqT m a)
Nothing -> SeqT m a -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView (Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
forall (m :: * -> *) a. Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
SeqT Queue (m (Maybe (a, SeqT m a)))
t)
    Just (a
hi, SeqT Queue (m (Maybe (a, SeqT m a)))
ti) -> Maybe (a, SeqT m a) -> m (Maybe (a, SeqT m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, SeqT m a) -> Maybe (a, SeqT m a)
forall a. a -> Maybe a
Just (a
hi, Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
forall (m :: * -> *) a. Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
SeqT (Queue (m (Maybe (a, SeqT m a)))
ti Queue (m (Maybe (a, SeqT m a)))
-> Queue (m (Maybe (a, SeqT m a)))
-> Queue (m (Maybe (a, SeqT m a)))
forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
S.>< Queue (m (Maybe (a, SeqT m a)))
t)))

single :: (MonadPlus mp, Monad m) => a -> m (Maybe (a, mp b))
single :: a -> m (Maybe (a, mp b))
single a
a = Maybe (a, mp b) -> m (Maybe (a, mp b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, mp b) -> Maybe (a, mp b)
forall a. a -> Maybe a
Just (a
a, mp b
forall (m :: * -> *) a. MonadPlus m => m a
mzero))

instance Monad m => Functor (SeqT m) where
  fmap :: (a -> b) -> SeqT m a -> SeqT m b
fmap a -> b
f SeqT m a
xs = SeqT m a
xs SeqT m a -> (a -> SeqT m b) -> SeqT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> SeqT m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> SeqT m b) -> (a -> b) -> a -> SeqT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

instance Monad m => Applicative (SeqT m) where
  pure :: a -> SeqT m a
pure = m (Maybe (a, SeqT m a)) -> SeqT m a
forall (m :: * -> *) a. m (Maybe (a, SeqT m a)) -> SeqT m a
fromView (m (Maybe (a, SeqT m a)) -> SeqT m a)
-> (a -> m (Maybe (a, SeqT m a))) -> a -> SeqT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe (a, SeqT m a))
forall (mp :: * -> *) (m :: * -> *) a b.
(MonadPlus mp, Monad m) =>
a -> m (Maybe (a, mp b))
single
  <*> :: SeqT m (a -> b) -> SeqT m a -> SeqT m b
(<*>) = ((a -> b) -> a -> b) -> SeqT m (a -> b) -> SeqT m a -> SeqT m b
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (a -> b) -> a -> b
forall a. a -> a
id

instance Monad m => Alternative (SeqT m) where
  empty :: SeqT m a
empty = Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
forall (m :: * -> *) a. Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
SeqT (FastTCQueue (AsUnitLoop (m (Maybe (a, SeqT m a)))) () ()
-> Queue (m (Maybe (a, SeqT m a)))
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq FastTCQueue (AsUnitLoop (m (Maybe (a, SeqT m a)))) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x.
TASequence s =>
s c x x
tempty)
  (SeqT m a -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView -> m (Maybe (a, SeqT m a))
m) <|> :: SeqT m a -> SeqT m a -> SeqT m a
<|> SeqT m a
n = m (Maybe (a, SeqT m a)) -> SeqT m a
forall (m :: * -> *) a. m (Maybe (a, SeqT m a)) -> SeqT m a
fromView (m (Maybe (a, SeqT m a))
m m (Maybe (a, SeqT m a))
-> (Maybe (a, SeqT m a) -> m (Maybe (a, SeqT m a)))
-> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (a, SeqT m a)
Nothing -> SeqT m a -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView SeqT m a
n
      Just (a
h,SeqT m a
t) -> Maybe (a, SeqT m a) -> m (Maybe (a, SeqT m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, SeqT m a) -> Maybe (a, SeqT m a)
forall a. a -> Maybe a
Just (a
h, SeqT m a -> SeqT m a -> SeqT m a
forall (m :: * -> *) a. SeqT m a -> SeqT m a -> SeqT m a
cat SeqT m a
t SeqT m a
n)))
    where cat :: SeqT m a -> SeqT m a -> SeqT m a
cat (SeqT Queue (m (Maybe (a, SeqT m a)))
l) (SeqT Queue (m (Maybe (a, SeqT m a)))
r) = Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
forall (m :: * -> *) a. Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
SeqT (Queue (m (Maybe (a, SeqT m a)))
l Queue (m (Maybe (a, SeqT m a)))
-> Queue (m (Maybe (a, SeqT m a)))
-> Queue (m (Maybe (a, SeqT m a)))
forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
S.>< Queue (m (Maybe (a, SeqT m a)))
r)

instance Monad m => Monad (SeqT m) where
  return :: a -> SeqT m a
return = m (Maybe (a, SeqT m a)) -> SeqT m a
forall (m :: * -> *) a. m (Maybe (a, SeqT m a)) -> SeqT m a
fromView (m (Maybe (a, SeqT m a)) -> SeqT m a)
-> (a -> m (Maybe (a, SeqT m a))) -> a -> SeqT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe (a, SeqT m a))
forall (mp :: * -> *) (m :: * -> *) a b.
(MonadPlus mp, Monad m) =>
a -> m (Maybe (a, mp b))
single
  (SeqT m a -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView -> m (Maybe (a, SeqT m a))
m) >>= :: SeqT m a -> (a -> SeqT m b) -> SeqT m b
>>= a -> SeqT m b
f = m (Maybe (b, SeqT m b)) -> SeqT m b
forall (m :: * -> *) a. m (Maybe (a, SeqT m a)) -> SeqT m a
fromView (m (Maybe (a, SeqT m a))
m m (Maybe (a, SeqT m a))
-> (Maybe (a, SeqT m a) -> m (Maybe (b, SeqT m b)))
-> m (Maybe (b, SeqT m b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (a, SeqT m a)
Nothing -> Maybe (b, SeqT m b) -> m (Maybe (b, SeqT m b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (b, SeqT m b)
forall a. Maybe a
Nothing
    Just (a
h,SeqT m a
t) -> SeqT m b -> m (Maybe (b, SeqT m b))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView (a -> SeqT m b
f a
h SeqT m b -> SeqT m b -> SeqT m b
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (SeqT m a
t SeqT m a -> (a -> SeqT m b) -> SeqT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> SeqT m b
f)))
#if !MIN_VERSION_base(4,13,0)
  fail = Fail.fail
#endif

instance Monad m => Fail.MonadFail (SeqT m) where
  fail :: String -> SeqT m a
fail String
_ = Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
forall (m :: * -> *) a. Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
SeqT Queue (m (Maybe (a, SeqT m a)))
forall (s :: * -> *) c. Sequence s => s c
S.empty

instance Monad m => MonadPlus (SeqT m) where
  mzero :: SeqT m a
mzero = SeqT m a
forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty
  mplus :: SeqT m a -> SeqT m a -> SeqT m a
mplus = SeqT m a -> SeqT m a -> SeqT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

#if MIN_VERSION_base(4,9,0)
instance Monad m => Semigroup (SeqT m a) where
  <> :: SeqT m a -> SeqT m a -> SeqT m a
(<>) = SeqT m a -> SeqT m a -> SeqT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  sconcat :: NonEmpty (SeqT m a) -> SeqT m a
sconcat = (SeqT m a -> SeqT m a -> SeqT m a)
-> NonEmpty (SeqT m a) -> SeqT m a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SeqT m a -> SeqT m a -> SeqT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
#endif

instance Monad m => Monoid (SeqT m a) where
  mempty :: SeqT m a
mempty = Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
forall (m :: * -> *) a. Queue (m (Maybe (a, SeqT m a))) -> SeqT m a
SeqT (FastTCQueue (AsUnitLoop (m (Maybe (a, SeqT m a)))) () ()
-> Queue (m (Maybe (a, SeqT m a)))
forall (s :: (* -> * -> *) -> * -> * -> *) a.
s (AsUnitLoop a) () () -> MSeq s a
MSeq FastTCQueue (AsUnitLoop (m (Maybe (a, SeqT m a)))) () ()
forall (s :: (* -> * -> *) -> * -> * -> *) (c :: * -> * -> *) x.
TASequence s =>
s c x x
tempty)
  mappend :: SeqT m a -> SeqT m a -> SeqT m a
mappend = SeqT m a -> SeqT m a -> SeqT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  mconcat :: [SeqT m a] -> SeqT m a
mconcat = [SeqT m a] -> SeqT m a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum

instance MonadTrans SeqT where
  lift :: m a -> SeqT m a
lift m a
m = m (Maybe (a, SeqT m a)) -> SeqT m a
forall (m :: * -> *) a. m (Maybe (a, SeqT m a)) -> SeqT m a
fromView (m a
m m a -> (a -> m (Maybe (a, SeqT m a))) -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m (Maybe (a, SeqT m a))
forall (mp :: * -> *) (m :: * -> *) a b.
(MonadPlus mp, Monad m) =>
a -> m (Maybe (a, mp b))
single)

instance Monad m => MonadLogic (SeqT m) where
  msplit :: SeqT m a -> SeqT m (Maybe (a, SeqT m a))
msplit (SeqT m a -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView -> m (Maybe (a, SeqT m a))
m) = m (Maybe (a, SeqT m a)) -> SeqT m (Maybe (a, SeqT m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe (a, SeqT m a))
m

observeAllT :: Monad m => SeqT m a -> m [a]
observeAllT :: SeqT m a -> m [a]
observeAllT (SeqT m a -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView -> m (Maybe (a, SeqT m a))
m) = m (Maybe (a, SeqT m a))
m m (Maybe (a, SeqT m a)) -> (Maybe (a, SeqT m a) -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (a, SeqT m a) -> m [a]
forall (m :: * -> *) a. Monad m => Maybe (a, SeqT m a) -> m [a]
go where
  go :: Maybe (a, SeqT m a) -> m [a]
go (Just (a
a,SeqT m a
t)) = ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (SeqT m a -> m [a]
forall (m :: * -> *) a. Monad m => SeqT m a -> m [a]
observeAllT SeqT m a
t)
  go Maybe (a, SeqT m a)
_ = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

#if !MIN_VERSION_base(4,13,0)
observeT :: Monad m => SeqT m a -> m a
#else
observeT :: MonadFail m => SeqT m a -> m a
#endif
observeT :: SeqT m a -> m a
observeT (SeqT m a -> m (Maybe (a, SeqT m a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView -> m (Maybe (a, SeqT m a))
m) = m (Maybe (a, SeqT m a))
m m (Maybe (a, SeqT m a)) -> (Maybe (a, SeqT m a) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (a, SeqT m a) -> m a
forall (f :: * -> *) a b. MonadFail f => Maybe (a, b) -> f a
go where
  go :: Maybe (a, b) -> f a
go (Just (a
a, b
_)) = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  go Maybe (a, b)
_ = String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No results."

observe :: Seq a -> a
observe :: Seq a -> a
observe (Seq a -> Identity (Maybe (a, Seq a))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView -> Identity (Maybe (a, Seq a))
m) = case Identity (Maybe (a, Seq a)) -> Maybe (a, Seq a)
forall a. Identity a -> a
runIdentity Identity (Maybe (a, Seq a))
m of
  Just (a
a, Seq a
_) -> a
a
  Maybe (a, Seq a)
_ -> String -> a
forall a. HasCallStack => String -> a
error String
"No results."

observeMaybeT :: Monad m => SeqT m (Maybe a) -> m (Maybe a)
observeMaybeT :: SeqT m (Maybe a) -> m (Maybe a)
observeMaybeT (SeqT m (Maybe a) -> m (Maybe (Maybe a, SeqT m (Maybe a)))
forall (m :: * -> *) a.
Monad m =>
SeqT m a -> m (Maybe (a, SeqT m a))
toView -> m (Maybe (Maybe a, SeqT m (Maybe a)))
m) = m (Maybe (Maybe a, SeqT m (Maybe a)))
m m (Maybe (Maybe a, SeqT m (Maybe a)))
-> (Maybe (Maybe a, SeqT m (Maybe a)) -> m (Maybe a))
-> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Maybe a, SeqT m (Maybe a)) -> m (Maybe a)
forall (f :: * -> *) a b.
Applicative f =>
Maybe (Maybe a, b) -> f (Maybe a)
go where
  go :: Maybe (Maybe a, b) -> f (Maybe a)
go (Just (Just a
a, b
_)) = Maybe a -> f (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
  go Maybe (Maybe a, b)
_ = Maybe a -> f (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

observeMaybe :: Seq (Maybe a) -> Maybe a
observeMaybe :: Seq (Maybe a) -> Maybe a
observeMaybe = Identity (Maybe a) -> Maybe a
forall a. Identity a -> a
runIdentity (Identity (Maybe a) -> Maybe a)
-> (Seq (Maybe a) -> Identity (Maybe a))
-> Seq (Maybe a)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Maybe a) -> Identity (Maybe a)
forall (m :: * -> *) a. Monad m => SeqT m (Maybe a) -> m (Maybe a)
observeMaybeT

observeAll :: Seq a -> [a]
observeAll :: Seq a -> [a]
observeAll = Identity [a] -> [a]
forall a. Identity a -> a
runIdentity (Identity [a] -> [a]) -> (Seq a -> Identity [a]) -> Seq a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Identity [a]
forall (m :: * -> *) a. Monad m => SeqT m a -> m [a]
observeAllT

instance MonadIO m => MonadIO (SeqT m) where
  liftIO :: IO a -> SeqT m a
liftIO = m a -> SeqT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> SeqT m a) -> (IO a -> m a) -> IO a -> SeqT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO