content: {-# LANGUAGE GADTs #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE Safe #-}
  
  -- | Fast type-aligned queue optimized to effectful functions @(a -> m b)@
  -- (monad continuations have this type). Constant-time append and snoc and
  -- average constant-time left-edge deconstruction
  module Data.FTCQueue (
    FTCQueue,
    tsingleton,
    (|>), -- snoc
    (><), -- append
    ViewL,
    viewlMap,
    tviewl
    )
    where
  
  -- | Non-empty tree. Deconstruction operations make it more and more
  -- left-leaning.
  data FTCQueue m a b where
    Leaf :: (a -> m b) -> FTCQueue m a b
    Node :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
  
  
  -- Exported operations
  
  -- | There is no @tempty@: use (@tsingleton return@), which works just the same.
  -- The names are chosen for compatibility with FastTCQueue
  {-# INLINE tsingleton #-}
  tsingleton :: (a -> m b) -> FTCQueue m a b
  tsingleton r = Leaf r
  
  -- | snoc: clearly constant-time
  {-# INLINE (|>) #-}
  (|>) :: FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
  t |> r = Node t (Leaf r)
  
  -- | append: clearly constant-time
  {-# INLINE (><) #-}
  (><) :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
  t1 >< t2 = Node t1 t2
  
  
  -- | Left-edge deconstruction
  data ViewL m a b where
    TOne  :: (a -> m b) -> ViewL m a b
    (:|)  :: (a -> m x) -> (FTCQueue m x b) -> ViewL m a b
  
  -- | Process the Left-edge deconstruction
  {-# INLINE viewlMap #-}
  viewlMap :: ViewL m a b
           -> ((a -> m b) -> c)
           -> (forall x. (a -> m x) -> (FTCQueue m x b) -> c)
           -> c
  viewlMap view tone cons = case view of
    TOne k -> tone k
    k :| t -> cons k t
  
  {-# INLINABLE tviewl #-}
  tviewl :: FTCQueue m a b -> ViewL m a b
  tviewl (Leaf r) = TOne r
  tviewl (Node t1 t2) = go t1 t2
   where
     go :: FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
     go (Leaf r) tr = r :| tr
     go (Node tl1 tl2) tr = go tl1 (Node tl2 tr)
  