module Queue
(
Queue (Empty, Full),
empty,
singleton,
fromList,
enqueue,
dequeue,
enqueueFront,
isEmpty,
map,
traverse,
toList,
)
where
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Traversable qualified as Traversable
import GHC.Exts (Any)
import Unsafe.Coerce (unsafeCoerce)
import Prelude hiding (foldMap, length, map, span, traverse)
data Queue a
= Q
[a]
[a]
Schedule
deriving stock ((forall a b. (a -> b) -> Queue a -> Queue b)
-> (forall a b. a -> Queue b -> Queue a) -> Functor Queue
forall a b. a -> Queue b -> Queue a
forall a b. (a -> b) -> Queue a -> Queue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Queue a -> Queue b
fmap :: forall a b. (a -> b) -> Queue a -> Queue b
$c<$ :: forall a b. a -> Queue b -> Queue a
<$ :: forall a b. a -> Queue b -> Queue a
Functor)
instance (Eq a) => Eq (Queue a) where
(==) :: Queue a -> Queue a -> Bool
Queue a
xs == :: Queue a -> Queue a -> Bool
== Queue a
ys =
Queue a -> [a]
forall a. Queue a -> [a]
Queue.toList Queue a
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Queue a -> [a]
forall a. Queue a -> [a]
Queue.toList Queue a
ys
instance Foldable Queue where
foldMap :: (Monoid m) => (a -> m) -> Queue a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Queue a -> m
foldMap a -> m
f =
Queue a -> m
go
where
go :: Queue a -> m
go = \case
Queue a
Empty -> m
forall a. Monoid a => a
mempty
Full a
x Queue a
xs -> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Queue a -> m
go Queue a
xs
null :: Queue a -> Bool
null :: forall a. Queue a -> Bool
null =
Queue a -> Bool
forall a. Queue a -> Bool
isEmpty
toList :: Queue a -> [a]
toList :: forall a. Queue a -> [a]
toList =
Queue a -> [a]
forall a. Queue a -> [a]
Queue.toList
instance Monoid (Queue a) where
mempty :: Queue a
mempty :: Queue a
mempty =
Queue a
forall a. Queue a
empty
instance Semigroup (Queue a) where
(<>) :: Queue a -> Queue a -> Queue a
Queue a
xs <> :: Queue a -> Queue a -> Queue a
<> Queue a
Empty = Queue a
xs
Queue a
xs <> Full a
y Queue a
ys = a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue a
y Queue a
xs Queue a -> Queue a -> Queue a
forall a. Semigroup a => a -> a -> a
<> Queue a
ys
instance (Show a) => Show (Queue a) where
show :: Queue a -> String
show :: Queue a -> String
show =
[a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Queue a -> [a]) -> Queue a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Queue a -> [a]
forall a. Queue a -> [a]
Queue.toList
instance Traversable Queue where
traverse :: (Applicative f) => (a -> f b) -> Queue a -> f (Queue b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Queue a -> f (Queue b)
traverse =
(a -> f b) -> Queue a -> f (Queue b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Queue a -> f (Queue b)
Queue.traverse
pattern Empty :: Queue a
pattern $mEmpty :: forall {r} {a}. Queue a -> ((# #) -> r) -> ((# #) -> r) -> r
Empty <- (dequeue -> Nothing)
pattern Full :: a -> Queue a -> Queue a
pattern $mFull :: forall {r} {a}. Queue a -> (a -> Queue a -> r) -> ((# #) -> r) -> r
Full x xs <- (dequeue -> Just (x, xs))
{-# COMPLETE Empty, Full #-}
makeQueue :: [a] -> [a] -> Schedule -> Queue a
makeQueue :: forall a. [a] -> [a] -> Schedule -> Queue a
makeQueue [a]
xs [a]
ys = \case
Schedule
Z -> [a] -> Queue a
forall a. [a] -> Queue a
Queue.fromList ([a] -> [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a] -> [a]
rotate [a]
xs [a]
ys [])
S Schedule
schedule -> [a] -> [a] -> Schedule -> Queue a
forall a. [a] -> [a] -> Schedule -> Queue a
Q [a]
xs [a]
ys Schedule
schedule
rotate :: [a] -> NonEmptyList a -> [a] -> [a]
rotate :: forall a. [a] -> [a] -> [a] -> [a]
rotate [] (a
y :| [a]
_) [a]
zs = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
zs
rotate (a
x : [a]
xs) (a
y :| [a]
ys) [a]
zs = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a] -> [a]
rotate [a]
xs [a]
ys (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
zs)
empty :: Queue a
empty :: forall a. Queue a
empty =
[a] -> [a] -> Schedule -> Queue a
forall a. [a] -> [a] -> Schedule -> Queue a
Q [] [] Schedule
Z
singleton :: a -> Queue a
singleton :: forall a. a -> Queue a
singleton a
x =
[a] -> Queue a
forall a. [a] -> Queue a
Queue.fromList [a
x]
fromList :: [a] -> Queue a
fromList :: forall a. [a] -> Queue a
fromList [a]
xs =
[a] -> [a] -> Schedule -> Queue a
forall a. [a] -> [a] -> Schedule -> Queue a
Q [a]
xs [] ([a] -> Schedule
forall a b. a -> b
unsafeCoerce [a]
xs)
enqueue :: a -> Queue a -> Queue a
enqueue :: forall a. a -> Queue a -> Queue a
enqueue a
y (Q [a]
xs [a]
ys Schedule
schedule) =
[a] -> [a] -> Schedule -> Queue a
forall a. [a] -> [a] -> Schedule -> Queue a
makeQueue [a]
xs (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys) Schedule
schedule
dequeue :: Queue a -> Maybe (a, Queue a)
dequeue :: forall a. Queue a -> Maybe (a, Queue a)
dequeue = \case
Q [] [a]
_ Schedule
_ -> Maybe (a, Queue a)
forall a. Maybe a
Nothing
Q (a
x : [a]
xs) [a]
ys Schedule
schedule -> (a, Queue a) -> Maybe (a, Queue a)
forall a. a -> Maybe a
Just (a
x, [a] -> [a] -> Schedule -> Queue a
forall a. [a] -> [a] -> Schedule -> Queue a
makeQueue [a]
xs [a]
ys Schedule
schedule)
enqueueFront :: a -> Queue a -> Queue a
enqueueFront :: forall a. a -> Queue a -> Queue a
enqueueFront a
x (Q [a]
xs [a]
ys Schedule
schedule) =
[a] -> [a] -> Schedule -> Queue a
forall a. [a] -> [a] -> Schedule -> Queue a
Q (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) [a]
ys (a -> Any
forall a b. a -> b
unsafeCoerce a
x Any -> Schedule -> Schedule
forall a. a -> [a] -> [a]
: Schedule
schedule)
isEmpty :: Queue a -> Bool
isEmpty :: forall a. Queue a -> Bool
isEmpty = \case
Q [] [a]
_ Schedule
_ -> Bool
True
Queue a
_ -> Bool
False
map :: (a -> b) -> Queue a -> Queue b
map :: forall a b. (a -> b) -> Queue a -> Queue b
map =
(a -> b) -> Queue a -> Queue b
forall a b. (a -> b) -> Queue a -> Queue b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
traverse :: (Applicative f) => (a -> f b) -> Queue a -> f (Queue b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Queue a -> f (Queue b)
traverse a -> f b
f =
([b] -> Queue b) -> f [b] -> f (Queue b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> Queue b
forall a. [a] -> Queue a
fromList (f [b] -> f (Queue b))
-> (Queue a -> f [b]) -> Queue a -> f (Queue b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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]
Traversable.traverse a -> f b
f ([a] -> f [b]) -> (Queue a -> [a]) -> Queue a -> f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Queue a -> [a]
forall a. Queue a -> [a]
toList
toList :: Queue a -> [a]
toList :: forall a. Queue a -> [a]
toList =
(Queue a -> Maybe (a, Queue a)) -> Queue a -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr Queue a -> Maybe (a, Queue a)
forall a. Queue a -> Maybe (a, Queue a)
dequeue
type Schedule =
[Any]
pattern Z :: Schedule
pattern $mZ :: forall {r}. Schedule -> ((# #) -> r) -> ((# #) -> r) -> r
$bZ :: Schedule
Z = []
pattern S :: Schedule -> Schedule
pattern $mS :: forall {r}. Schedule -> (Schedule -> r) -> ((# #) -> r) -> r
S xs <- _ : xs
{-# COMPLETE Z, S #-}
type NonEmptyList a =
[a]
pattern (:|) :: a -> [a] -> NonEmptyList a
pattern $m:| :: forall {r} {a}.
NonEmptyList a -> (a -> NonEmptyList a -> r) -> ((# #) -> r) -> r
$b:| :: forall a. a -> [a] -> [a]
(:|) x xs = x : xs
{-# COMPLETE (:|) #-}