{-# LANGUAGE CPP #-}
#include "logict-sequence.h"
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
#endif
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
#ifdef USE_PATTERN_SYNONYMS
{-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_HADDOCK not-home #-}
#if __GLASGOW_HASKELL__ >= 902
{-# OPTIONS_GHC -fno-dicts-strict #-}
#endif
module Control.Monad.Logic.Sequence.Internal
(
#ifdef USE_PATTERN_SYNONYMS
SeqT(MkSeqT, getSeqT, ..)
#else
SeqT(..)
#endif
, Seq
#ifdef USE_PATTERN_SYNONYMS
, pattern MkSeq
, getSeq
#endif
, ViewT(..)
, View
, viewT
, view
, toViewT
, toView
, fromViewT
, fromView
, observeAllT
, observeAll
, observeManyT
, observeMany
, observeT
, observe
, fromSeqT
, hoistPre
, hoistPost
, hoistPreUnexposed
, hoistPostUnexposed
, toLogicT
, fromLogicT
, cons
, consM
, choose
, chooseM
)
where
import Control.Applicative
import Control.Monad hiding (liftM)
#if !MIN_VERSION_base(4,8,0)
import qualified Control.Monad as Monad
#endif
import qualified Control.Monad.Fail as Fail
import Control.Monad.Identity (Identity(..))
import Control.Monad.Trans (MonadTrans(..))
import Control.Monad.Logic.Class
import qualified Control.Monad.Logic as L
import Control.Monad.IO.Class
import Control.Monad.Reader.Class (MonadReader (..))
import Control.Monad.State.Class (MonadState (..))
import Control.Monad.Error.Class (MonadError (..))
import Control.Monad.Morph (MFunctor (..))
import qualified Data.SequenceClass as S
import Control.Monad.Logic.Sequence.Internal.Queue (Queue)
#if MIN_VERSION_base(4,8,0)
import Control.Monad.Zip (MonadZip (..))
#endif
import qualified Text.Read as TR
import Data.Function (on)
#if MIN_VERSION_base(4,9,0)
import Data.Functor.Classes
#endif
#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
import GHC.Generics (Generic)
import Data.Coerce (coerce)
data ViewT m a = Empty | a :< SeqT m a
deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) a x. Rep (ViewT m a) x -> ViewT m a
forall (m :: * -> *) a x. ViewT m a -> Rep (ViewT m a) x
$cto :: forall (m :: * -> *) a x. Rep (ViewT m a) x -> ViewT m a
$cfrom :: forall (m :: * -> *) a x. ViewT m a -> Rep (ViewT m a) x
Generic
infixl 5 :<
type View = ViewT Identity
viewT :: b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT :: forall b a (m :: * -> *).
b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT b
n a -> SeqT m a -> b
_ ViewT m a
Empty = b
n
viewT b
_ a -> SeqT m a -> b
c (a
a :< SeqT m a
s) = a -> SeqT m a -> b
c a
a SeqT m a
s
{-# INLINE viewT #-}
view :: b -> (a -> Seq a -> b) -> View a -> b
view :: forall b a. b -> (a -> Seq a -> b) -> View a -> b
view = forall b a (m :: * -> *).
b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT
{-# INLINE view #-}
deriving instance (Show a, Show (SeqT m a)) => Show (ViewT m a)
deriving instance (Read a, Read (SeqT m a)) => Read (ViewT m a)
deriving instance (Eq a, Eq (SeqT m a)) => Eq (ViewT m a)
deriving instance (Ord a, Ord (SeqT m a)) => Ord (ViewT m a)
deriving instance Monad m => Functor (ViewT m)
deriving instance (Monad m, F.Foldable m) => F.Foldable (ViewT m)
instance (Monad m, T.Traversable m) => T.Traversable (ViewT m) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ViewT m a -> f (ViewT m b)
traverse a -> f b
_ ViewT m a
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a. ViewT m a
Empty
traverse a -> f b
f (a
x :< SeqT m a
xs) =
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\b
y m (ViewT m b)
ys -> b
y forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT m (ViewT m b)
ys) (a -> f b
f a
x) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT forall a b. (a -> b) -> a -> b
$ SeqT m a
xs)
#if MIN_VERSION_base(4,9,0)
instance (Eq1 m, Monad m) => Eq1 (ViewT m) where
liftEq :: forall a b. (a -> b -> Bool) -> ViewT m a -> ViewT m b -> Bool
liftEq a -> b -> Bool
_ ViewT m a
Empty ViewT m b
Empty = Bool
True
liftEq a -> b -> Bool
eq (a
a :< SeqT m a
s) (b
b :< SeqT m b
t) = a -> b -> Bool
eq a
a b
b Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq SeqT m a
s SeqT m b
t
liftEq a -> b -> Bool
_ ViewT m a
_ ViewT m b
_ = Bool
False
instance (Ord1 m, Monad m) => Ord1 (ViewT m) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> ViewT m a -> ViewT m b -> Ordering
liftCompare a -> b -> Ordering
_ ViewT m a
Empty ViewT m b
Empty = Ordering
EQ
liftCompare a -> b -> Ordering
_ ViewT m a
Empty (b
_ :< SeqT m b
_) = Ordering
LT
liftCompare a -> b -> Ordering
cmp (a
a :< SeqT m a
s) (b
b :< SeqT m b
t) = a -> b -> Ordering
cmp a
a b
b forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp SeqT m a
s SeqT m b
t
liftCompare a -> b -> Ordering
_ (a
_ :< SeqT m a
_) ViewT m b
Empty = Ordering
GT
instance (Show1 m, Monad m) => Show1 (ViewT m) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> ViewT m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d ViewT m a
val = case ViewT m a
val of
ViewT m a
Empty -> (String
"Empty" forall a. [a] -> [a] -> [a]
++)
a
a :< SeqT m a
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
5) forall a b. (a -> b) -> a -> b
$
Int -> a -> ShowS
sp Int
6 a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
" :< " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
6 SeqT m a
s
#endif
newtype SeqT m a = SeqT (Queue (m (ViewT m a)))
#ifdef USE_PATTERN_SYNONYMS
pattern MkSeqT :: Monad m => m (ViewT m a) -> SeqT m a
pattern $bMkSeqT :: forall (m :: * -> *) a. Monad m => m (ViewT m a) -> SeqT m a
$mMkSeqT :: forall {r} {m :: * -> *} {a}.
Monad m =>
SeqT m a -> (m (ViewT m a) -> r) -> ((# #) -> r) -> r
MkSeqT{forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
getSeqT} <- (toViewT -> getSeqT)
where
MkSeqT = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT
{-# COMPLETE MkSeqT #-}
pattern MkSeq :: View a -> Seq a
pattern $bMkSeq :: forall a. View a -> Seq a
$mMkSeq :: forall {r} {a}. Seq a -> (View a -> r) -> ((# #) -> r) -> r
MkSeq{forall a. Seq a -> View a
getSeq} = MkSeqT (Identity getSeq)
{-# COMPLETE MkSeq #-}
#endif
type Seq = SeqT Identity
fromViewT :: m (ViewT m a) -> SeqT m a
fromViewT :: forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) c. Sequence s => c -> s c
S.singleton
{-# INLINABLE [1] fromViewT #-}
fromView :: forall a. View a -> Seq a
fromView :: forall a. View a -> Seq a
fromView = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT :: Identity (View a) -> Seq a)
{-# INLINE fromView #-}
toViewT :: Monad m => SeqT m a -> m (ViewT m a)
toViewT :: forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT (SeqT Queue (m (ViewT m a))
s) = case forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
S.viewl Queue (m (ViewT m a))
s of
ViewL Queue (m (ViewT m a))
S.EmptyL -> forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. ViewT m a
Empty
m (ViewT m a)
h S.:< Queue (m (ViewT m a))
t -> m (ViewT m a)
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewT m a
x -> case ViewT m a
x of
ViewT m a
Empty -> forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT (forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT Queue (m (ViewT m a))
t)
a
hi :< SeqT Queue (m (ViewT m a))
ti -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
hi forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT (Queue (m (ViewT m a))
ti forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
S.>< Queue (m (ViewT m a))
t))
{-# INLINEABLE [1] toViewT #-}
toView :: forall a. Seq a -> View a
toView :: forall a. Seq a -> View a
toView = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT :: SeqT Identity a -> Identity (ViewT Identity a))
{-# INLINABLE toView #-}
{-# RULES
"toViewT . fromViewT" forall m. toViewT (fromViewT m) = m >>= return
#-}
instance (Show (m (ViewT m a)), Monad m) => Show (SeqT m a) where
showsPrec :: Int -> SeqT m a -> ShowS
showsPrec Int
d SeqT m a
s = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
app_prec) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"MkSeqT " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_prec forall a. Num a => a -> a -> a
+ Int
1) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
s)
where app_prec :: Int
app_prec = Int
10
instance Read (m (ViewT m a)) => Read (SeqT m a) where
readPrec :: ReadPrec (SeqT m a)
readPrec = forall a. ReadPrec a -> ReadPrec a
TR.parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
TR.prec Int
app_prec forall a b. (a -> b) -> a -> b
$ do
TR.Ident String
"MkSeqT" <- ReadPrec Lexeme
TR.lexP
m (ViewT m a)
m <- forall a. ReadPrec a -> ReadPrec a
TR.step forall a. Read a => ReadPrec a
TR.readPrec
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT m (ViewT m a)
m)
where app_prec :: Int
app_prec = Int
10
readListPrec :: ReadPrec [SeqT m a]
readListPrec = forall a. Read a => ReadPrec [a]
TR.readListPrecDefault
instance (Eq a, Eq (m (ViewT m a)), Monad m) => Eq (SeqT m a) where
== :: SeqT m a -> SeqT m a -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT
instance (Ord a, Ord (m (ViewT m a)), Monad m) => Ord (SeqT m a) where
compare :: SeqT m a -> SeqT m a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT
#if MIN_VERSION_base(4,9,0)
instance (Eq1 m, Monad m) => Eq1 (SeqT m) where
liftEq :: forall a b. (a -> b -> Bool) -> SeqT m a -> SeqT m b -> Bool
liftEq a -> b -> Bool
eq SeqT m a
s SeqT m b
t = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
s) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m b
t)
instance (Ord1 m, Monad m) => Ord1 (SeqT m) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> SeqT m a -> SeqT m b -> Ordering
liftCompare a -> b -> Ordering
eq SeqT m a
s SeqT m b
t = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
eq) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
s) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m b
t)
instance (Show1 m, Monad m) => Show1 (SeqT m) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SeqT m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d SeqT m a
s = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
app_prec) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"MkSeqT " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl) (Int
app_prec forall a. Num a => a -> a -> a
+ Int
1) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
s)
where app_prec :: Int
app_prec = Int
10
#endif
single :: Monad m => a -> m (ViewT m a)
single :: forall (m :: * -> *) a. Monad m => a -> m (ViewT m a)
single a
a = forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) a. MonadPlus m => m a
mzero)
{-# INLINE single #-}
instance Monad m => Functor (SeqT m) where
{-# INLINEABLE fmap #-}
fmap :: forall a b. (a -> b) -> SeqT m a -> SeqT m b
fmap a -> b
f (SeqT Queue (m (ViewT m a))
q) = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) Queue (m (ViewT m a))
q
{-# INLINABLE (<$) #-}
a
x <$ :: forall a b. a -> SeqT m b -> SeqT m a
<$ SeqT Queue (m (ViewT m b))
q = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM (a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)) Queue (m (ViewT m b))
q
instance Monad m => Applicative (SeqT m) where
{-# INLINE pure #-}
{-# INLINABLE (<*>) #-}
pure :: forall a. a -> SeqT m a
pure = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m (ViewT m a)
single
#if MIN_VERSION_base(4,8,0)
SeqT m (a -> b)
fs <*> :: forall a b. SeqT m (a -> b) -> SeqT m a -> SeqT m b
<*> SeqT m a
xs = SeqT m (a -> b)
fs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> a -> b
f forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
<$> SeqT m a
xs
#else
(<*>) = ap
#endif
{-# INLINABLE (*>) #-}
(forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) *> :: forall a b. SeqT m a -> SeqT m b -> SeqT m b
*> SeqT m b
n = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
m (ViewT m a) -> SeqT m b -> m (ViewT m b)
thenViewT m (ViewT m a)
m SeqT m b
n
#if MIN_VERSION_base(4,10,0)
liftA2 :: forall a b c. (a -> b -> c) -> SeqT m a -> SeqT m b -> SeqT m c
liftA2 a -> b -> c
f SeqT m a
xs SeqT m b
ys = SeqT m a
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> a -> b -> c
f a
x forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
<$> SeqT m b
ys
{-# INLINABLE liftA2 #-}
#endif
thenViewT :: Monad m => m (ViewT m a) -> SeqT m b -> m (ViewT m b)
thenViewT :: forall (m :: * -> *) a b.
Monad m =>
m (ViewT m a) -> SeqT m b -> m (ViewT m b)
thenViewT m (ViewT m a)
m SeqT m b
n = m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewT m a
x -> case ViewT m a
x of
ViewT m a
Empty -> forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. ViewT m a
Empty
a
_ :< SeqT m a
t -> forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m b
n forall (m :: * -> *) a.
Monad m =>
m (ViewT m a) -> SeqT m a -> m (ViewT m a)
`altViewT` (SeqT m a
t forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SeqT m b
n)
{-# INLINABLE thenViewT #-}
instance Monad m => Alternative (SeqT m) where
{-# INLINE empty #-}
{-# INLINEABLE (<|>) #-}
empty :: forall a. SeqT m a
empty = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall (s :: * -> *) c. Sequence s => s c
S.empty
SeqT Queue (m (ViewT m a))
m <|> :: forall a. SeqT m a -> SeqT m a -> SeqT m a
<|> SeqT Queue (m (ViewT m a))
n = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT (Queue (m (ViewT m a))
m forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
S.>< Queue (m (ViewT m a))
n)
altViewT :: Monad m => m (ViewT m a) -> SeqT m a -> m (ViewT m a)
altViewT :: forall (m :: * -> *) a.
Monad m =>
m (ViewT m a) -> SeqT m a -> m (ViewT m a)
altViewT m (ViewT m a)
m SeqT m a
n = m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewT m a
x -> case ViewT m a
x of
ViewT m a
Empty -> forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
n
a
h :< SeqT m a
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
h forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< (SeqT m a
t forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SeqT m a
n))
{-# INLINABLE altViewT #-}
cons :: Monad m => a -> SeqT m a -> SeqT m a
cons :: forall (m :: * -> *) a. Monad m => a -> SeqT m a -> SeqT m a
cons a
a SeqT m a
s = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT (forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< SeqT m a
s))
{-# INLINE cons #-}
consM :: Monad m => m a -> SeqT m a -> SeqT m a
consM :: forall (m :: * -> *) a. Monad m => m a -> SeqT m a -> SeqT m a
consM m a
m SeqT m a
s = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT (forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM (forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< SeqT m a
s) m a
m)
{-# INLINE consM #-}
instance Monad m => Monad (SeqT m) where
{-# INLINE return #-}
{-# INLINABLE (>>=) #-}
return :: forall a. a -> SeqT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
(forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) >>= :: forall a b. SeqT m a -> (a -> SeqT m b) -> SeqT m b
>>= a -> SeqT m b
f = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
m (ViewT m a) -> (a -> SeqT m b) -> m (ViewT m b)
bindViewT m (ViewT m a)
m a -> SeqT m b
f
>> :: forall a b. SeqT m a -> SeqT m b -> SeqT m b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
#if !MIN_VERSION_base(4,13,0)
{-# INLINEABLE fail #-}
fail = Fail.fail
#endif
bindViewT :: Monad m => m (ViewT m a) -> (a -> SeqT m b) -> m (ViewT m b)
bindViewT :: forall (m :: * -> *) a b.
Monad m =>
m (ViewT m a) -> (a -> SeqT m b) -> m (ViewT m b)
bindViewT m (ViewT m a)
m a -> SeqT m b
f = m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewT m a
x -> case ViewT m a
x of
ViewT m a
Empty -> forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. ViewT m a
Empty
a
h :< SeqT m a
t -> forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT (a -> SeqT m b
f a
h) forall (m :: * -> *) a.
Monad m =>
m (ViewT m a) -> SeqT m a -> m (ViewT m a)
`altViewT` (SeqT m a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> SeqT m b
f)
{-# INLINABLE bindViewT #-}
instance Monad m => Fail.MonadFail (SeqT m) where
{-# INLINEABLE fail #-}
fail :: forall a. String -> SeqT m a
fail String
_ = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall (s :: * -> *) c. Sequence s => s c
S.empty
instance Monad m => MonadPlus (SeqT m) where
{-# INLINE mzero #-}
{-# INLINE mplus #-}
mzero :: forall a. SeqT m a
mzero = forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty
mplus :: forall a. SeqT m a -> SeqT m a -> SeqT m a
mplus = 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
{-# INLINE (<>) #-}
{-# INLINE sconcat #-}
<> :: 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 = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum
#endif
instance Monad m => Monoid (SeqT m a) where
{-# INLINE mempty #-}
{-# INLINE mconcat #-}
mempty :: SeqT m a
mempty = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall (s :: * -> *) c. Sequence s => s c
S.empty
mconcat :: [SeqT m a] -> SeqT m a
mconcat = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum
#if !MIN_VERSION_base(4,11,0)
{-# INLINE mappend #-}
mappend = (<|>)
#endif
instance MonadTrans SeqT where
{-# INLINE lift #-}
lift :: forall (m :: * -> *) a. Monad m => m a -> SeqT m a
lift m a
m = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT (m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m (ViewT m a)
single)
instance Monad m => MonadLogic (SeqT m) where
{-# INLINE msplit #-}
msplit :: forall a. SeqT m a -> SeqT m (Maybe (a, SeqT m a))
msplit (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ do
ViewT m a
r <- m (ViewT m a)
m
case ViewT m a
r of
ViewT m a
Empty -> forall (m :: * -> *) a. Monad m => a -> m (ViewT m a)
single forall a. Maybe a
Nothing
a
a :< SeqT m a
t -> forall (m :: * -> *) a. Monad m => a -> m (ViewT m a)
single (forall a. a -> Maybe a
Just (a
a, SeqT m a
t))
interleave :: forall a. SeqT m a -> SeqT m a -> SeqT m a
interleave SeqT m a
m1 SeqT m a
m2 = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
SeqT m a -> SeqT m a -> m (ViewT m a)
interleaveViewT SeqT m a
m1 SeqT m a
m2
(forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) >>- :: forall a b. SeqT m a -> (a -> SeqT m b) -> SeqT m b
>>- a -> SeqT m b
f = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a (m :: * -> *).
b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT
(forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. ViewT m a
Empty) (\a
a SeqT m a
m' -> forall (m :: * -> *) a.
Monad m =>
SeqT m a -> SeqT m a -> m (ViewT m a)
interleaveViewT (a -> SeqT m b
f a
a) (SeqT m a
m' forall (m :: * -> *) a b. MonadLogic m => m a -> (a -> m b) -> m b
>>- a -> SeqT m b
f))
ifte :: forall a b. SeqT m a -> (a -> SeqT m b) -> SeqT m b -> SeqT m b
ifte (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
t) a -> SeqT m b
th (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m b)
el) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ m (ViewT m a)
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a (m :: * -> *).
b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT
m (ViewT m b)
el
(\a
a SeqT m a
s -> forall (m :: * -> *) a.
Monad m =>
m (ViewT m a) -> SeqT m a -> m (ViewT m a)
altViewT (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT (a -> SeqT m b
th a
a)) (SeqT m a
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> SeqT m b
th))
once :: forall a. SeqT m a -> SeqT m a
once (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a (m :: * -> *).
b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT
(forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. ViewT m a
Empty)
(\a
a SeqT m a
_ -> forall (m :: * -> *) a. Monad m => a -> m (ViewT m a)
single a
a)
lnot :: forall a. SeqT m a -> SeqT m ()
lnot (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a (m :: * -> *).
b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT
(forall (m :: * -> *) a. Monad m => a -> m (ViewT m a)
single ()) (\ a
_ SeqT m a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. ViewT m a
Empty)
interleaveViewT :: Monad m => SeqT m a -> SeqT m a -> m (ViewT m a)
interleaveViewT :: forall (m :: * -> *) a.
Monad m =>
SeqT m a -> SeqT m a -> m (ViewT m a)
interleaveViewT (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m1) SeqT m a
m2 = m (ViewT m a)
m1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a (m :: * -> *).
b -> (a -> SeqT m a -> b) -> ViewT m a -> b
viewT
(forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
m2)
(\a
a SeqT m a
m1' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) a. MonadLogic m => m a -> m a -> m a
interleave SeqT m a
m2 SeqT m a
m1')
choose :: (F.Foldable t, Monad m) => t a -> SeqT m a
choose :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> SeqT m a
choose = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall (m :: * -> *) a. Monad m => a -> SeqT m a -> SeqT m a
cons forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINABLE choose #-}
chooseM :: (F.Foldable t, Monad m) => t (m a) -> SeqT m a
chooseM :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> SeqT m a
chooseM = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall (m :: * -> *) a. Monad m => m a -> SeqT m a -> SeqT m a
consM forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINABLE chooseM #-}
observeAllT :: Monad m => SeqT m a -> m [a]
observeAllT :: forall (m :: * -> *) a. Monad m => SeqT m a -> m [a]
observeAllT (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}. Monad m => ViewT m a -> m [a]
go where
go :: ViewT m a -> m [a]
go (a
a :< SeqT m a
t) = forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM (a
aforall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ViewT m a -> m [a]
go)
go ViewT m a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
{-# INLINEABLE observeAllT #-}
observeT :: Monad m => SeqT m a -> m (Maybe a)
observeT :: forall (m :: * -> *) a. Monad m => SeqT m a -> m (Maybe a)
observeT (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
ViewT m a -> m (Maybe a)
go where
go :: ViewT m a -> m (Maybe a)
go (a
a :< SeqT m a
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
go ViewT m a
Empty = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
{-# INLINE observeT #-}
observeManyT :: Monad m => Int -> SeqT m a -> m [a]
observeManyT :: forall (m :: * -> *) a. Monad m => Int -> SeqT m a -> m [a]
observeManyT Int
k SeqT m a
m = forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT SeqT m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}. Monad m => Int -> ViewT m a -> m [a]
go Int
k where
go :: Int -> ViewT m a -> m [a]
go Int
n ViewT m a
_ | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
go Int
_ ViewT m a
Empty = forall (m :: * -> *) a. Monad m => a -> m a
return []
go Int
n (a
a :< SeqT m a
t) = forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM (a
aforall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => Int -> SeqT m a -> m [a]
observeManyT (Int
nforall a. Num a => a -> a -> a
-Int
1) SeqT m a
t)
{-# INLINEABLE observeManyT #-}
observe :: Seq a -> Maybe a
observe :: forall a. Seq a -> Maybe a
observe = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => SeqT m a -> m (Maybe a)
observeT
{-# INLINE observe #-}
observeAll :: Seq a -> [a]
observeAll :: forall a. Seq a -> [a]
observeAll = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => SeqT m a -> m [a]
observeAllT
{-# INLINE observeAll #-}
observeMany :: Int -> Seq a -> [a]
observeMany :: forall a. Int -> Seq a -> [a]
observeMany Int
n = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Int -> SeqT m a -> m [a]
observeManyT Int
n
{-# INLINE observeMany #-}
fromSeqT :: (Monad m, Monad (t m), MonadTrans t, Alternative (t m)) => SeqT m a -> t m a
fromSeqT :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, Monad (t m), MonadTrans t, Alternative (t m)) =>
SeqT m a -> t m a
fromSeqT (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (ViewT m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ViewT m a
r -> case ViewT m a
r of
ViewT m a
Empty -> forall (f :: * -> *) a. Alternative f => f a
empty
a
a :< SeqT m a
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, Monad (t m), MonadTrans t, Alternative (t m)) =>
SeqT m a -> t m a
fromSeqT SeqT m a
s
toLogicT :: Monad m => SeqT m a -> L.LogicT m a
toLogicT :: forall (m :: * -> *) a. Monad m => SeqT m a -> LogicT m a
toLogicT = forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, Monad (t m), MonadTrans t, Alternative (t m)) =>
SeqT m a -> t m a
fromSeqT
fromLogicT :: Monad m => L.LogicT m a -> SeqT m a
fromLogicT :: forall (m :: * -> *) a. Monad m => LogicT m a -> SeqT m a
fromLogicT (L.LogicT forall r. (a -> m r -> m r) -> m r -> m r
f) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ forall r. (a -> m r -> m r) -> m r -> m r
f (\a
a m (ViewT m a)
v -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT m (ViewT m a)
v)) (forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. ViewT m a
Empty)
instance (Monad m, F.Foldable m) => F.Foldable (SeqT m) where
foldMap :: forall m a. Monoid m => (a -> m) -> SeqT m a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT
instance (Monad m, T.Traversable m) => T.Traversable (SeqT m) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SeqT m a -> f (SeqT m b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT
instance MFunctor SeqT where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> SeqT m b -> SeqT n b
hoist forall a. m a -> n a
f = forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> SeqT m b -> SeqT n b
hoistPre forall a. m a -> n a
f
hoistPre :: Monad m => (forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPre :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> SeqT m b -> SeqT n b
hoistPre forall x. m x -> n x
f (SeqT Queue (m (ViewT m a))
s) = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. m x -> n x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM ViewT m a -> ViewT n a
go) Queue (m (ViewT m a))
s
where
go :: ViewT m a -> ViewT n a
go ViewT m a
Empty = forall (m :: * -> *) a. ViewT m a
Empty
go (a
a :< SeqT m a
as) = a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> SeqT m b -> SeqT n b
hoistPre forall x. m x -> n x
f SeqT m a
as
hoistPost :: Monad n => (forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPost :: forall (n :: * -> *) (m :: * -> *) a.
Monad n =>
(forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPost forall x. m x -> n x
f (SeqT Queue (m (ViewT m a))
s) = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM ViewT m a -> ViewT n a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. m x -> n x
f) Queue (m (ViewT m a))
s
where
go :: ViewT m a -> ViewT n a
go ViewT m a
Empty = forall (m :: * -> *) a. ViewT m a
Empty
go (a
a :< SeqT m a
as) = a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (n :: * -> *) (m :: * -> *) a.
Monad n =>
(forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPost forall x. m x -> n x
f SeqT m a
as
hoistPreUnexposed :: forall m n a. Monad m => (forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPreUnexposed :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> SeqT m b -> SeqT n b
hoistPreUnexposed forall x. m x -> n x
f (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ forall x. m x -> n x
f (forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM ViewT m a -> ViewT n a
go m (ViewT m a)
m)
where
go :: ViewT m a -> ViewT n a
go ViewT m a
Empty = forall (m :: * -> *) a. ViewT m a
Empty
go (a
a :< SeqT m a
as) = a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> SeqT m b -> SeqT n b
hoistPreUnexposed forall x. m x -> n x
f SeqT m a
as
hoistPostUnexposed :: forall m n a. (Monad m, Monad n) => (forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPostUnexposed :: forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPostUnexposed forall x. m x -> n x
f (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM ViewT m a -> ViewT n a
go (forall x. m x -> n x
f m (ViewT m a)
m)
where
go :: ViewT m a -> ViewT n a
go ViewT m a
Empty = forall (m :: * -> *) a. ViewT m a
Empty
go (a
a :< SeqT m a
as) = a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> SeqT m a -> SeqT n a
hoistPostUnexposed forall x. m x -> n x
f SeqT m a
as
instance MonadIO m => MonadIO (SeqT m) where
{-# INLINE liftIO #-}
liftIO :: forall a. IO a -> SeqT m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadReader e m => MonadReader e (SeqT m) where
ask :: SeqT m e
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (e -> e) -> SeqT m a -> SeqT m a
local e -> e
f (SeqT Queue (m (ViewT m a))
q) = forall (m :: * -> *) a. Queue (m (ViewT m a)) -> SeqT m a
SeqT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e -> e
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM ViewT m a -> ViewT m a
go) Queue (m (ViewT m a))
q
where
go :: ViewT m a -> ViewT m a
go ViewT m a
Empty = forall (m :: * -> *) a. ViewT m a
Empty
go (a
a :< SeqT m a
s) = a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e -> e
f SeqT m a
s
instance MonadState s m => MonadState s (SeqT m) where
get :: SeqT m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> SeqT m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
state :: forall a. (s -> (a, s)) -> SeqT m a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
instance MonadError e m => MonadError e (SeqT m) where
throwError :: forall a. e -> SeqT m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: forall a. SeqT m a -> (e -> SeqT m a) -> SeqT m a
catchError (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) e -> SeqT m a
h = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM ViewT m a -> ViewT m a
go m (ViewT m a)
m) forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SeqT m a
h)
where
go :: ViewT m a -> ViewT m a
go ViewT m a
Empty = forall (m :: * -> *) a. ViewT m a
Empty
go (a
a :< SeqT m a
s) = a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError SeqT m a
s e -> SeqT m a
h
#if MIN_VERSION_base(4,8,0)
instance MonadZip m => MonadZip (SeqT m) where
mzipWith :: forall a b c. (a -> b -> c) -> SeqT m a -> SeqT m b -> SeqT m c
mzipWith a -> b -> c
f (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m a)
m) (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m b)
n) = forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith ViewT m a -> ViewT m b -> ViewT m c
go m (ViewT m a)
m m (ViewT m b)
n
where
go :: ViewT m a -> ViewT m b -> ViewT m c
go (a
a :< SeqT m a
as) (b
b :< SeqT m b
bs) = a -> b -> c
f a
a b
b forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f SeqT m a
as SeqT m b
bs
go ViewT m a
_ ViewT m b
_ = forall (m :: * -> *) a. ViewT m a
Empty
munzip :: forall a b. SeqT m (a, b) -> (SeqT m a, SeqT m b)
munzip (forall (m :: * -> *) a. Monad m => SeqT m a -> m (ViewT m a)
toViewT -> m (ViewT m (a, b))
m)
| (m (ViewT m a)
l, m (ViewT m b)
r) <- forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {m :: * -> *} {a} {a}.
MonadZip m =>
ViewT m (a, a) -> (ViewT m a, ViewT m a)
go m (ViewT m (a, b))
m) = (forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT m (ViewT m a)
l, forall (m :: * -> *) a. m (ViewT m a) -> SeqT m a
fromViewT m (ViewT m b)
r)
where
go :: ViewT m (a, a) -> (ViewT m a, ViewT m a)
go ViewT m (a, a)
Empty = (forall (m :: * -> *) a. ViewT m a
Empty, forall (m :: * -> *) a. ViewT m a
Empty)
go ((a
a, a
b) :< SeqT m (a, a)
asbs) = (a
a forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< SeqT m a
as, a
b forall (m :: * -> *) a. a -> SeqT m a -> ViewT m a
:< SeqT m a
bs)
where
{-# NOINLINE muabs #-}
{-# NOINLINE as #-}
{-# NOINLINE bs #-}
muabs :: (SeqT m a, SeqT m a)
muabs = forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip SeqT m (a, a)
asbs
(SeqT m a
as, SeqT m a
bs) = (SeqT m a, SeqT m a)
muabs
#endif
#if MIN_VERSION_base(4,8,0)
myliftM :: Functor m => (a -> b) -> m a -> m b
myliftM :: forall (m :: * -> *) a b. Functor m => (a -> b) -> m a -> m b
myliftM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
#else
myliftM :: Monad m => (a -> b) -> m a -> m b
myliftM = Monad.liftM
#endif
{-# INLINE myliftM #-}