{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, Arrows, TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Math.Tools.Queue where
 import qualified Prelude as P
 import Prelude hiding (unzip,zip,zipWith,reverse,(.),id)
 import qualified Control.Monad as Monad
 import Control.Monad (ap)
 import qualified Data.List as L
 import Control.Category
 import Control.Arrow
 import Control.Applicative
 import Data.IORef
 import Data.Monoid
 import Math.Tools.Arrow
 import Math.Tools.Functor
 import Math.Tools.CoFunctor
 import qualified Math.Tools.List as LL
 import Math.Tools.Visitor
 import qualified Text.PrettyPrint as Pretty
 import qualified Math.Tools.PrettyP as PP
 import Math.Tools.PrettyP hiding (empty)
 import Math.Tools.Nondeterministic
 import Math.Matrix.Interface hiding (fromList)

 -- | a queue is really a list with a missing element which is the focus of
 -- the current operations.
 -- This idea comes from zipper pattern. <http://www.haskell.org/haskellwiki/Zipper>

 data Queue a = MakeQueue { forall a. Queue a -> [a]
queue_newest_first_prefix  :: ![a],
                            forall a. Queue a -> [a]
queue_oldest_first_postfix :: ![a] }

 -- | This version of queue is not a comonad, since empty queue is possible.
 instance (Num a) => VectorSpace (Queue a) where
   type Scalar (Queue a) = a
   vzero :: Queue a
vzero = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [] []
   vnegate :: Queue a -> Queue a
vnegate (MakeQueue [a]
lst [a]
lst') = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a. Num a => a -> a
negate [a]
lst) ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall a. Num a => a -> a
negate [a]
lst')
   Scalar (Queue a)
v %* :: Scalar (Queue a) -> Queue a -> Queue a
%* (MakeQueue [a]
lst [a]
lst') = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
Scalar (Queue a)
va -> a -> a
forall a. Num a => a -> a -> a
*) [a]
lst) ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
Scalar (Queue a)
va -> a -> a
forall a. Num a => a -> a -> a
*) [a]
lst')
   Queue a
q %+ :: Queue a -> Queue a -> Queue a
%+ Queue a
q' = Queue a
q Queue a -> Queue a -> Queue a
forall a. Queue a -> Queue a -> Queue a
`append` Queue a
q'

 newQueueM :: IO (IORef (Queue a))
 newQueueM :: forall a. IO (IORef (Queue a))
newQueueM = Queue a -> IO (IORef (Queue a))
forall a. a -> IO (IORef a)
newIORef Queue a
forall a. Queue a
forall (f :: * -> *) a. Alternative f => f a
empty

 enqueueM :: IORef (Queue a) -> a -> IO ()
 enqueueM :: forall a. IORef (Queue a) -> a -> IO ()
enqueueM IORef (Queue a)
ref a
x = IORef (Queue a) -> (Queue a -> Queue a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Queue a)
ref (a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue a
x)

 dequeueM :: IORef (Queue a) -> IO a
 dequeueM :: forall a. IORef (Queue a) -> IO a
dequeueM IORef (Queue a)
ref = do Queue a
q <- IORef (Queue a) -> IO (Queue a)
forall a. IORef a -> IO a
readIORef IORef (Queue a)
ref
                   (a
x,Queue a
q') <- Queue a -> IO (a, Queue a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue Queue a
q                   
                   IORef (Queue a) -> Queue a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Queue a)
ref Queue a
q'
                   a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

 split_list :: [a] -> Int -> (a,Queue a)
 split_list :: forall a. [a] -> Int -> (a, Queue a)
split_list [a]
lst Int
i = ([a]
lst [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i, [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i [a]
lst) ([a] -> [a]
forall a. [a] -> [a]
L.reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
lst))

 join_list :: a -> Queue a -> [a]
 join_list :: forall a. a -> Queue a -> [a]
join_list a
x (MakeQueue [a]
pre [a]
post) = [a]
pre [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
post)

 instance Functor Queue where
    fmap :: forall a b. (a -> b) -> Queue a -> Queue b
fmap a -> b
f (MakeQueue [a]
x [a]
y) = [b] -> [b] -> Queue b
forall a. [a] -> [a] -> Queue a
MakeQueue ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
x)  ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
y)

 instance Monad Queue where
    Queue a
q >>= :: forall a b. Queue a -> (a -> Queue b) -> Queue b
>>= a -> Queue b
f = Queue (Queue b) -> Queue b
forall a. Queue (Queue a) -> Queue a
join' (Queue (Queue b) -> Queue b) -> Queue (Queue b) -> Queue b
forall a b. (a -> b) -> a -> b
$ (a -> Queue b) -> Queue a -> Queue (Queue b)
forall a b. (a -> b) -> Queue a -> Queue b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Queue b
f Queue a
q

 instance MonadFail Queue where
    fail :: forall a. String -> Queue a
fail String
_ = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [] []

 instance Nondeterministic Queue where
    guess :: forall a. [a] -> Queue a
guess = [a] -> Queue a
forall a. [a] -> Queue a
fromList

 instance Applicative Queue where
    pure :: forall a. a -> Queue a
pure a
x = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a
x] []
    <*> :: forall a b. Queue (a -> b) -> Queue a -> Queue b
(<*>) = Queue (a -> b) -> Queue a -> Queue b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

 instance Alternative Queue where
    empty :: forall a. Queue a
empty = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [] []
    <|> :: forall a. Queue a -> Queue a -> Queue a
(<|>) = Queue a -> Queue a -> Queue a
forall a. Queue a -> Queue a -> Queue a
append

 isEmpty :: Queue a -> Bool
 isEmpty :: forall a. Queue a -> Bool
isEmpty (MakeQueue [] []) = Bool
True
 isEmpty Queue a
_ = Bool
False

 instance Visitor (Queue a) where
    data Fold (Queue a) b = QueueFold b (a -> b -> b)
    visit :: forall a. Fold (Queue a) a -> Queue a -> a
visit z :: Fold (Queue a) a
z@(QueueFold a
x a -> a -> a
f) Queue a
q = a -> ((Queue a, a) -> a) -> Maybe (Queue a, a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (Queue a, a) -> a
p (Queue a -> Maybe (Queue a, a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (Queue a, a)
dequeue_back Queue a
q)
        where p :: (Queue a, a) -> a
p ~(Queue a
b,a
a) = a -> a -> a
f a
a (Fold (Queue a) a -> Queue a -> a
forall v a. Visitor v => Fold v a -> v -> a
forall a. Fold (Queue a) a -> Queue a -> a
visit Fold (Queue a) a
z Queue a
b)

 instance (PpShow a) => Show (Queue a) where
    show :: Queue a -> String
show = Queue a -> String
forall a. PpShow a => a -> String
pPrint

 instance (PpShow a) => PpShow (Queue a) where
    pp :: Queue a -> Doc
pp (MakeQueue [a]
x [a]
y) = Doc
"queue{" 
         Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
Pretty.cat (Doc -> [Doc] -> [Doc]
Pretty.punctuate (Char -> Doc
forall a. PpShow a => a -> Doc
pp Char
',') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. PpShow a => a -> Doc
pp [a]
x)
         Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x then Doc
Pretty.empty else Char -> Doc
forall a. PpShow a => a -> Doc
pp Char
',')
         Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"!"
         Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
y then Doc
Pretty.empty else Char -> Doc
forall a. PpShow a => a -> Doc
pp Char
',')
         Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
Pretty.cat (Doc -> [Doc] -> [Doc]
Pretty.punctuate (Char -> Doc
forall a. PpShow a => a -> Doc
pp Char
',') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. PpShow a => a -> Doc
pp ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
y))
         Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
forall a. PpShow a => a -> Doc
pp Char
'}'                 

  -- cat (punctuate (pp ',') $ map pp (x ++ L.reverse y)) <> pp '}'

 instance (ArrowChoice ar) => FunctorArrow Queue ar ar where
    amap :: forall c d. ar c d -> ar (Queue c) (Queue d)
amap ar c d
f = proc (MakeQueue [c]
x [c]
y) -> do
                [d]
x' <- ar c d -> ar [c] [d]
forall c d. ar c d -> ar [c] [d]
forall {k} {k1} (f :: k -> k1) (arr :: k -> k -> *)
       (arr' :: k1 -> k1 -> *) (c :: k) (d :: k).
FunctorArrow f arr arr' =>
arr c d -> arr' (f c) (f d)
amap ar c d
f -< [c]
x
                [d]
y' <- ar c d -> ar [c] [d]
forall c d. ar c d -> ar [c] [d]
forall {k} {k1} (f :: k -> k1) (arr :: k -> k -> *)
       (arr' :: k1 -> k1 -> *) (c :: k) (d :: k).
FunctorArrow f arr arr' =>
arr c d -> arr' (f c) (f d)
amap ar c d
f -< [c]
y
                ar (Queue d) (Queue d)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< [d] -> [d] -> Queue d
forall a. [a] -> [a] -> Queue a
MakeQueue [d]
x' [d]
y'

 -- | join works in round-robin fashion. Note if all inner queues are empty,
 -- this goes to infinite loop trying to find elements from empty queues.
 join :: Queue (Queue a) -> Queue a
 join :: forall a. Queue (Queue a) -> Queue a
join = Fold (Queue (Queue a)) (Queue a) -> Queue (Queue a) -> Queue a
forall v a. Visitor v => Fold v a -> v -> a
forall a. Fold (Queue (Queue a)) a -> Queue (Queue a) -> a
visit (Queue a
-> (Queue a -> Queue a -> Queue a)
-> Fold (Queue (Queue a)) (Queue a)
forall a b. b -> (a -> b -> b) -> Fold (Queue a) b
QueueFold Queue a
forall a. Queue a
forall (f :: * -> *) a. Alternative f => f a
empty Queue a -> Queue a -> Queue a
forall a. Queue a -> Queue a -> Queue a
forall (f :: * -> *) a. InterleaveFunctor f => f a -> f a -> f a
interleave)

 -- | Alternative implementation of join, works in reverse compared to join.

 join' :: Queue (Queue a) -> Queue a
 join' :: forall a. Queue (Queue a) -> Queue a
join' Queue (Queue a)
q = Queue a
-> ((Queue a, Queue (Queue a)) -> Queue a)
-> Maybe (Queue a, Queue (Queue a))
-> Queue a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Queue a
forall a. Queue a
forall (f :: * -> *) a. Alternative f => f a
empty (Queue a, Queue (Queue a)) -> Queue a
forall {a}. (Queue a, Queue (Queue a)) -> Queue a
f (Queue (Queue a) -> Maybe (Queue a, Queue (Queue a))
forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue Queue (Queue a)
q)
    where f :: (Queue a, Queue (Queue a)) -> Queue a
f ~(Queue a
q',Queue (Queue a)
r) = Queue a
-> ((a, Queue a) -> Queue a) -> Maybe (a, Queue a) -> Queue a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Queue (Queue a) -> Queue a
forall a. Queue (Queue a) -> Queue a
join' Queue (Queue a)
r) (Queue (Queue a) -> (a, Queue a) -> Queue a
forall {a}. Queue (Queue a) -> (a, Queue a) -> Queue a
g Queue (Queue a)
r) (Queue a -> Maybe (a, Queue a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue Queue a
q')
          g :: Queue (Queue a) -> (a, Queue a) -> Queue a
g Queue (Queue a)
r ~(a
v,Queue a
q'') = a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue a
v (Queue (Queue a) -> Queue a
forall a. Queue (Queue a) -> Queue a
join' (Queue a -> Queue (Queue a) -> Queue (Queue a)
forall a. a -> Queue a -> Queue a
enqueue Queue a
q'' Queue (Queue a)
r))

 fold :: (Arrow arr) => (a -> arr b b) -> Queue a -> arr b b
 fold :: forall (arr :: * -> * -> *) a b.
Arrow arr =>
(a -> arr b b) -> Queue a -> arr b b
fold a -> arr b b
f (MakeQueue [a]
x [a]
y) = (a -> arr b b -> arr b b) -> arr b b -> [a] -> arr b b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
xx arr b b
r -> a -> arr b b
f a
xx arr b b -> arr b b -> arr b b
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> arr b b
r) arr b b
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA ([a]
y [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
x)

 instance InterleaveFunctor Queue where
   interleave :: forall a. Queue a -> Queue a -> Queue a
interleave = Queue a -> Queue a -> Queue a
forall a. Queue a -> Queue a -> Queue a
interleave_queue

 interleave_queue :: Queue a -> Queue a -> Queue a
 interleave_queue :: forall a. Queue a -> Queue a -> Queue a
interleave_queue (MakeQueue [a]
a [a]
b) (MakeQueue [a]
c [a]
d) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
forall (f :: * -> *) a. InterleaveFunctor f => f a -> f a -> f a
interleave [a]
a [a]
c)
                                                        ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
forall (f :: * -> *) a. InterleaveFunctor f => f a -> f a -> f a
interleave [a]
b [a]
d)

  -- empty comes from Alternative

 singleton :: a -> Queue a
 singleton :: forall a. a -> Queue a
singleton a
x = a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue a
x Queue a
forall a. Queue a
forall (f :: * -> *) a. Alternative f => f a
empty

 enqueue :: a -> Queue a -> Queue a
 enqueue :: forall a. a -> Queue a -> Queue a
enqueue a
x (MakeQueue [a]
a [a]
b) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a) [a]
b 

 enqueue_back :: a -> Queue a -> Queue a
 enqueue_back :: forall a. a -> Queue a -> Queue a
enqueue_back a
x (MakeQueue [a]
a [a]
b) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
a (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
b) 

 dequeue :: (MonadFail m) => Queue a -> m (a,Queue a)
 dequeue :: forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue (MakeQueue [] []) = String -> m (a, Queue a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot dequeue from an empty queue"
 dequeue (MakeQueue [a]
x (a
x':[a]
r')) = (a, Queue a) -> m (a, Queue a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x',[a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
x [a]
r')
 dequeue (MakeQueue [a]
x []) = Queue a -> m (a, Queue a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue ([a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [] ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
x))

 dequeue_back :: (MonadFail m) => Queue a -> m (Queue a,a)
 dequeue_back :: forall (m :: * -> *) a. MonadFail m => Queue a -> m (Queue a, a)
dequeue_back (MakeQueue [] []) = String -> m (Queue a, a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot dequeue_back an empty queue"
 dequeue_back (MakeQueue (a
x:[a]
xr) [a]
r) = (Queue a, a) -> m (Queue a, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
xr [a]
r,a
x)
 dequeue_back (MakeQueue [] [a]
r) = Queue a -> m (Queue a, a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (Queue a, a)
dequeue_back (Queue a -> m (Queue a, a)) -> Queue a -> m (Queue a, a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
r) []

 dequeue_rotate :: (MonadFail m) => Queue a -> m (a,Queue a)
 dequeue_rotate :: forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue_rotate Queue a
q = do { (a
x,Queue a
q') <- Queue a -> m (a, Queue a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue Queue a
q ; (a, Queue a) -> m (a, Queue a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue a
x Queue a
q') }

 dequeue_rotate_back :: (MonadFail m) => Queue a -> m (Queue a,a)
 dequeue_rotate_back :: forall (m :: * -> *) a. MonadFail m => Queue a -> m (Queue a, a)
dequeue_rotate_back Queue a
q = do (Queue a
q',a
x) <- Queue a -> m (Queue a, a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (Queue a, a)
dequeue_back Queue a
q
                            (Queue a, a) -> m (Queue a, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue_back a
x Queue a
q',a
x)

 rotate :: Queue a -> Queue a
 rotate :: forall a. Queue a -> Queue a
rotate Queue a
q = Queue a
-> ((a, Queue a) -> Queue a) -> Maybe (a, Queue a) -> Queue a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Queue a
q ((a -> Queue a -> Queue a) -> (a, Queue a) -> Queue a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue) (Queue a -> Maybe (a, Queue a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue Queue a
q)

 rotate_back :: Queue a -> Queue a
 rotate_back :: forall a. Queue a -> Queue a
rotate_back Queue a
q = Queue a
-> ((Queue a, a) -> Queue a) -> Maybe (Queue a, a) -> Queue a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Queue a
q ((a -> Queue a -> Queue a) -> (a, Queue a) -> Queue a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Queue a -> Queue a
forall a. a -> Queue a -> Queue a
enqueue_back ((a, Queue a) -> Queue a)
-> ((Queue a, a) -> (a, Queue a)) -> (Queue a, a) -> Queue a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Queue a, a) -> (a, Queue a)
forall {b} {a}. (b, a) -> (a, b)
swap) (Queue a -> Maybe (Queue a, a)
forall (m :: * -> *) a. MonadFail m => Queue a -> m (Queue a, a)
dequeue_back Queue a
q)
    where swap :: (b, a) -> (a, b)
swap (b
x,a
y) = (a
y,b
x)

 reduce :: Queue a -> Queue a
 reduce :: forall a. Queue a -> Queue a
reduce (MakeQueue [a]
x [a]
y) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [] ([a]
y [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
x)

 unreduce :: Queue a -> Queue a
 unreduce :: forall a. Queue a -> Queue a
unreduce (MakeQueue [a]
x [a]
y) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ([a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
y) []

 fromList :: [a] -> Queue a
 fromList :: forall a. [a] -> Queue a
fromList [a]
lst = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
lst []

 toList :: Queue a -> [a]
 toList :: forall a. Queue a -> [a]
toList (MakeQueue [a]
x [a]
y) = [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
y

 unzip :: Queue (a,b) -> (Queue a, Queue b)
 unzip :: forall a b. Queue (a, b) -> (Queue a, Queue b)
unzip (MakeQueue [(a, b)]
x [(a, b)]
y) = let ([a]
x',[b]
x'') = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
P.unzip [(a, b)]
x
                             ([a]
y',[b]
y'') = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
P.unzip [(a, b)]
y
                          in ([a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
x' [a]
y', [b] -> [b] -> Queue b
forall a. [a] -> [a] -> Queue a
MakeQueue [b]
x'' [b]
y'')

 zip :: Queue a -> Queue b -> Queue (a,b)
 zip :: forall a b. Queue a -> Queue b -> Queue (a, b)
zip Queue a
q1 Queue b
q2 = let MakeQueue [a]
_ [a]
q1' = Queue a -> Queue a
forall a. Queue a -> Queue a
reduce Queue a
q1
                 MakeQueue [b]
_ [b]
q2' = Queue b -> Queue b
forall a. Queue a -> Queue a
reduce Queue b
q2
              in [(a, b)] -> [(a, b)] -> Queue (a, b)
forall a. [a] -> [a] -> Queue a
MakeQueue [] ([a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
P.zip [a]
q1' [b]
q2')

 partitionEither :: Queue (Either a b) -> (Queue a, Queue b)
 partitionEither :: forall a b. Queue (Either a b) -> (Queue a, Queue b)
partitionEither (MakeQueue [Either a b]
x [Either a b]
y) = let ([Either a b]
x',[Either a b]
x'') = (Either a b -> Bool)
-> [Either a b] -> ([Either a b], [Either a b])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Either a b -> Bool
forall {a} {b}. Either a b -> Bool
isLeft [Either a b]
x
                                       ([Either a b]
y',[Either a b]
y'') = (Either a b -> Bool)
-> [Either a b] -> ([Either a b], [Either a b])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Either a b -> Bool
forall {a} {b}. Either a b -> Bool
isLeft [Either a b]
y
                                       isLeft :: Either a b -> Bool
isLeft (Left a
_) = Bool
True
                                       isLeft Either a b
_        = Bool
False
                                       fromLeft :: Either a b -> a
fromLeft (Left a
xx) = a
xx
                                       fromLeft Either a b
_ = a
forall a. HasCallStack => a
undefined
                                       fromRight :: Either a b -> b
fromRight (Right b
yy) = b
yy
                                       fromRight Either a b
_ = b
forall a. HasCallStack => a
undefined
                                     in ([a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ((Either a b -> a) -> [Either a b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Either a b -> a
forall {a} {b}. Either a b -> a
fromLeft [Either a b]
x')
                                                   ((Either a b -> a) -> [Either a b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Either a b -> a
forall {a} {b}. Either a b -> a
fromLeft [Either a b]
y'), 
                                         [b] -> [b] -> Queue b
forall a. [a] -> [a] -> Queue a
MakeQueue ((Either a b -> b) -> [Either a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Either a b -> b
forall {a} {b}. Either a b -> b
fromRight [Either a b]
x'')
                                                   ((Either a b -> b) -> [Either a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Either a b -> b
forall {a} {b}. Either a b -> b
fromRight [Either a b]
y''))

 append :: Queue a -> Queue a -> Queue a
 append :: forall a. Queue a -> Queue a -> Queue a
append (MakeQueue [a]
x [a]
x') (MakeQueue [a]
y [a]
y') = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ([a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
x')
                                                      ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
y [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y')

 dequeue_current :: (MonadFail m) => Queue a -> m (a,Queue a)
 dequeue_current :: forall (m :: * -> *) a. MonadFail m => Queue a -> m (a, Queue a)
dequeue_current (MakeQueue [a]
x (a
c:[a]
cr)) = (a, Queue a) -> m (a, Queue a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
c,[a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
x [a]
cr)
 dequeue_current (MakeQueue [a]
x []) = String -> m (a, Queue a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"At end of queue"

 replace_current :: a -> Queue a -> Queue a
 replace_current :: forall a. a -> Queue a -> Queue a
replace_current a
x (MakeQueue [a]
r (a
_:[a]
cr)) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
r (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cr)
 replace_current a
x (MakeQueue [a]
r []) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
r [a
x]

 forward :: a -> Queue a -> Queue a
 forward :: forall a. a -> Queue a -> Queue a
forward a
_ (MakeQueue [a]
r (a
c:[a]
cr)) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r) [a]
cr
 forward a
x (MakeQueue [a]
r []) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r) []

 backward :: a -> Queue a -> Queue a
 backward :: forall a. a -> Queue a -> Queue a
backward a
_ (MakeQueue (a
c:[a]
cr) [a]
r) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
cr (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)
 backward a
x (MakeQueue [] [a]
r) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [] (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)


 reverse :: Queue a -> Queue a
 reverse :: forall a. Queue a -> Queue a
reverse (MakeQueue [a]
x [a]
y) = [a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
y) ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
x)

 sequence :: (Monad m) => Queue (m a) -> m (Queue a)
 sequence :: forall (m :: * -> *) a. Monad m => Queue (m a) -> m (Queue a)
sequence (MakeQueue [m a]
f [m a]
g) = do [a]
fr <- [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
Monad.sequence [m a]
f
                               [a]
gr <- [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
Monad.sequence [m a]
g                               
                               Queue a -> m (Queue a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a] -> Queue a
forall a. [a] -> [a] -> Queue a
MakeQueue [a]
fr [a]
gr)

 mapM :: (Monad m) => (a -> m b) -> Queue a -> m (Queue b)
 mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Queue a -> m (Queue b)
mapM a -> m b
f (MakeQueue [a]
a [a]
b) = do [b]
a' <- (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Monad.mapM a -> m b
f [a]
a
                             [b]
b' <- (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Monad.mapM a -> m b
f [a]
b                             
                             Queue b -> m (Queue b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> [b] -> Queue b
forall a. [a] -> [a] -> Queue a
MakeQueue [b]
a' [b]
b')