{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#include "lens-common.h"
module Control.Lens.Internal.Deque
( Deque(..)
, size
, fromList
, null
, singleton
) where
import Prelude ()
import Control.Lens.Cons
import Control.Lens.Fold
import Control.Lens.Indexed hiding ((<.>))
import Control.Lens.Internal.Prelude hiding (null)
import Control.Lens.Iso
import Control.Lens.Lens
import Control.Lens.Prism
import Control.Monad
import Data.Foldable (toList)
import Data.Function
import Data.Functor.Bind
import Data.Functor.Plus
import Data.Functor.Reverse
data Deque a = BD !Int [a] !Int [a]
deriving Int -> Deque a -> ShowS
forall a. Show a => Int -> Deque a -> ShowS
forall a. Show a => [Deque a] -> ShowS
forall a. Show a => Deque a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Deque a] -> ShowS
$cshowList :: forall a. Show a => [Deque a] -> ShowS
show :: Deque a -> String
$cshow :: forall a. Show a => Deque a -> String
showsPrec :: Int -> Deque a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Deque a -> ShowS
Show
null :: Deque a -> Bool
null :: forall a. Deque a -> Bool
null (BD Int
lf [a]
_ Int
lr [a]
_) = Int
lf forall a. Num a => a -> a -> a
+ Int
lr forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE null #-}
singleton :: a -> Deque a
singleton :: forall a. a -> Deque a
singleton a
a = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
1 [a
a] Int
0 []
{-# INLINE singleton #-}
size :: Deque a -> Int
size :: forall a. Deque a -> Int
size (BD Int
lf [a]
_ Int
lr [a]
_) = Int
lf forall a. Num a => a -> a -> a
+ Int
lr
{-# INLINE size #-}
fromList :: [a] -> Deque a
fromList :: forall a. [a] -> Deque a
fromList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s a. Cons s s a a => a -> s -> s
cons forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE fromList #-}
instance Eq a => Eq (Deque a) where
== :: Deque a -> Deque a -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE (==) #-}
instance Ord a => Ord (Deque a) where
compare :: Deque a -> Deque 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 (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE compare #-}
instance Functor Deque where
fmap :: forall a b. (a -> b) -> Deque a -> Deque b
fmap a -> b
h (BD Int
lf [a]
f Int
lr [a]
r) = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lf (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h [a]
f) Int
lr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h [a]
r)
{-# INLINE fmap #-}
instance FunctorWithIndex Int Deque where
imap :: forall a b. (Int -> a -> b) -> Deque a -> Deque b
imap Int -> a -> b
h (BD Int
lf [a]
f Int
lr [a]
r) = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lf (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap Int -> a -> b
h [a]
f) Int
lr (forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
j -> Int -> a -> b
h (Int
n forall a. Num a => a -> a -> a
- Int
j)) [a]
r)
where !n :: Int
n = Int
lf forall a. Num a => a -> a -> a
+ Int
lr
instance Apply Deque where
Deque (a -> b)
fs <.> :: forall a b. Deque (a -> b) -> Deque a -> Deque b
<.> Deque a
as = forall a. [a] -> Deque a
fromList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque (a -> b)
fs forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque a
as)
{-# INLINE (<.>) #-}
instance Applicative Deque where
pure :: forall a. a -> Deque a
pure a
a = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
1 [a
a] Int
0 []
{-# INLINE pure #-}
Deque (a -> b)
fs <*> :: forall a b. Deque (a -> b) -> Deque a -> Deque b
<*> Deque a
as = forall a. [a] -> Deque a
fromList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque (a -> b)
fs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque a
as)
{-# INLINE (<*>) #-}
instance Alt Deque where
Deque a
xs <!> :: forall a. Deque a -> Deque a -> Deque a
<!> Deque a
ys
| forall a. Deque a -> Int
size Deque a
xs forall a. Ord a => a -> a -> Bool
< forall a. Deque a -> Int
size Deque a
ys = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s a. Cons s s a a => a -> s -> s
cons Deque a
ys Deque a
xs
| Bool
otherwise = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall s a. Snoc s s a a => s -> a -> s
snoc Deque a
xs Deque a
ys
{-# INLINE (<!>) #-}
instance Plus Deque where
zero :: forall a. Deque a
zero = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
0 [] Int
0 []
{-# INLINE zero #-}
instance Alternative Deque where
empty :: forall a. Deque a
empty = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
0 [] Int
0 []
{-# INLINE empty #-}
Deque a
xs <|> :: forall a. Deque a -> Deque a -> Deque a
<|> Deque a
ys
| forall a. Deque a -> Int
size Deque a
xs forall a. Ord a => a -> a -> Bool
< forall a. Deque a -> Int
size Deque a
ys = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s a. Cons s s a a => a -> s -> s
cons Deque a
ys Deque a
xs
| Bool
otherwise = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall s a. Snoc s s a a => s -> a -> s
snoc Deque a
xs Deque a
ys
{-# INLINE (<|>) #-}
instance Reversing (Deque a) where
reversing :: Deque a -> Deque a
reversing (BD Int
lf [a]
f Int
lr [a]
r) = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lr [a]
r Int
lf [a]
f
{-# INLINE reversing #-}
instance Bind Deque where
Deque a
ma >>- :: forall a b. Deque a -> (a -> Deque b) -> Deque b
>>- a -> Deque b
k = forall a. [a] -> Deque a
fromList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Deque b
k)
{-# INLINE (>>-) #-}
instance Monad Deque where
return :: forall a. a -> Deque a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
Deque a
ma >>= :: forall a b. Deque a -> (a -> Deque b) -> Deque b
>>= a -> Deque b
k = forall a. [a] -> Deque a
fromList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Deque b
k)
{-# INLINE (>>=) #-}
instance MonadPlus Deque where
mzero :: forall a. Deque a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE mzero #-}
mplus :: forall a. Deque a -> Deque a -> Deque a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
{-# INLINE mplus #-}
instance Foldable Deque where
foldMap :: forall m a. Monoid m => (a -> m) -> Deque a -> m
foldMap a -> m
h (BD Int
_ [a]
f Int
_ [a]
r) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
h [a]
f forall a. Monoid a => a -> a -> a
`mappend` forall a. Dual a -> a
getDual (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Dual a
Dual forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> m
h) [a]
r)
{-# INLINE foldMap #-}
instance FoldableWithIndex Int Deque where
ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> Deque a -> m
ifoldMap Int -> a -> m
h (BD Int
lf [a]
f Int
lr [a]
r) = forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap Int -> a -> m
h [a]
f forall a. Monoid a => a -> a -> a
`mappend` forall a. Dual a -> a
getDual (forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\Int
j -> forall a. a -> Dual a
Dual forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Int -> a -> m
h (Int
n forall a. Num a => a -> a -> a
- Int
j)) [a]
r)
where !n :: Int
n = Int
lf forall a. Num a => a -> a -> a
+ Int
lr
{-# INLINE ifoldMap #-}
instance Traversable Deque where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Deque a -> f (Deque b)
traverse a -> f b
h (BD Int
lf [a]
f Int
lr [a]
r) = (forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lf forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? Int
lr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
h [a]
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) s t a b.
(Profunctor p, Profunctor q) =>
Optical p q (Backwards f) s t a b -> Optical p q f s t a b
backwards forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
h [a]
r
{-# INLINE traverse #-}
instance TraversableWithIndex Int Deque where
itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Deque a -> f (Deque b)
itraverse Int -> a -> f b
h (BD Int
lf [a]
f Int
lr [a]
r) = (\[b]
f' Reverse [] b
r' -> forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lr [b]
f' Int
lr (forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse Reverse [] b
r')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse Int -> a -> f b
h [a]
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\Int
j -> Int -> a -> f b
h (Int
n forall a. Num a => a -> a -> a
- Int
j)) (forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse [a]
r)
where !n :: Int
n = Int
lf forall a. Num a => a -> a -> a
+ Int
lr
{-# INLINE itraverse #-}
instance Semigroup (Deque a) where
Deque a
xs <> :: Deque a -> Deque a -> Deque a
<> Deque a
ys
| forall a. Deque a -> Int
size Deque a
xs forall a. Ord a => a -> a -> Bool
< forall a. Deque a -> Int
size Deque a
ys = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s a. Cons s s a a => a -> s -> s
cons Deque a
ys Deque a
xs
| Bool
otherwise = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall s a. Snoc s s a a => s -> a -> s
snoc Deque a
xs Deque a
ys
{-# INLINE (<>) #-}
instance Monoid (Deque a) where
mempty :: Deque a
mempty = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
0 [] Int
0 []
{-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
mappend xs ys
| size xs < size ys = foldr cons ys xs
| otherwise = foldl snoc xs ys
{-# INLINE mappend #-}
#endif
check :: Int -> [a] -> Int -> [a] -> Deque a
check :: forall a. Int -> [a] -> Int -> [a] -> Deque a
check Int
lf [a]
f Int
lr [a]
r
| Int
lf forall a. Ord a => a -> a -> Bool
> Int
3forall a. Num a => a -> a -> a
*Int
lr forall a. Num a => a -> a -> a
+ Int
1, Int
i <- forall a. Integral a => a -> a -> a
div (Int
lf forall a. Num a => a -> a -> a
+ Int
lr) Int
2, ([a]
f',[a]
f'') <- forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
f = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
i [a]
f' (Int
lf forall a. Num a => a -> a -> a
+ Int
lr forall a. Num a => a -> a -> a
- Int
i) ([a]
r forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [a]
f'')
| Int
lr forall a. Ord a => a -> a -> Bool
> Int
3forall a. Num a => a -> a -> a
*Int
lf forall a. Num a => a -> a -> a
+ Int
1, Int
j <- forall a. Integral a => a -> a -> a
div (Int
lf forall a. Num a => a -> a -> a
+ Int
lr) Int
2, ([a]
r',[a]
r'') <- forall a. Int -> [a] -> ([a], [a])
splitAt Int
j [a]
r = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD (Int
lf forall a. Num a => a -> a -> a
+ Int
lr forall a. Num a => a -> a -> a
- Int
j) ([a]
f forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [a]
r'') Int
j [a]
r'
| Bool
otherwise = forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lf [a]
f Int
lr [a]
r
{-# INLINE check #-}
instance Cons (Deque a) (Deque b) a b where
_Cons :: Prism (Deque a) (Deque b) (a, Deque a) (b, Deque b)
_Cons = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\(b
x,BD Int
lf [b]
f Int
lr [b]
r) -> forall a. Int -> [a] -> Int -> [a] -> Deque a
check (Int
lf forall a. Num a => a -> a -> a
+ Int
1) (b
x forall a. a -> [a] -> [a]
: [b]
f) Int
lr [b]
r) forall a b. (a -> b) -> a -> b
$ \ (BD Int
lf [a]
f Int
lr [a]
r) ->
if Int
lf forall a. Num a => a -> a -> a
+ Int
lr forall a. Eq a => a -> a -> Bool
== Int
0
then forall a b. a -> Either a b
Left forall (f :: * -> *) a. Alternative f => f a
empty
else forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ case [a]
f of
[] -> (forall a. [a] -> a
head [a]
r, forall (f :: * -> *) a. Alternative f => f a
empty)
(a
x:[a]
xs) -> (a
x, forall a. Int -> [a] -> Int -> [a] -> Deque a
check (Int
lf forall a. Num a => a -> a -> a
- Int
1) [a]
xs Int
lr [a]
r)
{-# INLINE _Cons #-}
instance Snoc (Deque a) (Deque b) a b where
_Snoc :: Prism (Deque a) (Deque b) (Deque a, a) (Deque b, b)
_Snoc = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\(BD Int
lf [b]
f Int
lr [b]
r,b
x) -> forall a. Int -> [a] -> Int -> [a] -> Deque a
check Int
lf [b]
f (Int
lr forall a. Num a => a -> a -> a
+ Int
1) (b
x forall a. a -> [a] -> [a]
: [b]
r)) forall a b. (a -> b) -> a -> b
$ \ (BD Int
lf [a]
f Int
lr [a]
r) ->
if Int
lf forall a. Num a => a -> a -> a
+ Int
lr forall a. Eq a => a -> a -> Bool
== Int
0
then forall a b. a -> Either a b
Left forall (f :: * -> *) a. Alternative f => f a
empty
else forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ case [a]
r of
[] -> (forall (f :: * -> *) a. Alternative f => f a
empty, forall a. [a] -> a
head [a]
f)
(a
x:[a]
xs) -> (forall a. Int -> [a] -> Int -> [a] -> Deque a
check Int
lf [a]
f (Int
lr forall a. Num a => a -> a -> a
- Int
1) [a]
xs, a
x)
{-# INLINE _Snoc #-}