{-# 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
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

-- | /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 forall a. Num a => a -> a -> a
+ Int
lr 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 = 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 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 = 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 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 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
      []     -> case [a]
r of
                  a
y:[a]
_ -> (a
y, forall (f :: * -> *) a. Alternative f => f a
empty)
                  []  -> forall a. HasCallStack => String -> a
error String
"Control.Lens.Internal.Deque._Cons: Internal check failed"
      (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
      []     -> case [a]
f of
                  a
y:[a]
_ -> (forall (f :: * -> *) a. Alternative f => f a
empty, a
y)
                  []  -> forall a. HasCallStack => String -> a
error String
"Control.Lens.Internal.Deque._Snoc: Internal check failed"
      (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 #-}