{-# LANGUAGE TypeFamilies #-}

module Data.Queue where

import Data.Function
import GHC.Exts

data Queue a = Q [a] [a]

emptyQ :: Queue a
emptyQ :: forall a. Queue a
emptyQ = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Q [] []
{-# INLINE emptyQ #-}

nullQ :: Queue a -> Bool
nullQ :: forall a. Queue a -> Bool
nullQ (Q [a]
fs [a]
rs) = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
fs Bool -> Bool -> Bool
&& [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
rs
{-# INLINE nullQ #-}

singletonQ :: a -> Queue a
singletonQ :: forall a. a -> Queue a
singletonQ a
x = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Q [a
x] []
{-# INLINE singletonQ #-}

headQ :: Queue a -> Maybe (a, Queue a)
headQ :: forall a. Queue a -> Maybe (a, Queue a)
headQ (Q (a
f : [a]
fs) [a]
rs) = (a, Queue a) -> Maybe (a, Queue a)
forall a. a -> Maybe a
Just (a
f, [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Q [a]
fs [a]
rs)
headQ (Q [] [a]
rs) = case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs of
  (a
r : [a]
rs') -> (a, Queue a) -> Maybe (a, Queue a)
forall a. a -> Maybe a
Just (a
r, [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Q [a]
rs' [])
  [] -> Maybe (a, Queue a)
forall a. Maybe a
Nothing
{-# INLINE headQ #-}

insertQ :: a -> Queue a -> Queue a
insertQ :: forall a. a -> Queue a -> Queue a
insertQ = (Queue a -> a -> Queue a) -> a -> Queue a -> Queue a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Queue a -> a -> Queue a
forall a. Queue a -> a -> Queue a
snocQ
{-# INLINE insertQ #-}

snocQ :: Queue a -> a -> Queue a
snocQ :: forall a. Queue a -> a -> Queue a
snocQ (Q [a]
fs [a]
rs) a
x = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Q [a]
fs (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs)
{-# INLINE snocQ #-}

consQ :: a -> Queue a -> Queue a
consQ :: forall a. a -> Queue a -> Queue a
consQ a
x (Q [a]
fs [a]
rs) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Q (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs) [a]
rs
{-# INLINE consQ #-}

(|>) :: Queue a -> a -> Queue a
|> :: forall a. Queue a -> a -> Queue a
(|>) = Queue a -> a -> Queue a
forall a. Queue a -> a -> Queue a
snocQ
{-# INLINE (|>) #-}

(<|) :: a -> Queue a -> Queue a
<| :: forall a. a -> Queue a -> Queue a
(<|) = a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
consQ
{-# INLINE (<|) #-}

instance IsList (Queue a) where
  type Item (Queue a) = a
  fromList :: [Item (Queue a)] -> Queue a
fromList [Item (Queue a)]
xs = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
Q [a]
[Item (Queue a)]
xs []
  toList :: Queue a -> [Item (Queue a)]
toList (Q [a]
fs [a]
rs) = [a]
fs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs

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]
Queue a -> [Item (Queue a)]
forall l. IsList l => l -> [Item l]
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]
Queue a -> [Item (Queue a)]
forall l. IsList l => l -> [Item l]
toList

instance (Show a) => Show (Queue a) where
  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]
Queue a -> [Item (Queue a)]
forall l. IsList l => l -> [Item l]
toList

instance Functor Queue where
  fmap :: forall a b. (a -> b) -> Queue a -> Queue b
fmap a -> b
f (Q [a]
fs [a]
rs) = [b] -> [b] -> Queue b
forall a. [a] -> [a] -> Queue a
Q ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
fs) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
rs)