{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Monad.Freer.Par.FTCQueue (
	-- * FTCQueue
	FTCQueue ) where

import Control.Arrow ((>>>))
import Control.Monad.Freer.Par.Sequence (Sequence(..), ViewL(..))

---------------------------------------------------------------------------

data FTCQueue cat a b where
	Empty :: FTCQueue cat a a
	Node :: FTCQueue cat a b ->
		cat b c -> FTCQueue cat c d -> FTCQueue cat a d

instance Sequence FTCQueue where
	empty :: forall (cat :: * -> * -> *) a. FTCQueue cat a a
empty = forall (cat :: * -> * -> *) a. FTCQueue cat a a
Empty; singleton :: forall (cat :: * -> * -> *) a b. cat a b -> FTCQueue cat a b
singleton cat a b
x = forall (cat :: * -> * -> *) a x c d.
FTCQueue cat a x -> cat x c -> FTCQueue cat c d -> FTCQueue cat a d
Node forall (cat :: * -> * -> *) a. FTCQueue cat a a
Empty cat a b
x forall (cat :: * -> * -> *) a. FTCQueue cat a a
Empty
	>< :: forall (cat :: * -> * -> *) a b c.
FTCQueue cat a b -> FTCQueue cat b c -> FTCQueue cat a c
(><) FTCQueue cat a b
l = forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
       b.
Sequence sq =>
sq cat a b -> ViewL sq cat a b
viewl forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case ViewL FTCQueue cat b c
EmptyL -> FTCQueue cat a b
l; cat b x
x :<| FTCQueue cat x c
r -> forall (cat :: * -> * -> *) a x c d.
FTCQueue cat a x -> cat x c -> FTCQueue cat c d -> FTCQueue cat a d
Node FTCQueue cat a b
l cat b x
x FTCQueue cat x c
r
	viewl :: forall (cat :: * -> * -> *) a b.
FTCQueue cat a b -> ViewL FTCQueue cat a b
viewl = \case FTCQueue cat a b
Empty -> forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a.
ViewL sq cat a a
EmptyL; Node FTCQueue cat a b
l cat b c
x FTCQueue cat c b
r -> forall (cat :: * -> * -> *) a b c d.
FTCQueue cat a b
-> cat b c -> FTCQueue cat c d -> ViewL FTCQueue cat a d
vwl FTCQueue cat a b
l cat b c
x FTCQueue cat c b
r

vwl :: FTCQueue cat a b -> cat b c -> FTCQueue cat c d -> ViewL FTCQueue cat a d
vwl :: forall (cat :: * -> * -> *) a b c d.
FTCQueue cat a b
-> cat b c -> FTCQueue cat c d -> ViewL FTCQueue cat a d
vwl FTCQueue cat a b
Empty cat b c
x FTCQueue cat c d
r = cat b c
x forall (cat :: * -> * -> *) a x
       (sq :: (* -> * -> *) -> * -> * -> *) b.
cat a x -> sq cat x b -> ViewL sq cat a b
:<| FTCQueue cat c d
r; vwl (Node FTCQueue cat a b
ll cat b c
x FTCQueue cat c b
lr) cat b c
y FTCQueue cat c d
r = forall (cat :: * -> * -> *) a b c d.
FTCQueue cat a b
-> cat b c -> FTCQueue cat c d -> ViewL FTCQueue cat a d
vwl FTCQueue cat a b
ll cat b c
x forall a b. (a -> b) -> a -> b
$ forall (cat :: * -> * -> *) a x c d.
FTCQueue cat a x -> cat x c -> FTCQueue cat c d -> FTCQueue cat a d
Node FTCQueue cat c b
lr cat b c
y FTCQueue cat c d
r