#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
module Control.Lens.Internal.Deque
( Deque(..)
, size
, fromList
, null
, singleton
) where
import Control.Applicative
import Control.Lens.Cons
import Control.Lens.Fold
import Control.Lens.Indexed hiding ((<.>))
import Control.Lens.Iso
import Control.Lens.Lens
import Control.Lens.Prism
import Control.Monad
#if MIN_VERSION_base(4,8,0)
import Data.Foldable hiding (null)
import qualified Data.Foldable as Foldable
#else
import Data.Foldable as Foldable
#endif
import Data.Function
import Data.Functor.Bind
import Data.Functor.Plus
import Data.Functor.Reverse
import Data.Traversable as Traversable
import Data.Semigroup
import Data.Profunctor.Unsafe
import Prelude hiding (null)
data Deque a = BD !Int [a] !Int [a]
deriving Show
null :: Deque a -> Bool
null (BD lf _ lr _) = lf + lr == 0
singleton :: a -> Deque a
singleton a = BD 1 [a] 0 []
size :: Deque a -> Int
size (BD lf _ lr _) = lf + lr
fromList :: [a] -> Deque a
fromList = Prelude.foldr cons empty
instance Eq a => Eq (Deque a) where
(==) = (==) `on` toList
instance Ord a => Ord (Deque a) where
compare = compare `on` toList
instance Functor Deque where
fmap h (BD lf f lr r) = BD lf (fmap h f) lr (fmap h r)
instance FunctorWithIndex Int Deque where
imap h (BD lf f lr r) = BD lf (imap h f) lr (imap (\j -> h (n j)) r)
where !n = lf + lr
instance Apply Deque where
fs <.> as = fromList (toList fs <.> toList as)
instance Applicative Deque where
pure a = BD 1 [a] 0 []
fs <*> as = fromList (toList fs <*> toList as)
instance Alt Deque where
xs <!> ys
| size xs < size ys = Foldable.foldr cons ys xs
| otherwise = Foldable.foldl snoc xs ys
instance Plus Deque where
zero = BD 0 [] 0 []
instance Alternative Deque where
empty = BD 0 [] 0 []
xs <|> ys
| size xs < size ys = Foldable.foldr cons ys xs
| otherwise = Foldable.foldl snoc xs ys
instance Reversing (Deque a) where
reversing (BD lf f lr r) = BD lr r lf f
instance Bind Deque where
ma >>- k = fromList (toList ma >>= toList . k)
instance Monad Deque where
return a = BD 1 [a] 0 []
ma >>= k = fromList (toList ma >>= toList . k)
instance MonadPlus Deque where
mzero = empty
mplus = (<|>)
instance Foldable Deque where
foldMap h (BD _ f _ r) = foldMap h f `mappend` getDual (foldMap (Dual #. h) r)
instance FoldableWithIndex Int Deque where
ifoldMap h (BD lf f lr r) = ifoldMap h f `mappend` getDual (ifoldMap (\j -> Dual #. h (n j)) r)
where !n = lf + lr
instance Traversable Deque where
traverse h (BD lf f lr r) = (BD lf ?? lr) <$> traverse h f <*> backwards traverse h r
instance TraversableWithIndex Int Deque where
itraverse h (BD lf f lr r) = (\f' r' -> BD lr f' lr (getReverse r')) <$> itraverse h f <*> itraverse (\j -> h (n j)) (Reverse r)
where !n = lf + lr
instance Semigroup (Deque a) where
xs <> ys
| size xs < size ys = Foldable.foldr cons ys xs
| otherwise = Foldable.foldl snoc xs ys
instance Monoid (Deque a) where
mempty = BD 0 [] 0 []
mappend xs ys
| size xs < size ys = Foldable.foldr cons ys xs
| otherwise = Foldable.foldl snoc xs ys
check :: Int -> [a] -> Int -> [a] -> Deque a
check lf f lr r
| lf > 3*lr + 1, i <- div (lf + lr) 2, (f',f'') <- splitAt i f = BD i f' (lf + lr i) (r ++ reverse f'')
| lr > 3*lf + 1, j <- div (lf + lr) 2, (r',r'') <- splitAt j r = BD (lf + lr j) (f ++ reverse r'') j r'
| otherwise = BD lf f lr r
instance Cons (Deque a) (Deque b) a b where
_Cons = prism (\(x,BD lf f lr r) -> check (lf + 1) (x : f) lr r) $ \ (BD lf f lr r) ->
if lf + lr == 0
then Left empty
else Right $ case f of
[] -> (head r, empty)
(x:xs) -> (x, check (lf 1) xs lr r)
instance Snoc (Deque a) (Deque b) a b where
_Snoc = prism (\(BD lf f lr r,x) -> check lf f (lr + 1) (x : r)) $ \ (BD lf f lr r) ->
if lf + lr == 0
then Left empty
else Right $ case r of
[] -> (empty, head f)
(x:xs) -> (check lf f (lr 1) xs, x)