{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types,GADTs, DataKinds, TypeOperators #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
#endif
module Data.Sequence.Queue.Internal
( Queue (..)
, P (..)
, B (..)
) where
import Control.Applicative (pure, (<*>), (<$>))
import Data.Foldable
import Data.Monoid (Monoid (..), (<>))
import Data.Traversable
import qualified Text.Read as TR
import Data.Function (on)
#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as Semigroup
import Data.Functor.Classes (Show1 (..))
#endif
import Prelude hiding (foldr,foldl)
import Data.SequenceClass
data P a = a :* a
deriving (a -> P b -> P a
(a -> b) -> P a -> P b
(forall a b. (a -> b) -> P a -> P b)
-> (forall a b. a -> P b -> P a) -> Functor P
forall a b. a -> P b -> P a
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> P b -> P a
$c<$ :: forall a b. a -> P b -> P a
fmap :: (a -> b) -> P a -> P b
$cfmap :: forall a b. (a -> b) -> P a -> P b
Functor, P a -> Bool
(a -> m) -> P a -> m
(a -> b -> b) -> b -> P a -> b
(forall m. Monoid m => P m -> m)
-> (forall m a. Monoid m => (a -> m) -> P a -> m)
-> (forall m a. Monoid m => (a -> m) -> P a -> m)
-> (forall a b. (a -> b -> b) -> b -> P a -> b)
-> (forall a b. (a -> b -> b) -> b -> P a -> b)
-> (forall b a. (b -> a -> b) -> b -> P a -> b)
-> (forall b a. (b -> a -> b) -> b -> P a -> b)
-> (forall a. (a -> a -> a) -> P a -> a)
-> (forall a. (a -> a -> a) -> P a -> a)
-> (forall a. P a -> [a])
-> (forall a. P a -> Bool)
-> (forall a. P a -> Int)
-> (forall a. Eq a => a -> P a -> Bool)
-> (forall a. Ord a => P a -> a)
-> (forall a. Ord a => P a -> a)
-> (forall a. Num a => P a -> a)
-> (forall a. Num a => P a -> a)
-> Foldable P
forall a. Eq a => a -> P a -> Bool
forall a. Num a => P a -> a
forall a. Ord a => P a -> a
forall m. Monoid m => P m -> m
forall a. P a -> Bool
forall a. P a -> Int
forall a. P a -> [a]
forall a. (a -> a -> a) -> P a -> a
forall m a. Monoid m => (a -> m) -> P a -> m
forall b a. (b -> a -> b) -> b -> P a -> b
forall a b. (a -> b -> b) -> b -> P a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: P a -> a
$cproduct :: forall a. Num a => P a -> a
sum :: P a -> a
$csum :: forall a. Num a => P a -> a
minimum :: P a -> a
$cminimum :: forall a. Ord a => P a -> a
maximum :: P a -> a
$cmaximum :: forall a. Ord a => P a -> a
elem :: a -> P a -> Bool
$celem :: forall a. Eq a => a -> P a -> Bool
length :: P a -> Int
$clength :: forall a. P a -> Int
null :: P a -> Bool
$cnull :: forall a. P a -> Bool
toList :: P a -> [a]
$ctoList :: forall a. P a -> [a]
foldl1 :: (a -> a -> a) -> P a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> P a -> a
foldr1 :: (a -> a -> a) -> P a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> P a -> a
foldl' :: (b -> a -> b) -> b -> P a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> P a -> b
foldl :: (b -> a -> b) -> b -> P a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> P a -> b
foldr' :: (a -> b -> b) -> b -> P a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> P a -> b
foldr :: (a -> b -> b) -> b -> P a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> P a -> b
foldMap' :: (a -> m) -> P a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> P a -> m
foldMap :: (a -> m) -> P a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> P a -> m
fold :: P m -> m
$cfold :: forall m. Monoid m => P m -> m
Foldable, Functor P
Foldable P
Functor P
-> Foldable P
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> P a -> f (P b))
-> (forall (f :: * -> *) a. Applicative f => P (f a) -> f (P a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> P a -> m (P b))
-> (forall (m :: * -> *) a. Monad m => P (m a) -> m (P a))
-> Traversable P
(a -> f b) -> P a -> f (P b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => P (m a) -> m (P a)
forall (f :: * -> *) a. Applicative f => P (f a) -> f (P a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> P a -> m (P b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> P a -> f (P b)
sequence :: P (m a) -> m (P a)
$csequence :: forall (m :: * -> *) a. Monad m => P (m a) -> m (P a)
mapM :: (a -> m b) -> P a -> m (P b)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> P a -> m (P b)
sequenceA :: P (f a) -> f (P a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => P (f a) -> f (P a)
traverse :: (a -> f b) -> P a -> f (P b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> P a -> f (P b)
$cp2Traversable :: Foldable P
$cp1Traversable :: Functor P
Traversable)
data B a where
B1 :: a -> B a
B2 :: !(P a) -> B a
deriving instance Functor B
deriving instance Foldable B
deriving instance Traversable B
data Queue a where
Q0 :: Queue a
Q1 :: a -> Queue a
QN :: !(B a) -> Queue (P a) -> !(B a) -> Queue a
deriving instance Functor Queue
deriving instance Foldable Queue
deriving instance Traversable Queue
#if MIN_VERSION_base(4,9,0)
instance Semigroup.Semigroup (Queue a) where
<> :: Queue a -> Queue a -> Queue a
(<>) = Queue a -> Queue a -> Queue a
forall (s :: * -> *) c. Sequence s => s c -> s c -> s c
(><)
#endif
instance Monoid (Queue a) where
mempty :: Queue a
mempty = Queue a
forall (s :: * -> *) c. Sequence s => s c
empty
#if MIN_VERSION_base(4,9,0)
mappend :: Queue a -> Queue a -> Queue a
mappend = Queue a -> Queue a -> Queue a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
#else
mappend = (><)
#endif
instance Sequence Queue where
empty :: Queue c
empty = Queue c
forall a. Queue a
Q0
singleton :: c -> Queue c
singleton = c -> Queue c
forall c. c -> Queue c
Q1
Queue c
q |> :: Queue c -> c -> Queue c
|> c
b = case Queue c
q of
Queue c
Q0 -> c -> Queue c
forall c. c -> Queue c
Q1 c
b
Q1 c
a -> B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN (c -> B c
forall a. a -> B a
B1 c
a) Queue (P c)
forall a. Queue a
Q0 (c -> B c
forall a. a -> B a
B1 c
b)
QN B c
l Queue (P c)
m (B1 c
a) -> B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN B c
l Queue (P c)
m (P c -> B c
forall a. P a -> B a
B2 (c
a c -> c -> P c
forall a. a -> a -> P a
:* c
b))
QN B c
l Queue (P c)
m (B2 P c
r) -> B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN B c
l (Queue (P c)
m Queue (P c) -> P c -> Queue (P c)
forall (s :: * -> *) c. Sequence s => s c -> c -> s c
|> P c
r) (c -> B c
forall a. a -> B a
B1 c
b)
c
a <| :: c -> Queue c -> Queue c
<| Queue c
q = case Queue c
q of
Queue c
Q0 -> c -> Queue c
forall c. c -> Queue c
Q1 c
a
Q1 c
b -> B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN (c -> B c
forall a. a -> B a
B1 c
a) Queue (P c)
forall a. Queue a
Q0 (c -> B c
forall a. a -> B a
B1 c
b)
QN (B1 c
b) Queue (P c)
m B c
r -> B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN (P c -> B c
forall a. P a -> B a
B2 (c
a c -> c -> P c
forall a. a -> a -> P a
:* c
b)) Queue (P c)
m B c
r
QN (B2 P c
l) Queue (P c)
m B c
r -> B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN (c -> B c
forall a. a -> B a
B1 c
a) (P c
l P c -> Queue (P c) -> Queue (P c)
forall (s :: * -> *) c. Sequence s => c -> s c -> s c
<| Queue (P c)
m) B c
r
>< :: Queue c -> Queue c -> Queue c
(><) = (Queue c -> c -> Queue c) -> Queue c -> Queue c -> Queue c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Queue c -> c -> Queue c
forall (s :: * -> *) c. Sequence s => s c -> c -> s c
(|>)
viewl :: Queue c -> ViewL Queue c
viewl Queue c
q0 = case Queue c
q0 of
Queue c
Q0 -> ViewL Queue c
forall (s :: * -> *) c. ViewL s c
EmptyL
Q1 c
a -> c
a c -> Queue c -> ViewL Queue c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< Queue c
forall a. Queue a
Q0
QN (B2 (c
a :* c
b)) Queue (P c)
m B c
r -> c
a c -> Queue c -> ViewL Queue c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN (c -> B c
forall a. a -> B a
B1 c
b) Queue (P c)
m B c
r
QN (B1 c
a) Queue (P c)
m B c
r -> c
a c -> Queue c -> ViewL Queue c
forall c (s :: * -> *). c -> s c -> ViewL s c
:< Queue (P c) -> B c -> Queue c
forall a. Queue (P a) -> B a -> Queue a
shiftLeft Queue (P c)
m B c
r
where
shiftLeft :: Queue (P a) -> B a -> Queue a
shiftLeft Queue (P a)
q B a
r = case Queue (P a) -> ViewL Queue (P a)
forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
viewl Queue (P a)
q of
ViewL Queue (P a)
EmptyL -> B a -> Queue a
forall a. B a -> Queue a
buf2queue B a
r
P a
l :< Queue (P a)
m -> B a -> Queue (P a) -> B a -> Queue a
forall a. B a -> Queue (P a) -> B a -> Queue a
QN (P a -> B a
forall a. P a -> B a
B2 P a
l) Queue (P a)
m B a
r
viewr :: Queue c -> ViewR Queue c
viewr Queue c
q0 = case Queue c
q0 of
Queue c
Q0 -> ViewR Queue c
forall (s :: * -> *) c. ViewR s c
EmptyR
Q1 c
a -> Queue c
forall a. Queue a
Q0 Queue c -> c -> ViewR Queue c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
a
QN B c
l Queue (P c)
m (B2 (c
a :* c
b)) -> B c -> Queue (P c) -> B c -> Queue c
forall a. B a -> Queue (P a) -> B a -> Queue a
QN B c
l Queue (P c)
m (c -> B c
forall a. a -> B a
B1 c
a) Queue c -> c -> ViewR Queue c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
b
QN B c
l Queue (P c)
m (B1 c
a) -> B c -> Queue (P c) -> Queue c
forall a. B a -> Queue (P a) -> Queue a
shiftRight B c
l Queue (P c)
m Queue c -> c -> ViewR Queue c
forall (s :: * -> *) c. s c -> c -> ViewR s c
:> c
a
where
shiftRight :: B a -> Queue (P a) -> Queue a
shiftRight B a
l Queue (P a)
q = case Queue (P a) -> ViewR Queue (P a)
forall (s :: * -> *) c. Sequence s => s c -> ViewR s c
viewr Queue (P a)
q of
ViewR Queue (P a)
EmptyR -> B a -> Queue a
forall a. B a -> Queue a
buf2queue B a
l
Queue (P a)
m :> P a
r -> B a -> Queue (P a) -> B a -> Queue a
forall a. B a -> Queue (P a) -> B a -> Queue a
QN B a
l Queue (P a)
m (P a -> B a
forall a. P a -> B a
B2 P a
r)
buf2queue :: B a -> Queue a
buf2queue :: B a -> Queue a
buf2queue (B1 a
a) = a -> Queue a
forall c. c -> Queue c
Q1 a
a
buf2queue (B2 (a
a :* a
b)) = B a -> Queue (P a) -> B a -> Queue a
forall a. B a -> Queue (P a) -> B a -> Queue a
QN (a -> B a
forall a. a -> B a
B1 a
a) Queue (P a)
forall a. Queue a
Q0 (a -> B a
forall a. a -> B a
B1 a
b)
{-# INLINE buf2queue #-}
instance Show a => Show (Queue a) where
showsPrec :: Int -> Queue a -> ShowS
showsPrec Int
p Queue a
xs = Bool -> ShowS -> ShowS
showParen (Int
p 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
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (Queue a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Queue a
xs)
#if MIN_VERSION_base(4,9,0)
instance Show1 Queue where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Queue a -> ShowS
liftShowsPrec Int -> a -> ShowS
_shwsPrc [a] -> ShowS
shwList Int
p Queue a
xs = Bool -> ShowS -> ShowS
showParen (Int
p 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
. [a] -> ShowS
shwList (Queue a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Queue a
xs)
#endif
instance Read a => Read (Queue a) where
readPrec :: ReadPrec (Queue a)
readPrec = ReadPrec (Queue a) -> ReadPrec (Queue a)
forall a. ReadPrec a -> ReadPrec a
TR.parens (ReadPrec (Queue a) -> ReadPrec (Queue a))
-> ReadPrec (Queue a) -> ReadPrec (Queue a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Queue a) -> ReadPrec (Queue a)
forall a. Int -> ReadPrec a -> ReadPrec a
TR.prec Int
10 (ReadPrec (Queue a) -> ReadPrec (Queue a))
-> ReadPrec (Queue a) -> ReadPrec (Queue a)
forall a b. (a -> b) -> a -> b
$ do
TR.Ident String
"fromList" <- ReadPrec Lexeme
TR.lexP
[a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
TR.readPrec
Queue a -> ReadPrec (Queue a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Queue a
forall (s :: * -> *) c. Sequence s => [c] -> s c
fromList [a]
xs)
readListPrec :: ReadPrec [Queue a]
readListPrec = ReadPrec [Queue a]
forall a. Read a => ReadPrec [a]
TR.readListPrecDefault
instance Eq a => Eq (Queue a) where
== :: Queue a -> Queue a -> Bool
(==) = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> Bool)
-> (Queue a -> [a]) -> Queue a -> Queue a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Queue a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Ord a => Ord (Queue a) where
compare :: Queue a -> Queue a -> Ordering
compare = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [a] -> Ordering)
-> (Queue a -> [a]) -> Queue a -> Queue a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Queue a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList