-- |
-- Module:       Data.FTCQueue
-- Description:  Fast type-aligned queue optimized to effectful functions.
-- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
-- License:      BSD3
-- Maintainer:   Alexis King <lexi.lambda@gmail.com>
-- Stability:    experimental
-- Portability:  GHC specific language extensions.
--
-- * Constant-time append\/('><') and snoc\/('|>')
-- * Average constant-time 'viewL' (left-edge deconstruction).
--
-- Using <http://okmij.org/ftp/Haskell/extensible/FTCQueue1.hs> as a starting
-- point.
--
-- A minimal version of FTCQueue from "Reflection w/o Remorse":
--
-- * Research: <http://okmij.org/ftp/Haskell/Reflection.html>
-- * <https://hackage.haskell.org/package/type-aligned type-aligned> (FTCQueue)
module Data.FTCQueue
  ( FTCQueue
  , tsingleton
  , (|>)
  , snoc
  , (><)
  , append
  , ViewL(..)
  , 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

-- | Build a leaf from a single operation. [O(1)]
tsingleton :: (a -> m b) -> FTCQueue m a b
tsingleton :: (a -> m b) -> FTCQueue m a b
tsingleton = (a -> m b) -> FTCQueue m a b
forall a (m :: * -> *) b. (a -> m b) -> FTCQueue m a b
Leaf
{-# INLINE tsingleton #-}

-- | Append an operation to the right of the tree. [O(1)]
(|>) :: FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
FTCQueue m a x
t |> :: FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
|> x -> m b
r = FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
forall (m :: * -> *) a x b.
FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
Node FTCQueue m a x
t ((x -> m b) -> FTCQueue m x b
forall a (m :: * -> *) b. (a -> m b) -> FTCQueue m a b
Leaf x -> m b
r)
{-# INLINE (|>) #-}

-- | An alias for '(|>)'
snoc :: FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
snoc :: FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
snoc = FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
forall (m :: * -> *) a x b.
FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
(|>)
{-# INLINE snoc #-}

-- | Append two trees of operations. [O(1)]
(><)   :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
FTCQueue m a x
t1 >< :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
>< FTCQueue m x b
t2 = FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
forall (m :: * -> *) a x b.
FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
Node FTCQueue m a x
t1 FTCQueue m x b
t2
{-# INLINE (><) #-}

-- | An alias for '(><)'
append :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
append :: FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
append = FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
forall (m :: * -> *) a x b.
FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
(><)
{-# INLINE append #-}

-- | Left view deconstruction data structure.
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

-- | Left view deconstruction. [average O(1)]
tviewl :: FTCQueue m a b -> ViewL m a b
tviewl :: FTCQueue m a b -> ViewL m a b
tviewl (Leaf a -> m b
r)     = (a -> m b) -> ViewL m a b
forall a (m :: * -> *) b. (a -> m b) -> ViewL m a b
TOne a -> m b
r
tviewl (Node FTCQueue m a x
t1 FTCQueue m x b
t2) = FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
forall (m :: * -> *) a x b.
FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
go FTCQueue m a x
t1 FTCQueue m x b
t2
  where
    go :: FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
    go :: FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
go (Leaf a -> m x
r)       FTCQueue m x b
tr = a -> m x
r (a -> m x) -> FTCQueue m x b -> ViewL m a b
forall a (m :: * -> *) x b.
(a -> m x) -> FTCQueue m x b -> ViewL m a b
:| FTCQueue m x b
tr
    go (Node FTCQueue m a x
tl1 FTCQueue m x x
tl2) FTCQueue m x b
tr = FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
forall (m :: * -> *) a x b.
FTCQueue m a x -> FTCQueue m x b -> ViewL m a b
go FTCQueue m a x
tl1 (FTCQueue m x x -> FTCQueue m x b -> FTCQueue m x b
forall (m :: * -> *) a x b.
FTCQueue m a x -> FTCQueue m x b -> FTCQueue m a b
Node FTCQueue m x x
tl2 FTCQueue m x b
tr)