{-# LANGUAGE PatternGuards, BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}
module Data.Stream.Infinite.Skew
( Stream
, (<|)
, (!!)
, tail
, uncons
, drop
, dropWhile
, span
, break
, split
, splitW
, repeat
, insert
, insertBy
, adjust
, update
, from
, indexed
, interleave
) where
import Control.Arrow (first)
import Control.Applicative hiding (empty)
import Control.Comonad
import Data.Distributive
import Data.Functor.Alt
import Data.Functor.Extend
import Data.Functor.Rep
import Data.Foldable
import Data.Traversable
import Data.Semigroup hiding (Last)
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, (!!), break)
import Data.Boring (Boring (..), Absurd (..))
infixr 5 :<, <|
data Complete a
= Tip a
| Bin !Integer a !(Complete a) !(Complete a)
deriving Int -> Complete a -> ShowS
[Complete a] -> ShowS
Complete a -> String
(Int -> Complete a -> ShowS)
-> (Complete a -> String)
-> ([Complete a] -> ShowS)
-> Show (Complete a)
forall a. Show a => Int -> Complete a -> ShowS
forall a. Show a => [Complete a] -> ShowS
forall a. Show a => Complete a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Complete a -> ShowS
showsPrec :: Int -> Complete a -> ShowS
$cshow :: forall a. Show a => Complete a -> String
show :: Complete a -> String
$cshowList :: forall a. Show a => [Complete a] -> ShowS
showList :: [Complete a] -> ShowS
Show
instance Functor Complete where
fmap :: forall a b. (a -> b) -> Complete a -> Complete b
fmap a -> b
f (Tip a
a) = b -> Complete b
forall a. a -> Complete a
Tip (a -> b
f a
a)
fmap a -> b
f (Bin Integer
w a
a Complete a
l Complete a
r) = Integer -> b -> Complete b -> Complete b -> Complete b
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
w (a -> b
f a
a) ((a -> b) -> Complete a -> Complete b
forall a b. (a -> b) -> Complete a -> Complete b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Complete a
l) ((a -> b) -> Complete a -> Complete b
forall a b. (a -> b) -> Complete a -> Complete b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Complete a
r)
instance Extend Complete where
extended :: forall a b. (Complete a -> b) -> Complete a -> Complete b
extended Complete a -> b
f w :: Complete a
w@Tip {} = b -> Complete b
forall a. a -> Complete a
Tip (Complete a -> b
f Complete a
w)
extended Complete a -> b
f w :: Complete a
w@(Bin Integer
n a
_ Complete a
l Complete a
r) = Integer -> b -> Complete b -> Complete b -> Complete b
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
n (Complete a -> b
f Complete a
w) ((Complete a -> b) -> Complete a -> Complete b
forall a b. (Complete a -> b) -> Complete a -> Complete b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended Complete a -> b
f Complete a
l) ((Complete a -> b) -> Complete a -> Complete b
forall a b. (Complete a -> b) -> Complete a -> Complete b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended Complete a -> b
f Complete a
r)
instance Comonad Complete where
extend :: forall a b. (Complete a -> b) -> Complete a -> Complete b
extend Complete a -> b
f w :: Complete a
w@Tip {} = b -> Complete b
forall a. a -> Complete a
Tip (Complete a -> b
f Complete a
w)
extend Complete a -> b
f w :: Complete a
w@(Bin Integer
n a
_ Complete a
l Complete a
r) = Integer -> b -> Complete b -> Complete b -> Complete b
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
n (Complete a -> b
f Complete a
w) ((Complete a -> b) -> Complete a -> Complete b
forall a b. (Complete a -> b) -> Complete a -> Complete b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Complete a -> b
f Complete a
l) ((Complete a -> b) -> Complete a -> Complete b
forall a b. (Complete a -> b) -> Complete a -> Complete b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Complete a -> b
f Complete a
r)
extract :: forall a. Complete a -> a
extract (Tip a
a) = a
a
extract (Bin Integer
_ a
a Complete a
_ Complete a
_) = a
a
instance Foldable Complete where
foldMap :: forall m a. Monoid m => (a -> m) -> Complete a -> m
foldMap a -> m
f (Tip a
a) = a -> m
f a
a
foldMap a -> m
f (Bin Integer
_ a
a Complete a
l Complete a
r) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Complete a -> m
forall m a. Monoid m => (a -> m) -> Complete a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Complete a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Complete a -> m
forall m a. Monoid m => (a -> m) -> Complete a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Complete a
r
foldr :: forall a b. (a -> b -> b) -> b -> Complete a -> b
foldr a -> b -> b
f b
z (Tip a
a) = a -> b -> b
f a
a b
z
foldr a -> b -> b
f b
z (Bin Integer
_ a
a Complete a
l Complete a
r) = a -> b -> b
f a
a ((a -> b -> b) -> b -> Complete a -> b
forall a b. (a -> b -> b) -> b -> Complete a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f ((a -> b -> b) -> b -> Complete a -> b
forall a b. (a -> b -> b) -> b -> Complete a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Complete a
r) Complete a
l)
length :: forall a. Complete a -> Int
length Tip{} = Int
1
length (Bin Integer
n a
_ Complete a
_ Complete a
_) = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
null :: forall a. Complete a -> Bool
null Complete a
_ = Bool
False
instance Foldable1 Complete where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Complete a -> m
foldMap1 a -> m
f (Tip a
a) = a -> m
f a
a
foldMap1 a -> m
f (Bin Integer
_ a
a Complete a
l Complete a
r) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Complete a -> m
forall m a. Semigroup m => (a -> m) -> Complete a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f Complete a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Complete a -> m
forall m a. Semigroup m => (a -> m) -> Complete a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f Complete a
r
instance Traversable Complete where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse a -> f b
f (Tip a
a) = b -> Complete b
forall a. a -> Complete a
Tip (b -> Complete b) -> f b -> f (Complete b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
traverse a -> f b
f (Bin Integer
n a
a Complete a
l Complete a
r) = Integer -> b -> Complete b -> Complete b -> Complete b
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
n (b -> Complete b -> Complete b -> Complete b)
-> f b -> f (Complete b -> Complete b -> Complete b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (Complete b -> Complete b -> Complete b)
-> f (Complete b) -> f (Complete b -> Complete b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Complete a -> f (Complete b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse a -> f b
f Complete a
l f (Complete b -> Complete b) -> f (Complete b) -> f (Complete b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Complete a -> f (Complete b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse a -> f b
f Complete a
r
instance Traversable1 Complete where
traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse1 a -> f b
f (Tip a
a) = b -> Complete b
forall a. a -> Complete a
Tip (b -> Complete b) -> f b -> f (Complete b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
traverse1 a -> f b
f (Bin Integer
n a
a Complete a
l Complete a
r) = Integer -> b -> Complete b -> Complete b -> Complete b
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
n (b -> Complete b -> Complete b -> Complete b)
-> f b -> f (Complete b -> Complete b -> Complete b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (Complete b -> Complete b -> Complete b)
-> f (Complete b) -> f (Complete b -> Complete b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> f b) -> Complete a -> f (Complete b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse1 a -> f b
f Complete a
l f (Complete b -> Complete b) -> f (Complete b) -> f (Complete b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> f b) -> Complete a -> f (Complete b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse1 a -> f b
f Complete a
r
bin :: a -> Complete a -> Complete a -> Complete a
bin :: forall a. a -> Complete a -> Complete a -> Complete a
bin a
a Complete a
l Complete a
r = Integer -> a -> Complete a -> Complete a -> Complete a
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin (Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
r) a
a Complete a
l Complete a
r
{-# INLINE bin #-}
weight :: Complete a -> Integer
weight :: forall a. Complete a -> Integer
weight Tip{} = Integer
1
weight (Bin Integer
w a
_ Complete a
_ Complete a
_) = Integer
w
{-# INLINE weight #-}
data Stream a = !(Complete a) :< Stream a
instance Show a => Show (Stream a) where
showsPrec :: Int -> Stream a -> ShowS
showsPrec Int
d Stream a
as = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Stream a -> [a]
forall a. Stream a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Stream a
as)
instance Functor Stream where
fmap :: forall a b. (a -> b) -> Stream a -> Stream b
fmap a -> b
f (Complete a
t :< Stream a
ts) = (a -> b) -> Complete a -> Complete b
forall a b. (a -> b) -> Complete a -> Complete b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Complete a
t Complete b -> Stream b -> Stream b
forall a. Complete a -> Stream a -> Stream a
:< (a -> b) -> Stream a -> Stream b
forall a b. (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Stream a
ts
instance Extend Stream where
extended :: forall a b. (Stream a -> b) -> Stream a -> Stream b
extended = (Stream a -> b) -> Stream a -> Stream b
forall a b. (Stream a -> b) -> Stream a -> Stream b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend
instance Comonad Stream where
extend :: forall a b. (Stream a -> b) -> Stream a -> Stream b
extend Stream a -> b
g0 (Complete a
t :< Stream a
ts) = (Stream a -> b)
-> Complete a -> (Complete a -> Stream a) -> Complete b
forall a b.
(Stream a -> b)
-> Complete a -> (Complete a -> Stream a) -> Complete b
go Stream a -> b
g0 Complete a
t (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
ts) Complete b -> Stream b -> Stream b
forall a. Complete a -> Stream a -> Stream a
:< (Stream a -> b) -> Stream a -> Stream b
forall a b. (Stream a -> b) -> Stream a -> Stream b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Stream a -> b
g0 Stream a
ts
where
go :: (Stream a -> b) -> Complete a -> (Complete a -> Stream a) -> Complete b
go :: forall a b.
(Stream a -> b)
-> Complete a -> (Complete a -> Stream a) -> Complete b
go Stream a -> b
g w :: Complete a
w@Tip{} Complete a -> Stream a
f = b -> Complete b
forall a. a -> Complete a
Tip (Stream a -> b
g (Complete a -> Stream a
f Complete a
w))
go Stream a -> b
g w :: Complete a
w@(Bin Integer
n a
_ Complete a
l Complete a
r) Complete a -> Stream a
f = Integer -> b -> Complete b -> Complete b -> Complete b
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
n (Stream a -> b
g (Complete a -> Stream a
f Complete a
w)) ((Stream a -> b)
-> Complete a -> (Complete a -> Stream a) -> Complete b
forall a b.
(Stream a -> b)
-> Complete a -> (Complete a -> Stream a) -> Complete b
go Stream a -> b
g Complete a
l (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Complete a -> Stream a
f Complete a
r)) ((Stream a -> b)
-> Complete a -> (Complete a -> Stream a) -> Complete b
forall a b.
(Stream a -> b)
-> Complete a -> (Complete a -> Stream a) -> Complete b
go Stream a -> b
g Complete a
r Complete a -> Stream a
f)
extract :: forall a. Stream a -> a
extract (Complete a
a :< Stream a
_) = Complete a -> a
forall a. Complete a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Complete a
a
instance Apply Stream where
Stream (a -> b)
fs <.> :: forall a b. Stream (a -> b) -> Stream a -> Stream b
<.> Stream a
as = (Integer -> (a -> b) -> b) -> Stream (a -> b) -> Stream b
forall a b. (Integer -> a -> b) -> Stream a -> Stream b
mapWithIndex (\Integer
n a -> b
f -> a -> b
f (Stream a
as Stream a -> Integer -> a
forall a. Stream a -> Integer -> a
!! Integer
n)) Stream (a -> b)
fs
Stream a
as <. :: forall a b. Stream a -> Stream b -> Stream a
<. Stream b
_ = Stream a
as
Stream a
_ .> :: forall a b. Stream a -> Stream b -> Stream b
.> Stream b
bs = Stream b
bs
instance ComonadApply Stream where
<@> :: forall a b. Stream (a -> b) -> Stream a -> Stream b
(<@>) = Stream (a -> b) -> Stream a -> Stream b
forall a b. Stream (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
<@ :: forall a b. Stream a -> Stream b -> Stream a
(<@) = Stream a -> Stream b -> Stream a
forall a b. Stream a -> Stream b -> Stream a
forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
(<.)
@> :: forall a b. Stream a -> Stream b -> Stream b
(@>) = Stream a -> Stream b -> Stream b
forall a b. Stream a -> Stream b -> Stream b
forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
(.>)
instance Applicative Stream where
pure :: forall a. a -> Stream a
pure = a -> Stream a
forall a. a -> Stream a
repeat
<*> :: forall a b. Stream (a -> b) -> Stream a -> Stream b
(<*>) = Stream (a -> b) -> Stream a -> Stream b
forall a b. Stream (a -> b) -> Stream a -> Stream b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
(<* ) = (<. )
( *>) = ( .>)
instance Alt Stream where
Stream a
as <!> :: forall a. Stream a -> Stream a -> Stream a
<!> Stream a
bs = (Rep Stream -> a) -> Stream a
forall a. (Rep Stream -> a) -> Stream a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate ((Rep Stream -> a) -> Stream a) -> (Rep Stream -> a) -> Stream a
forall a b. (a -> b) -> a -> b
$ \Rep Stream
i -> case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
Rep Stream
i Integer
2 of
(Integer
q,Integer
0) -> Stream a
as Stream a -> Integer -> a
forall a. Stream a -> Integer -> a
!! Integer
q
(Integer
q,Integer
_) -> Stream a
bs Stream a -> Integer -> a
forall a. Stream a -> Integer -> a
!! Integer
q
instance Foldable Stream where
foldMap :: forall m a. Monoid m => (a -> m) -> Stream a -> m
foldMap a -> m
f (Complete a
t :< Stream a
ts) = (a -> m) -> Complete a -> m
forall m a. Monoid m => (a -> m) -> Complete a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Complete a
t m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Stream a -> m
forall m a. Monoid m => (a -> m) -> Stream a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Stream a
ts
foldr :: forall a b. (a -> b -> b) -> b -> Stream a -> b
foldr a -> b -> b
f b
z (Complete a
t :< Stream a
ts) = (a -> b -> b) -> b -> Complete a -> b
forall a b. (a -> b -> b) -> b -> Complete a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f ((a -> b -> b) -> b -> Stream a -> b
forall a b. (a -> b -> b) -> b -> Stream a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Stream a
ts) Complete a
t
length :: forall a. Stream a -> Int
length Stream a
_ = String -> Int
forall a. HasCallStack => String -> a
error String
"infinite length"
null :: forall a. Stream a -> Bool
null Stream a
_ = Bool
False
instance Foldable1 Stream where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Stream a -> m
foldMap1 a -> m
f (Complete a
t :< Stream a
ts) = (a -> m) -> Complete a -> m
forall m a. Semigroup m => (a -> m) -> Complete a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f Complete a
t m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Stream a -> m
forall m a. Semigroup m => (a -> m) -> Stream a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f Stream a
ts
instance Traversable Stream where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stream a -> f (Stream b)
traverse a -> f b
f (Complete a
t :< Stream a
ts) = Complete b -> Stream b -> Stream b
forall a. Complete a -> Stream a -> Stream a
(:<) (Complete b -> Stream b -> Stream b)
-> f (Complete b) -> f (Stream b -> Stream b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Complete a -> f (Complete b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse a -> f b
f Complete a
t f (Stream b -> Stream b) -> f (Stream b) -> f (Stream b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Stream a -> f (Stream b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stream a -> f (Stream b)
traverse a -> f b
f Stream a
ts
instance Traversable1 Stream where
traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Stream a -> f (Stream b)
traverse1 a -> f b
f (Complete a
t :< Stream a
ts) = Complete b -> Stream b -> Stream b
forall a. Complete a -> Stream a -> Stream a
(:<) (Complete b -> Stream b -> Stream b)
-> f (Complete b) -> f (Stream b -> Stream b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Complete a -> f (Complete b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Complete a -> f (Complete b)
traverse1 a -> f b
f Complete a
t f (Stream b -> Stream b) -> f (Stream b) -> f (Stream b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> f b) -> Stream a -> f (Stream b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Stream a -> f (Stream b)
traverse1 a -> f b
f Stream a
ts
instance Distributive Stream where
distribute :: forall (f :: * -> *) a. Functor f => f (Stream a) -> Stream (f a)
distribute f (Stream a)
w = (Rep Stream -> f a) -> Stream (f a)
forall a. (Rep Stream -> a) -> Stream a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate (\Rep Stream
i -> (Stream a -> a) -> f (Stream a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stream a -> Integer -> a
forall a. Stream a -> Integer -> a
!! Integer
Rep Stream
i) f (Stream a)
w)
instance Representable Stream where
type Rep Stream = Integer
tabulate :: forall a. (Rep Stream -> a) -> Stream a
tabulate Rep Stream -> a
f = (Integer -> () -> a) -> Stream () -> Stream a
forall a b. (Integer -> a -> b) -> Stream a -> Stream b
mapWithIndex (a -> () -> a
forall a b. a -> b -> a
const (a -> () -> a) -> (Integer -> a) -> Integer -> () -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
Rep Stream -> a
f) (() -> Stream ()
forall a. a -> Stream a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
index :: forall a. Stream a -> Rep Stream -> a
index (Complete a
t :< Stream a
ts) Rep Stream
i
| Integer
Rep Stream
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = String -> a
forall a. HasCallStack => String -> a
error String
"index: negative index"
| Integer
Rep Stream
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
w = Integer -> Complete a -> a
forall a. Integer -> Complete a -> a
indexComplete Integer
Rep Stream
i Complete a
t
| Bool
otherwise = Stream a -> Rep Stream -> a
forall a. Stream a -> Rep Stream -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index Stream a
ts (Integer
Rep Stream
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
w)
where w :: Integer
w = Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
t
instance Boring a => Boring (Stream a) where
boring :: Stream a
boring = a -> Stream a
forall a. a -> Stream a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Boring a => a
boring
instance Absurd a => Absurd (Stream a) where
absurd :: forall b. Stream a -> b
absurd = a -> b
forall b. a -> b
forall a b. Absurd a => a -> b
absurd (a -> b) -> (Stream a -> a) -> Stream a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> a
forall a. Stream a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract
instance Semigroup (Stream a) where
<> :: Stream a -> Stream a -> Stream a
(<>) = Stream a -> Stream a -> Stream a
forall a. Stream a -> Stream a -> Stream a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>)
instance Monad Stream where
return :: forall a. a -> Stream a
return = a -> Stream a
forall a. a -> Stream a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Stream a
as >>= :: forall a b. Stream a -> (a -> Stream b) -> Stream b
>>= a -> Stream b
f = (Integer -> a -> b) -> Stream a -> Stream b
forall a b. (Integer -> a -> b) -> Stream a -> Stream b
mapWithIndex (\Integer
i a
a -> a -> Stream b
f a
a Stream b -> Integer -> b
forall a. Stream a -> Integer -> a
!! Integer
i) Stream a
as
interleave :: Stream a -> Stream a -> Stream a
interleave :: forall a. Stream a -> Stream a -> Stream a
interleave = Stream a -> Stream a -> Stream a
forall a. Stream a -> Stream a -> Stream a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>)
repeat :: a -> Stream a
repeat :: forall a. a -> Stream a
repeat a
b = a -> Complete a -> Stream a
forall a. a -> Complete a -> Stream a
go a
b (a -> Complete a
forall a. a -> Complete a
Tip a
b)
where
go :: a -> Complete a -> Stream a
go :: forall a. a -> Complete a -> Stream a
go a
a Complete a
as | Complete a
ass <- a -> Complete a -> Complete a -> Complete a
forall a. a -> Complete a -> Complete a -> Complete a
bin a
a Complete a
as Complete a
as = Complete a
as Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< a -> Complete a -> Stream a
forall a. a -> Complete a -> Stream a
go a
a Complete a
ass
mapWithIndex :: (Integer -> a -> b) -> Stream a -> Stream b
mapWithIndex :: forall a b. (Integer -> a -> b) -> Stream a -> Stream b
mapWithIndex Integer -> a -> b
f0 Stream a
as0 = (Integer -> a -> b) -> Integer -> Stream a -> Stream b
forall {a} {a}.
(Integer -> a -> a) -> Integer -> Stream a -> Stream a
spine Integer -> a -> b
f0 Integer
0 Stream a
as0
where
spine :: (Integer -> a -> a) -> Integer -> Stream a -> Stream a
spine Integer -> a -> a
f Integer
m (Complete a
a :< Stream a
as) = (Integer -> a -> a) -> Integer -> Complete a -> Complete a
forall {a} {a}.
(Integer -> a -> a) -> Integer -> Complete a -> Complete a
tree Integer -> a -> a
f Integer
m Complete a
a Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< (Integer -> a -> a) -> Integer -> Stream a -> Stream a
spine Integer -> a -> a
f (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
a) Stream a
as
tree :: (Integer -> a -> a) -> Integer -> Complete a -> Complete a
tree Integer -> a -> a
f Integer
m (Tip a
a) = a -> Complete a
forall a. a -> Complete a
Tip (Integer -> a -> a
f Integer
m a
a)
tree Integer -> a -> a
f Integer
m (Bin Integer
n a
a Complete a
l Complete a
r) = Integer -> a -> Complete a -> Complete a -> Complete a
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
n (Integer -> a -> a
f Integer
m a
a) ((Integer -> a -> a) -> Integer -> Complete a -> Complete a
tree Integer -> a -> a
f (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Complete a
l) ((Integer -> a -> a) -> Integer -> Complete a -> Complete a
tree Integer -> a -> a
f (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
l) Complete a
r)
indexed :: Stream a -> Stream (Integer, a)
indexed :: forall a. Stream a -> Stream (Integer, a)
indexed = (Integer -> a -> (Integer, a)) -> Stream a -> Stream (Integer, a)
forall a b. (Integer -> a -> b) -> Stream a -> Stream b
mapWithIndex (,)
from :: Num a => a -> Stream a
from :: forall a. Num a => a -> Stream a
from a
a = (Integer -> a -> a) -> Stream a -> Stream a
forall a b. (Integer -> a -> b) -> Stream a -> Stream b
mapWithIndex (a -> a -> a
forall a. Num a => a -> a -> a
(+) (a -> a -> a) -> (Integer -> a) -> Integer -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (a -> Stream a
forall a. a -> Stream a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
(<|) :: a -> Stream a -> Stream a
a
a <| :: forall a. a -> Stream a -> Stream a
<| (Complete a
l :< Complete a
r :< Stream a
as)
| Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
l Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
r = a -> Complete a -> Complete a -> Complete a
forall a. a -> Complete a -> Complete a -> Complete a
bin a
a Complete a
l Complete a
r Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
as
a
a <| Stream a
as = a -> Complete a
forall a. a -> Complete a
Tip a
a Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
as
{-# INLINE (<|) #-}
tail :: Stream a -> Stream a
tail :: forall a. Stream a -> Stream a
tail (Tip{} :< Stream a
ts) = Stream a
ts
tail (Bin Integer
_ a
_ Complete a
l Complete a
r :< Stream a
ts) = Complete a
l Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Complete a
r Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
ts
{-# INLINE tail #-}
uncons :: Stream a -> (a, Stream a)
uncons :: forall a. Stream a -> (a, Stream a)
uncons (Tip a
a :< Stream a
as) = (a
a, Stream a
as)
uncons (Bin Integer
_ a
a Complete a
l Complete a
r :< Stream a
as) = (a
a, Complete a
l Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Complete a
r Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
as)
{-# INLINE uncons #-}
indexComplete :: Integer -> Complete a -> a
indexComplete :: forall a. Integer -> Complete a -> a
indexComplete Integer
0 (Tip a
a) = a
a
indexComplete Integer
0 (Bin Integer
_ a
a Complete a
_ Complete a
_) = a
a
indexComplete Integer
i (Bin Integer
w a
_ Complete a
l Complete a
r)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
w' = Integer -> Complete a -> a
forall a. Integer -> Complete a -> a
indexComplete (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) Complete a
l
| Bool
otherwise = Integer -> Complete a -> a
forall a. Integer -> Complete a -> a
indexComplete (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
w') Complete a
r
where w' :: Integer
w' = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
w Integer
2
indexComplete Integer
_ Complete a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"indexComplete"
(!!) :: Stream a -> Integer -> a
!! :: forall a. Stream a -> Integer -> a
(!!) = Stream a -> Integer -> a
Stream a -> Rep Stream -> a
forall a. Stream a -> Rep Stream -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index
drop :: Integer -> Stream a -> Stream a
drop :: forall a. Integer -> Stream a -> Stream a
drop Integer
0 Stream a
ts = Stream a
ts
drop Integer
i (Complete a
t :< Stream a
ts) = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
i Integer
w of
Ordering
LT -> Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
forall a.
Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
dropComplete Integer
i Complete a
t (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
ts)
Ordering
EQ -> Stream a
ts
Ordering
GT -> Integer -> Stream a -> Stream a
forall a. Integer -> Stream a -> Stream a
drop (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
w) Stream a
ts
where w :: Integer
w = Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
t
dropComplete :: Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
dropComplete :: forall a.
Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
dropComplete Integer
0 Complete a
t Complete a -> Stream a
f = Complete a -> Stream a
f Complete a
t
dropComplete Integer
1 (Bin Integer
_ a
_ Complete a
l Complete a
r) Complete a -> Stream a
f = Complete a
l Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Complete a -> Stream a
f Complete a
r
dropComplete Integer
i (Bin Integer
w a
_ Complete a
l Complete a
r) Complete a -> Stream a
f = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer
w' of
Ordering
LT -> Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
forall a.
Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
dropComplete (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) Complete a
l (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Complete a -> Stream a
f Complete a
r)
Ordering
EQ -> Complete a -> Stream a
f Complete a
r
Ordering
GT -> Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
forall a.
Integer -> Complete a -> (Complete a -> Stream a) -> Stream a
dropComplete (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
w') Complete a
r Complete a -> Stream a
f
where w' :: Integer
w' = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
w Integer
2
dropComplete Integer
_ Complete a
_ Complete a -> Stream a
_ = String -> Stream a
forall a. HasCallStack => String -> a
error String
"dropComplete"
dropWhile :: (a -> Bool) -> Stream a -> Stream a
dropWhile :: forall a. (a -> Bool) -> Stream a -> Stream a
dropWhile a -> Bool
p Stream a
as
| a -> Bool
p (Stream a -> a
forall a. Stream a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Stream a
as) = (a -> Bool) -> Stream a -> Stream a
forall a. (a -> Bool) -> Stream a -> Stream a
dropWhile a -> Bool
p (Stream a -> Stream a
forall a. Stream a -> Stream a
tail Stream a
as)
| Bool
otherwise = Stream a
as
span :: (a -> Bool) -> Stream a -> ([a], Stream a)
span :: forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
span a -> Bool
p Stream a
as
| a
a <- Stream a -> a
forall a. Stream a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Stream a
as, a -> Bool
p a
a = ([a] -> [a]) -> ([a], Stream a) -> ([a], Stream a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], Stream a) -> ([a], Stream a))
-> ([a], Stream a) -> ([a], Stream a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Stream a -> ([a], Stream a)
forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
span a -> Bool
p (Stream a -> Stream a
forall a. Stream a -> Stream a
tail Stream a
as)
| Bool
otherwise = ([], Stream a
as)
break :: (a -> Bool) -> Stream a -> ([a], Stream a)
break :: forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
break a -> Bool
p = (a -> Bool) -> Stream a -> ([a], Stream a)
forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
split :: (a -> Bool) -> Stream a -> ([a], Stream a)
split :: forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
split a -> Bool
p (Complete a
a :< Stream a
as)
| a -> Bool
p (Stream a -> a
forall a. Stream a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Stream a
as) = (a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
forall a.
(a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitComplete a -> Bool
p Complete a
a (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
as)
| ([a]
ts, Stream a
fs) <- (a -> Bool) -> Stream a -> ([a], Stream a)
forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
split a -> Bool
p Stream a
as = ((a -> [a] -> [a]) -> [a] -> Complete a -> [a]
forall a b. (a -> b -> b) -> b -> Complete a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [a]
ts Complete a
a, Stream a
fs)
splitComplete :: (a -> Bool) -> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitComplete :: forall a.
(a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitComplete a -> Bool
_ t :: Complete a
t@Tip{} Complete a -> Stream a
f = ([], Complete a -> Stream a
f Complete a
t)
splitComplete a -> Bool
p t :: Complete a
t@(Bin Integer
_ a
a Complete a
l Complete a
r) Complete a -> Stream a
f
| a -> Bool
p a
a = ([], Complete a -> Stream a
f Complete a
t)
| a -> Bool
p (Complete a -> a
forall a. Complete a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Complete a
r), ([a]
ts, Stream a
fs) <- (a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
forall a.
(a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitComplete a -> Bool
p Complete a
l (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Complete a -> Stream a
f Complete a
r) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ts, Stream a
fs)
| ([a]
ts, Stream a
fs) <- (a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
forall a.
(a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitComplete a -> Bool
p Complete a
r Complete a -> Stream a
f = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> [a] -> [a]) -> [a] -> Complete a -> [a]
forall a b. (a -> b -> b) -> b -> Complete a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [a]
ts Complete a
l, Stream a
fs)
splitW :: (Stream a -> Bool) -> Stream a -> ([a], Stream a)
splitW :: forall a. (Stream a -> Bool) -> Stream a -> ([a], Stream a)
splitW Stream a -> Bool
p (Complete a
a :< Stream a
as)
| Stream a -> Bool
p Stream a
as = (Stream a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
forall a.
(Stream a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitCompleteW Stream a -> Bool
p Complete a
a (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
as)
| ([a]
ts, Stream a
fs) <- (Stream a -> Bool) -> Stream a -> ([a], Stream a)
forall a. (Stream a -> Bool) -> Stream a -> ([a], Stream a)
splitW Stream a -> Bool
p Stream a
as = ((a -> [a] -> [a]) -> [a] -> Complete a -> [a]
forall a b. (a -> b -> b) -> b -> Complete a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [a]
ts Complete a
a, Stream a
fs)
splitCompleteW :: (Stream a -> Bool) -> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitCompleteW :: forall a.
(Stream a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitCompleteW Stream a -> Bool
_ t :: Complete a
t@Tip{} Complete a -> Stream a
f = ([], Complete a -> Stream a
f Complete a
t)
splitCompleteW Stream a -> Bool
p t :: Complete a
t@(Bin Integer
_ a
a Complete a
l Complete a
r) Complete a -> Stream a
f
| Stream a
w <- Complete a -> Stream a
f Complete a
t, Stream a -> Bool
p Stream a
w = ([], Stream a
w)
| Stream a
w <- Complete a -> Stream a
f Complete a
r, Stream a -> Bool
p Stream a
w, ([a]
ts, Stream a
fs) <- (Stream a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
forall a.
(Stream a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitCompleteW Stream a -> Bool
p Complete a
l (Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
w) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ts, Stream a
fs)
| ([a]
ts, Stream a
fs) <- (Stream a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
forall a.
(Stream a -> Bool)
-> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)
splitCompleteW Stream a -> Bool
p Complete a
r Complete a -> Stream a
f = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> [a] -> [a]) -> [a] -> Complete a -> [a]
forall a b. (a -> b -> b) -> b -> Complete a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [a]
ts Complete a
l, Stream a
fs)
insert :: Ord a => a -> Stream a -> Stream a
insert :: forall a. Ord a => a -> Stream a -> Stream a
insert a
a Stream a
as | ([a]
ts, Stream a
as') <- (a -> Bool) -> Stream a -> ([a], Stream a)
forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
split (a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=) Stream a
as = (a -> Stream a -> Stream a) -> Stream a -> [a] -> Stream a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
(<|) (a
a a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
<| Stream a
as') [a]
ts
insertBy :: (a -> a -> Ordering) -> a -> Stream a -> Stream a
insertBy :: forall a. (a -> a -> Ordering) -> a -> Stream a -> Stream a
insertBy a -> a -> Ordering
cmp a
a Stream a
as | ([a]
ts, Stream a
as') <- (a -> Bool) -> Stream a -> ([a], Stream a)
forall a. (a -> Bool) -> Stream a -> ([a], Stream a)
split (\a
b -> a -> a -> Ordering
cmp a
a a
b Ordering -> Ordering -> Bool
forall a. Ord a => a -> a -> Bool
<= Ordering
EQ) Stream a
as = (a -> Stream a -> Stream a) -> Stream a -> [a] -> Stream a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
(<|) (a
a a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
<| Stream a
as') [a]
ts
adjust :: Integer -> (a -> a) -> Stream a -> Stream a
adjust :: forall a. Integer -> (a -> a) -> Stream a -> Stream a
adjust !Integer
n a -> a
f (Complete a
a :< Stream a
as)
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
w = Integer -> (a -> a) -> Complete a -> Complete a
forall a. Integer -> (a -> a) -> Complete a -> Complete a
adjustComplete Integer
n a -> a
f Complete a
a Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Stream a
as
| Bool
otherwise = Complete a
a Complete a -> Stream a -> Stream a
forall a. Complete a -> Stream a -> Stream a
:< Integer -> (a -> a) -> Stream a -> Stream a
forall a. Integer -> (a -> a) -> Stream a -> Stream a
adjust (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
w) a -> a
f Stream a
as
where w :: Integer
w = Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
a
adjustComplete :: Integer -> (a -> a) -> Complete a -> Complete a
adjustComplete :: forall a. Integer -> (a -> a) -> Complete a -> Complete a
adjustComplete Integer
0 a -> a
f (Tip a
a) = a -> Complete a
forall a. a -> Complete a
Tip (a -> a
f a
a)
adjustComplete Integer
_ a -> a
_ t :: Complete a
t@Tip{} = Complete a
t
adjustComplete Integer
n a -> a
f (Bin Integer
m a
a Complete a
l Complete a
r)
| Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> a -> Complete a -> Complete a -> Complete a
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
m (a -> a
f a
a) Complete a
l Complete a
r
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
w = Integer -> a -> Complete a -> Complete a -> Complete a
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
m a
a (Integer -> (a -> a) -> Complete a -> Complete a
forall a. Integer -> (a -> a) -> Complete a -> Complete a
adjustComplete (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) a -> a
f Complete a
l) Complete a
r
| Bool
otherwise = Integer -> a -> Complete a -> Complete a -> Complete a
forall a. Integer -> a -> Complete a -> Complete a -> Complete a
Bin Integer
m a
a Complete a
l (Integer -> (a -> a) -> Complete a -> Complete a
forall a. Integer -> (a -> a) -> Complete a -> Complete a
adjustComplete (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
w) a -> a
f Complete a
r)
where w :: Integer
w = Complete a -> Integer
forall a. Complete a -> Integer
weight Complete a
l
update :: Integer -> a -> Stream a -> Stream a
update :: forall a. Integer -> a -> Stream a -> Stream a
update Integer
n = Integer -> (a -> a) -> Stream a -> Stream a
forall a. Integer -> (a -> a) -> Stream a -> Stream a
adjust Integer
n ((a -> a) -> Stream a -> Stream a)
-> (a -> a -> a) -> a -> Stream a -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const