{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

#include "lens-common.h"
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Internal.Deque
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- This module is designed to be imported qualified.
-----------------------------------------------------------------------------
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

-- $setup
-- >>> import Control.Applicative (empty)

-- | A Banker's deque based on Chris Okasaki's \"Purely Functional Data Structures\"
data Deque a = BD !Int [a] !Int [a]
  deriving Int -> Deque a -> ShowS
[Deque a] -> ShowS
Deque a -> String
(Int -> Deque a -> ShowS)
-> (Deque a -> String) -> ([Deque a] -> ShowS) -> Show (Deque a)
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
$cshowsPrec :: forall a. Show a => Int -> Deque a -> ShowS
showsPrec :: Int -> Deque a -> ShowS
$cshow :: forall a. Show a => Deque a -> String
show :: Deque a -> String
$cshowList :: forall a. Show a => [Deque a] -> ShowS
showList :: [Deque a] -> ShowS
Show

-- | /O(1)/. Determine if a 'Deque' is 'empty'.
--
-- >>> Control.Lens.Internal.Deque.null empty
-- True
--
-- >>> Control.Lens.Internal.Deque.null (singleton 1)
-- False
null :: Deque a -> Bool
null :: forall a. Deque a -> Bool
null (BD Int
lf [a]
_ Int
lr [a]
_) = Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE null #-}

-- | /O(1)/. Generate a singleton 'Deque'
--
-- >>> singleton 1
-- BD 1 [1] 0 []
singleton :: a -> Deque a
singleton :: forall a. a -> Deque a
singleton a
a = Int -> [a] -> Int -> [a] -> Deque a
forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
1 [a
a] Int
0 []
{-# INLINE singleton #-}

-- | /O(1)/. Calculate the size of a 'Deque'
--
-- >>> size (fromList [1,4,6])
-- 3
size :: Deque a -> Int
size :: forall a. Deque a -> Int
size (BD Int
lf [a]
_ Int
lr [a]
_) = Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr
{-# INLINE size #-}

-- | /O(n)/ amortized. Construct a 'Deque' from a list of values.
--
-- >>> fromList [1,2]
-- BD 1 [1] 1 [2]
fromList :: [a] -> Deque a
fromList :: forall a. [a] -> Deque a
fromList = (a -> Deque a -> Deque a) -> Deque a -> [a] -> Deque 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 -> Deque a -> Deque a
forall s a. Cons s s a a => a -> s -> s
cons Deque a
forall a. Deque a
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE fromList #-}

instance Eq a => Eq (Deque a) where
  == :: Deque a -> Deque a -> Bool
(==) = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> Bool)
-> (Deque a -> [a]) -> Deque a -> Deque a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Deque a -> [a]
forall a. Deque a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  {-# INLINE (==) #-}

instance Ord a => Ord (Deque a) where
  compare :: Deque a -> Deque a -> Ordering
compare = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [a] -> Ordering)
-> (Deque a -> [a]) -> Deque a -> Deque a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Deque a -> [a]
forall a. Deque a -> [a]
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) = Int -> [b] -> Int -> [b] -> Deque b
forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lf ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h [a]
f) Int
lr ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
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) = Int -> [b] -> Int -> [b] -> Deque b
forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lf ((Int -> a -> b) -> [a] -> [b]
forall a b. (Int -> a -> b) -> [a] -> [b]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap Int -> a -> b
h [a]
f) Int
lr ((Int -> a -> b) -> [a] -> [b]
forall a b. (Int -> a -> b) -> [a] -> [b]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
j -> Int -> a -> b
h (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j)) [a]
r)
    where !n :: Int
n = Int
lf Int -> Int -> Int
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 = [b] -> Deque b
forall a. [a] -> Deque a
fromList (Deque (a -> b) -> [a -> b]
forall a. Deque a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque (a -> b)
fs [a -> b] -> [a] -> [b]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> Deque a -> [a]
forall a. Deque a -> [a]
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 = Int -> [a] -> Int -> [a] -> Deque 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 = [b] -> Deque b
forall a. [a] -> Deque a
fromList (Deque (a -> b) -> [a -> b]
forall a. Deque a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque (a -> b)
fs [a -> b] -> [a] -> [b]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Deque a -> [a]
forall a. Deque a -> [a]
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
    | Deque a -> Int
forall a. Deque a -> Int
size Deque a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Deque a -> Int
forall a. Deque a -> Int
size Deque a
ys = (a -> Deque a -> Deque a) -> Deque a -> Deque a -> Deque a
forall a b. (a -> b -> b) -> b -> Deque a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Deque a -> Deque a
forall s a. Cons s s a a => a -> s -> s
cons Deque a
ys Deque a
xs
    | Bool
otherwise         = (Deque a -> a -> Deque a) -> Deque a -> Deque a -> Deque a
forall b a. (b -> a -> b) -> b -> Deque a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Deque a -> a -> Deque a
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 = Int -> [a] -> Int -> [a] -> Deque a
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 = Int -> [a] -> Int -> [a] -> Deque a
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
    | Deque a -> Int
forall a. Deque a -> Int
size Deque a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Deque a -> Int
forall a. Deque a -> Int
size Deque a
ys = (a -> Deque a -> Deque a) -> Deque a -> Deque a -> Deque a
forall a b. (a -> b -> b) -> b -> Deque a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Deque a -> Deque a
forall s a. Cons s s a a => a -> s -> s
cons Deque a
ys Deque a
xs
    | Bool
otherwise         = (Deque a -> a -> Deque a) -> Deque a -> Deque a -> Deque a
forall b a. (b -> a -> b) -> b -> Deque a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Deque a -> a -> Deque a
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) = Int -> [a] -> Int -> [a] -> Deque a
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 = [b] -> Deque b
forall a. [a] -> Deque a
fromList (Deque a -> [a]
forall a. Deque a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque a
ma [a] -> (a -> [b]) -> [b]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Deque b -> [b]
forall a. Deque a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Deque b -> [b]) -> (a -> Deque b) -> a -> [b]
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 = a -> Deque a
forall a. a -> Deque a
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 = [b] -> Deque b
forall a. [a] -> Deque a
fromList (Deque a -> [a]
forall a. Deque a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Deque a
ma [a] -> (a -> [b]) -> [b]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Deque b -> [b]
forall a. Deque a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Deque b -> [b]) -> (a -> Deque b) -> a -> [b]
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 = Deque a
forall a. Deque a
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE mzero #-}
  mplus :: forall a. Deque a -> Deque a -> Deque a
mplus = Deque a -> Deque a -> Deque a
forall a. Deque a -> Deque a -> Deque a
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) = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
h [a]
f m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Dual m -> m
forall a. Dual a -> a
getDual ((a -> Dual m) -> [a] -> Dual m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m -> Dual m
forall a. a -> Dual a
Dual (m -> Dual m) -> (a -> m) -> a -> Dual m
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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) = (Int -> a -> m) -> [a] -> m
forall m a. Monoid m => (Int -> a -> m) -> [a] -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap Int -> a -> m
h [a]
f m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Dual m -> m
forall a. Dual a -> a
getDual ((Int -> a -> Dual m) -> [a] -> Dual m
forall m a. Monoid m => (Int -> a -> m) -> [a] -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\Int
j -> m -> Dual m
forall a. a -> Dual a
Dual (m -> Dual m) -> (a -> m) -> a -> Dual m
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j)) [a]
r)
    where !n :: Int
n = Int
lf Int -> Int -> Int
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) = (Int -> [b] -> Int -> [b] -> Deque b
forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lf ([b] -> Int -> [b] -> Deque b) -> Int -> [b] -> [b] -> Deque b
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? Int
lr) ([b] -> [b] -> Deque b) -> f [b] -> f ([b] -> Deque b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [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) -> [a] -> f [b]
traverse a -> f b
h [a]
f f ([b] -> Deque b) -> f [b] -> f (Deque b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Optical (->) (->) (Backwards f) [a] [b] a b
-> (a -> f b) -> [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 Optical (->) (->) (Backwards f) [a] [b] a 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) -> [a] -> f [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' -> Int -> [b] -> Int -> [b] -> Deque b
forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
lr [b]
f' Int
lr (Reverse [] b -> [b]
forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse Reverse [] b
r')) ([b] -> Reverse [] b -> Deque b)
-> f [b] -> f (Reverse [] b -> Deque b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f b) -> [a] -> f [b]
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> [a] -> f [b]
itraverse Int -> a -> f b
h [a]
f f (Reverse [] b -> Deque b) -> f (Reverse [] b) -> f (Deque b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> a -> f b) -> Reverse [] a -> f (Reverse [] b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Reverse [] a -> f (Reverse [] b)
itraverse (\Int
j -> Int -> a -> f b
h (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j)) ([a] -> Reverse [] a
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse [a]
r)
    where !n :: Int
n = Int
lf Int -> Int -> Int
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
    | Deque a -> Int
forall a. Deque a -> Int
size Deque a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Deque a -> Int
forall a. Deque a -> Int
size Deque a
ys = (a -> Deque a -> Deque a) -> Deque a -> Deque a -> Deque a
forall a b. (a -> b -> b) -> b -> Deque a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Deque a -> Deque a
forall s a. Cons s s a a => a -> s -> s
cons Deque a
ys Deque a
xs
    | Bool
otherwise         = (Deque a -> a -> Deque a) -> Deque a -> Deque a -> Deque a
forall b a. (b -> a -> b) -> b -> Deque a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Deque a -> a -> Deque a
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 = Int -> [a] -> Int -> [a] -> Deque a
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 that a 'Deque' satisfies the balance invariants and rebalance if not.
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
i <- Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr) Int
2, ([a]
f',[a]
f'') <- Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
f = Int -> [a] -> Int -> [a] -> Deque a
forall a. Int -> [a] -> Int -> [a] -> Deque a
BD Int
i [a]
f' (Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ([a]
r [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
f'')
  | Int
lr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
j <- Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr) Int
2, ([a]
r',[a]
r'') <- Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
j [a]
r = Int -> [a] -> Int -> [a] -> Deque a
forall a. Int -> [a] -> Int -> [a] -> Deque a
BD (Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j) ([a]
f [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
r'') Int
j [a]
r'
  | Bool
otherwise = Int -> [a] -> Int -> [a] -> Deque a
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 = ((b, Deque b) -> Deque b)
-> (Deque a -> Either (Deque b) (a, Deque a))
-> Prism (Deque a) (Deque b) (a, Deque a) (b, Deque b)
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) -> Int -> [b] -> Int -> [b] -> Deque b
forall a. Int -> [a] -> Int -> [a] -> Deque a
check (Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (b
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
f) Int
lr [b]
r) ((Deque a -> Either (Deque b) (a, Deque a))
 -> Prism (Deque a) (Deque b) (a, Deque a) (b, Deque b))
-> (Deque a -> Either (Deque b) (a, Deque a))
-> Prism (Deque a) (Deque b) (a, Deque a) (b, Deque b)
forall a b. (a -> b) -> a -> b
$ \ (BD Int
lf [a]
f Int
lr [a]
r) ->
    if Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Deque b -> Either (Deque b) (a, Deque a)
forall a b. a -> Either a b
Left Deque b
forall a. Deque a
forall (f :: * -> *) a. Alternative f => f a
empty
    else (a, Deque a) -> Either (Deque b) (a, Deque a)
forall a b. b -> Either a b
Right ((a, Deque a) -> Either (Deque b) (a, Deque a))
-> (a, Deque a) -> Either (Deque b) (a, Deque a)
forall a b. (a -> b) -> a -> b
$ case [a]
f of
      []     -> case [a]
r of
                  a
y:[a]
_ -> (a
y, Deque a
forall a. Deque a
forall (f :: * -> *) a. Alternative f => f a
empty)
                  []  -> String -> (a, Deque a)
forall a. HasCallStack => String -> a
error String
"Control.Lens.Internal.Deque._Cons: Internal check failed"
      (a
x:[a]
xs) -> (a
x, Int -> [a] -> Int -> [a] -> Deque a
forall a. Int -> [a] -> Int -> [a] -> Deque a
check (Int
lf Int -> Int -> Int
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 = ((Deque b, b) -> Deque b)
-> (Deque a -> Either (Deque b) (Deque a, a))
-> Prism (Deque a) (Deque b) (Deque a, a) (Deque b, b)
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) -> Int -> [b] -> Int -> [b] -> Deque b
forall a. Int -> [a] -> Int -> [a] -> Deque a
check Int
lf [b]
f (Int
lr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (b
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
r)) ((Deque a -> Either (Deque b) (Deque a, a))
 -> Prism (Deque a) (Deque b) (Deque a, a) (Deque b, b))
-> (Deque a -> Either (Deque b) (Deque a, a))
-> Prism (Deque a) (Deque b) (Deque a, a) (Deque b, b)
forall a b. (a -> b) -> a -> b
$ \ (BD Int
lf [a]
f Int
lr [a]
r) ->
    if Int
lf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Deque b -> Either (Deque b) (Deque a, a)
forall a b. a -> Either a b
Left Deque b
forall a. Deque a
forall (f :: * -> *) a. Alternative f => f a
empty
    else (Deque a, a) -> Either (Deque b) (Deque a, a)
forall a b. b -> Either a b
Right ((Deque a, a) -> Either (Deque b) (Deque a, a))
-> (Deque a, a) -> Either (Deque b) (Deque a, a)
forall a b. (a -> b) -> a -> b
$ case [a]
r of
      []     -> case [a]
f of
                  a
y:[a]
_ -> (Deque a
forall a. Deque a
forall (f :: * -> *) a. Alternative f => f a
empty, a
y)
                  []  -> String -> (Deque a, a)
forall a. HasCallStack => String -> a
error String
"Control.Lens.Internal.Deque._Snoc: Internal check failed"
      (a
x:[a]
xs) -> (Int -> [a] -> Int -> [a] -> Deque a
forall a. Int -> [a] -> Int -> [a] -> Deque a
check Int
lf [a]
f (Int
lr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs, a
x)
  {-# INLINE _Snoc #-}