-- | A queue data structure with \(\mathcal{O}(1)^*\) (amortized under ephemeral usage only) operations, as described in
--
--   * Okasaki, Chris. \"Simple and efficient purely functional queues and deques.\" /Journal of functional programming/ 5.4 (1995): 583-592.
--   * Okasaki, Chris. /Purely Functional Data Structures/. Diss. Princeton University, 1996.
module Queue.Ephemeral
  ( -- * Ephemeral queue
    EphemeralQueue (Empty, Full),

    -- ** Initialization
    empty,
    singleton,
    fromList,

    -- * Basic interface
    enqueue,
    dequeue,

    -- ** Extended interface
    enqueueFront,

    -- * Queries
    isEmpty,

    -- * Transformations
    map,
    traverse,

    -- * Conversions
    toList,
  )
where

import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Traversable qualified as Traversable
import Prelude hiding (foldMap, length, map, span, traverse)

------------------------------------------------------------------------------------------------------------------------
-- Queue type and instances

-- | A queue data structure with \(\mathcal{O}(1)^*\) (amortized under ephemeral usage only) operations.
data EphemeralQueue a
  = Q [a] [a]
  deriving stock ((forall a b. (a -> b) -> EphemeralQueue a -> EphemeralQueue b)
-> (forall a b. a -> EphemeralQueue b -> EphemeralQueue a)
-> Functor EphemeralQueue
forall a b. a -> EphemeralQueue b -> EphemeralQueue a
forall a b. (a -> b) -> EphemeralQueue a -> EphemeralQueue 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) -> EphemeralQueue a -> EphemeralQueue b
fmap :: forall a b. (a -> b) -> EphemeralQueue a -> EphemeralQueue b
$c<$ :: forall a b. a -> EphemeralQueue b -> EphemeralQueue a
<$ :: forall a b. a -> EphemeralQueue b -> EphemeralQueue a
Functor)

instance (Eq a) => Eq (EphemeralQueue a) where
  (==) :: EphemeralQueue a -> EphemeralQueue a -> Bool
  EphemeralQueue a
xs == :: EphemeralQueue a -> EphemeralQueue a -> Bool
== EphemeralQueue a
ys =
    EphemeralQueue a -> [a]
forall a. EphemeralQueue a -> [a]
Queue.Ephemeral.toList EphemeralQueue a
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== EphemeralQueue a -> [a]
forall a. EphemeralQueue a -> [a]
Queue.Ephemeral.toList EphemeralQueue a
ys

instance Foldable EphemeralQueue where
  foldMap :: (Monoid m) => (a -> m) -> EphemeralQueue a -> m
  foldMap :: forall m a. Monoid m => (a -> m) -> EphemeralQueue a -> m
foldMap a -> m
f =
    EphemeralQueue a -> m
go
    where
      go :: EphemeralQueue a -> m
go = \case
        EphemeralQueue a
Empty -> m
forall a. Monoid a => a
mempty
        Full a
x EphemeralQueue a
xs -> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> EphemeralQueue a -> m
go EphemeralQueue a
xs

  elem :: (Eq a) => a -> EphemeralQueue a -> Bool
  elem :: forall a. Eq a => a -> EphemeralQueue a -> Bool
elem a
x (Q [a]
xs [a]
ys) =
    a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem a
x [a]
xs Bool -> Bool -> Bool
|| a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem a
x [a]
ys

  null :: EphemeralQueue a -> Bool
  null :: forall a. EphemeralQueue a -> Bool
null =
    EphemeralQueue a -> Bool
forall a. EphemeralQueue a -> Bool
isEmpty

  toList :: EphemeralQueue a -> [a]
  toList :: forall a. EphemeralQueue a -> [a]
toList =
    EphemeralQueue a -> [a]
forall a. EphemeralQueue a -> [a]
Queue.Ephemeral.toList

instance Monoid (EphemeralQueue a) where
  mempty :: EphemeralQueue a
  mempty :: EphemeralQueue a
mempty =
    EphemeralQueue a
forall a. EphemeralQueue a
empty

-- | \(\mathcal{O}(n)\), where \(n\) is the size of the second argument.
instance Semigroup (EphemeralQueue a) where
  (<>) :: EphemeralQueue a -> EphemeralQueue a -> EphemeralQueue a
  Q [a]
as [a]
bs <> :: EphemeralQueue a -> EphemeralQueue a -> EphemeralQueue a
<> Q [a]
cs [a]
ds =
    [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q [a]
as ([a]
ds [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
cs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
bs)

instance (Show a) => Show (EphemeralQueue a) where
  show :: EphemeralQueue a -> String
  show :: EphemeralQueue a -> String
show =
    [a] -> String
forall a. Show a => a -> String
show ([a] -> String)
-> (EphemeralQueue a -> [a]) -> EphemeralQueue a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EphemeralQueue a -> [a]
forall a. EphemeralQueue a -> [a]
Queue.Ephemeral.toList

instance Traversable EphemeralQueue where
  traverse :: (Applicative f) => (a -> f b) -> EphemeralQueue a -> f (EphemeralQueue b)
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EphemeralQueue a -> f (EphemeralQueue b)
traverse =
    (a -> f b) -> EphemeralQueue a -> f (EphemeralQueue b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EphemeralQueue a -> f (EphemeralQueue b)
Queue.Ephemeral.traverse

------------------------------------------------------------------------------------------------------------------------
-- Patterns

-- | An empty queue.
pattern Empty :: EphemeralQueue a
pattern $mEmpty :: forall {r} {a}.
EphemeralQueue a -> ((# #) -> r) -> ((# #) -> r) -> r
Empty <- (dequeue -> Nothing)

-- | The front of a queue, and the rest of it.
pattern Full :: a -> EphemeralQueue a -> EphemeralQueue a
pattern $mFull :: forall {r} {a}.
EphemeralQueue a
-> (a -> EphemeralQueue a -> r) -> ((# #) -> r) -> r
Full x xs <- (dequeue -> Just (x, xs))

{-# COMPLETE Empty, Full #-}

------------------------------------------------------------------------------------------------------------------------
-- Initialization

-- | An empty queue.
empty :: EphemeralQueue a
empty :: forall a. EphemeralQueue a
empty =
  [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q [] []

-- | A singleton queue.
singleton :: a -> EphemeralQueue a
singleton :: forall a. a -> EphemeralQueue a
singleton a
x =
  [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q [a
x] []

-- | \(\mathcal{O}(1)\). Construct a queue from a list. The head of the list corresponds to the front of the queue.
fromList :: [a] -> EphemeralQueue a
fromList :: forall a. [a] -> EphemeralQueue a
fromList [a]
xs =
  [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q [a]
xs []

------------------------------------------------------------------------------------------------------------------------
-- Basic interface

-- | \(\mathcal{O}(1)\). Enqueue an element at the back of a queue, to be dequeued last.
enqueue :: a -> EphemeralQueue a -> EphemeralQueue a
enqueue :: forall a. a -> EphemeralQueue a -> EphemeralQueue a
enqueue a
y (Q [a]
xs [a]
ys) =
  [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q [a]
xs (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)

-- | \(\mathcal{O}(1)^*\) front, \(\mathcal{O}(1)^*\) rest. Dequeue an element from the front of a queue.
dequeue :: EphemeralQueue a -> Maybe (a, EphemeralQueue a)
dequeue :: forall a. EphemeralQueue a -> Maybe (a, EphemeralQueue a)
dequeue = \case
  Q [] [a]
ys ->
    case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys of
      [] -> Maybe (a, EphemeralQueue a)
forall a. Maybe a
Nothing
      a
x : [a]
xs -> (a, EphemeralQueue a) -> Maybe (a, EphemeralQueue a)
forall a. a -> Maybe a
Just (a
x, [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q [a]
xs [])
  Q (a
x : [a]
xs) [a]
ys -> (a, EphemeralQueue a) -> Maybe (a, EphemeralQueue a)
forall a. a -> Maybe a
Just (a
x, [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q [a]
xs [a]
ys)

------------------------------------------------------------------------------------------------------------------------
-- Extended interface

-- | \(\mathcal{O}(1)\). Enqueue an element at the front of a queue, to be dequeued next.
enqueueFront :: a -> EphemeralQueue a -> EphemeralQueue a
enqueueFront :: forall a. a -> EphemeralQueue a -> EphemeralQueue a
enqueueFront a
x (Q [a]
xs [a]
ys) =
  [a] -> [a] -> EphemeralQueue a
forall a. [a] -> [a] -> EphemeralQueue a
Q (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) [a]
ys

------------------------------------------------------------------------------------------------------------------------
-- Queries

-- | \(\mathcal{O}(1)\). Is a queue empty?
isEmpty :: EphemeralQueue a -> Bool
isEmpty :: forall a. EphemeralQueue a -> Bool
isEmpty = \case
  Q [] [] -> Bool
True
  EphemeralQueue a
_ -> Bool
False

------------------------------------------------------------------------------------------------------------------------
-- Transformations

-- | \(\mathcal{O}(n)\). Apply a function to every element in a queue.
map :: (a -> b) -> EphemeralQueue a -> EphemeralQueue b
map :: forall a b. (a -> b) -> EphemeralQueue a -> EphemeralQueue b
map =
  (a -> b) -> EphemeralQueue a -> EphemeralQueue b
forall a b. (a -> b) -> EphemeralQueue a -> EphemeralQueue b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | \(\mathcal{O}(n)\). Apply a function to every element in a queue.
traverse :: (Applicative f) => (a -> f b) -> EphemeralQueue a -> f (EphemeralQueue b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EphemeralQueue a -> f (EphemeralQueue b)
traverse a -> f b
f (Q [a]
xs [a]
ys) =
  [b] -> [b] -> EphemeralQueue b
forall a. [a] -> [a] -> EphemeralQueue a
Q
    ([b] -> [b] -> EphemeralQueue b)
-> f [b] -> f ([b] -> EphemeralQueue 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]
Traversable.traverse a -> f b
f [a]
xs
    f ([b] -> EphemeralQueue b) -> f [b] -> f (EphemeralQueue b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> f [b]
backwards [a]
ys
  where
    backwards :: [a] -> f [b]
backwards =
      [a] -> f [b]
go
      where
        go :: [a] -> f [b]
go = \case
          [] -> [b] -> f [b]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          a
z : [a]
zs -> (b -> [b] -> [b]) -> [b] -> b -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:) ([b] -> b -> [b]) -> f [b] -> f (b -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [b]
go [a]
zs f (b -> [b]) -> f b -> f [b]
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
z

------------------------------------------------------------------------------------------------------------------------
-- Conversions

-- | \(\mathcal{O}(n)\). Construct a list from a queue. The head of the list corresponds to the front of the queue.
toList :: EphemeralQueue a -> [a]
toList :: forall a. EphemeralQueue a -> [a]
toList (Q [a]
xs [a]
ys) =
  [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys