module Acc.NeAcc.Def
  ( NeAcc (..),
    foldM,
    prependReverseList,
    uncons,
    unconsTo,
    unsnoc,
    unsnocTo,
    appendEnumFromTo,
  )
where

import Acc.Prelude hiding (foldM)
import qualified Acc.Prelude as Prelude

-- |
-- Non-empty accumulator.
--
-- Relates to 'Acc.Acc' the same way as 'NonEmpty' to list.
data NeAcc a
  = Leaf !a
  | Branch !(NeAcc a) !(NeAcc a)
  deriving ((forall x. NeAcc a -> Rep (NeAcc a) x)
-> (forall x. Rep (NeAcc a) x -> NeAcc a) -> Generic (NeAcc a)
forall x. Rep (NeAcc a) x -> NeAcc a
forall x. NeAcc a -> Rep (NeAcc a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NeAcc a) x -> NeAcc a
forall a x. NeAcc a -> Rep (NeAcc a) x
$cto :: forall a x. Rep (NeAcc a) x -> NeAcc a
$cfrom :: forall a x. NeAcc a -> Rep (NeAcc a) x
Generic, (forall a. NeAcc a -> Rep1 NeAcc a)
-> (forall a. Rep1 NeAcc a -> NeAcc a) -> Generic1 NeAcc
forall a. Rep1 NeAcc a -> NeAcc a
forall a. NeAcc a -> Rep1 NeAcc a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 NeAcc a -> NeAcc a
$cfrom1 :: forall a. NeAcc a -> Rep1 NeAcc a
Generic1)

instance Show a => Show (NeAcc a) where
  show :: NeAcc a -> String
show =
    [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (NeAcc a -> [a]) -> NeAcc a -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NeAcc a -> [a]
forall l. IsList l => l -> [Item l]
toList

instance NFData a => NFData (NeAcc a)

instance NFData1 NeAcc

instance IsList (NeAcc a) where
  type Item (NeAcc a) = a
  {-# INLINE [0] fromList #-}
  fromList :: [Item (NeAcc a)] -> NeAcc a
fromList [Item (NeAcc a)]
list =
    case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
[Item (NeAcc a)]
list of
      a
a : [a]
b -> [a] -> NeAcc a -> NeAcc a
forall a. [a] -> NeAcc a -> NeAcc a
prependReverseList [a]
b (a -> NeAcc a
forall a. a -> NeAcc a
Leaf a
a)
      [a]
_ -> String -> NeAcc a
forall a. HasCallStack => String -> a
error String
"Empty input list"
  {-# INLINE [0] toList #-}
  toList :: NeAcc a -> [Item (NeAcc a)]
toList =
    (a -> [a] -> [a]) -> [a] -> NeAcc a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) []

deriving instance Functor NeAcc

instance Applicative NeAcc where
  pure :: a -> NeAcc a
pure =
    a -> NeAcc a
forall a. a -> NeAcc a
Leaf
  {-# INLINE [1] (<*>) #-}
  <*> :: NeAcc (a -> b) -> NeAcc a -> NeAcc b
(<*>) =
    \case
      Branch NeAcc (a -> b)
a NeAcc (a -> b)
b ->
        \NeAcc a
c ->
          NeAcc b -> NeAcc b -> NeAcc b
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch (NeAcc (a -> b)
a NeAcc (a -> b) -> NeAcc a -> NeAcc b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NeAcc a
c) (NeAcc (a -> b)
b NeAcc (a -> b) -> NeAcc a -> NeAcc b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NeAcc a
c)
      Leaf a -> b
a ->
        (a -> b) -> NeAcc a -> NeAcc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
a

instance Foldable NeAcc where
  {-# INLINEABLE [0] foldr #-}
  foldr :: (a -> b -> b) -> b -> NeAcc a -> b
  foldr :: (a -> b -> b) -> b -> NeAcc a -> b
foldr a -> b -> b
step b
acc =
    [NeAcc a] -> NeAcc a -> b
peel []
    where
      peel :: [NeAcc a] -> NeAcc a -> b
peel [NeAcc a]
layers =
        \case
          Leaf a
a ->
            a -> b -> b
step a
a ([NeAcc a] -> b
unpeel [NeAcc a]
layers)
          Branch NeAcc a
l NeAcc a
r ->
            [NeAcc a] -> NeAcc a -> b
peel (NeAcc a
r NeAcc a -> [NeAcc a] -> [NeAcc a]
forall a. a -> [a] -> [a]
: [NeAcc a]
layers) NeAcc a
l
      unpeel :: [NeAcc a] -> b
unpeel =
        \case
          NeAcc a
h : [NeAcc a]
t ->
            [NeAcc a] -> NeAcc a -> b
peel [NeAcc a]
t NeAcc a
h
          [NeAcc a]
_ ->
            b
acc

  {-# INLINE [0] foldr' #-}
  foldr' :: (a -> b -> b) -> b -> NeAcc a -> b
  foldr' :: (a -> b -> b) -> b -> NeAcc a -> b
foldr' a -> b -> b
step =
    [NeAcc a] -> b -> NeAcc a -> b
peel []
    where
      peel :: [NeAcc a] -> b -> NeAcc a -> b
peel [NeAcc a]
layers b
acc =
        \case
          Leaf a
a ->
            b -> [NeAcc a] -> b
unpeel (a -> b -> b
step a
a b
acc) [NeAcc a]
layers
          Branch NeAcc a
l NeAcc a
r ->
            [NeAcc a] -> b -> NeAcc a -> b
peel (NeAcc a
l NeAcc a -> [NeAcc a] -> [NeAcc a]
forall a. a -> [a] -> [a]
: [NeAcc a]
layers) b
acc NeAcc a
r
      unpeel :: b -> [NeAcc a] -> b
unpeel !b
acc =
        \case
          NeAcc a
h : [NeAcc a]
t ->
            [NeAcc a] -> b -> NeAcc a -> b
peel [NeAcc a]
t b
acc NeAcc a
h
          [NeAcc a]
_ ->
            b
acc

  {-# INLINE [0] foldl #-}
  foldl :: (b -> a -> b) -> b -> NeAcc a -> b
  foldl :: (b -> a -> b) -> b -> NeAcc a -> b
foldl b -> a -> b
step b
acc =
    \case
      Branch NeAcc a
a NeAcc a
b ->
        (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
forall b a. (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
foldlOnBranch b -> a -> b
step b
acc NeAcc a
a NeAcc a
b
      Leaf a
a ->
        b -> a -> b
step b
acc a
a
    where
      foldlOnBranch :: (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
      foldlOnBranch :: (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
foldlOnBranch b -> a -> b
step b
acc NeAcc a
a NeAcc a
b =
        case NeAcc a
b of
          Leaf a
c ->
            b -> a -> b
step ((b -> a -> b) -> b -> NeAcc a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
step b
acc NeAcc a
a) a
c
          Branch NeAcc a
c NeAcc a
d ->
            (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
forall b a. (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
foldlOnBranch b -> a -> b
step b
acc (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
a NeAcc a
c) NeAcc a
d

  {-# INLINE [0] foldl' #-}
  foldl' :: (b -> a -> b) -> b -> NeAcc a -> b
  foldl' :: (b -> a -> b) -> b -> NeAcc a -> b
foldl' b -> a -> b
step !b
acc =
    \case
      Branch NeAcc a
a NeAcc a
b ->
        (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
forall b a. (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
foldlOnBranch' b -> a -> b
step b
acc NeAcc a
a NeAcc a
b
      Leaf a
a ->
        b -> a -> b
step b
acc a
a
    where
      foldlOnBranch' :: (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
      foldlOnBranch' :: (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
foldlOnBranch' b -> a -> b
step b
acc NeAcc a
a NeAcc a
b =
        case NeAcc a
a of
          Leaf a
c ->
            (b -> a -> b) -> b -> NeAcc a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
step (b -> a -> b
step b
acc a
c) NeAcc a
b
          Branch NeAcc a
c NeAcc a
d ->
            (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
forall b a. (b -> a -> b) -> b -> NeAcc a -> NeAcc a -> b
foldlOnBranch' b -> a -> b
step b
acc NeAcc a
c (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
d NeAcc a
b)

  {-# INLINE [0] foldMap #-}
  foldMap :: Monoid m => (a -> m) -> NeAcc a -> m
  foldMap :: (a -> m) -> NeAcc a -> m
foldMap a -> m
map =
    NeAcc a -> m
peel
    where
      peel :: NeAcc a -> m
peel =
        \case
          Branch NeAcc a
a NeAcc a
b ->
            NeAcc a -> NeAcc a -> m
peelLeftStacking NeAcc a
b NeAcc a
a
          Leaf a
a ->
            a -> m
map a
a
      peelLeftStacking :: NeAcc a -> NeAcc a -> m
peelLeftStacking NeAcc a
buff =
        \case
          Branch NeAcc a
a NeAcc a
b ->
            NeAcc a -> NeAcc a -> m
peelLeftStacking (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
b NeAcc a
buff) NeAcc a
a
          Leaf a
a ->
            a -> m
map a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> NeAcc a -> m
peel NeAcc a
buff

  {-# INLINE [0] foldMap' #-}
  foldMap' :: Monoid m => (a -> m) -> NeAcc a -> m
  foldMap' :: (a -> m) -> NeAcc a -> m
foldMap' =
    m -> (a -> m) -> NeAcc a -> m
forall m a. Monoid m => m -> (a -> m) -> NeAcc a -> m
foldMapTo' m
forall a. Monoid a => a
mempty
    where
      foldMapTo' :: Monoid m => m -> (a -> m) -> NeAcc a -> m
      foldMapTo' :: m -> (a -> m) -> NeAcc a -> m
foldMapTo' !m
acc a -> m
map =
        \case
          Branch NeAcc a
a NeAcc a
b -> m -> (a -> m) -> NeAcc a -> NeAcc a -> m
forall m a. Monoid m => m -> (a -> m) -> NeAcc a -> NeAcc a -> m
foldMapToOnBranch' m
acc a -> m
map NeAcc a
a NeAcc a
b
          Leaf a
a -> m
acc m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
map a
a
      foldMapToOnBranch' :: Monoid m => m -> (a -> m) -> NeAcc a -> NeAcc a -> m
      foldMapToOnBranch' :: m -> (a -> m) -> NeAcc a -> NeAcc a -> m
foldMapToOnBranch' m
acc a -> m
map NeAcc a
a NeAcc a
b =
        case NeAcc a
a of
          Leaf a
c -> m -> (a -> m) -> NeAcc a -> m
forall m a. Monoid m => m -> (a -> m) -> NeAcc a -> m
foldMapTo' (m
acc m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
map a
c) a -> m
map NeAcc a
b
          Branch NeAcc a
c NeAcc a
d -> m -> (a -> m) -> NeAcc a -> NeAcc a -> m
forall m a. Monoid m => m -> (a -> m) -> NeAcc a -> NeAcc a -> m
foldMapToOnBranch' m
acc a -> m
map NeAcc a
c (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
d NeAcc a
b)

  {-# INLINE length #-}
  length :: NeAcc a -> Int
  length :: NeAcc a -> Int
length =
    \case
      Leaf a
_ -> Int
1
      Branch NeAcc a
l NeAcc a
r -> Int -> NeAcc a -> NeAcc a -> Int
forall p a. Enum p => p -> NeAcc a -> NeAcc a -> p
go Int
0 NeAcc a
l NeAcc a
r
    where
      go :: p -> NeAcc a -> NeAcc a -> p
go p
n NeAcc a
l NeAcc a
r =
        case NeAcc a
l of
          Leaf a
_ -> case p -> p
forall a. Enum a => a -> a
succ p
n of
            p
n -> case NeAcc a
r of
              Branch NeAcc a
l NeAcc a
r -> p -> NeAcc a -> NeAcc a -> p
go p
n NeAcc a
l NeAcc a
r
              Leaf a
_ -> p -> p
forall a. Enum a => a -> a
succ p
n
          Branch NeAcc a
l NeAcc a
lr -> p -> NeAcc a -> NeAcc a -> p
go p
n NeAcc a
l (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
lr NeAcc a
r)

instance Traversable NeAcc where
  {-# INLINE [0] traverse #-}
  traverse :: Applicative f => (a -> f b) -> NeAcc a -> f (NeAcc b)
  traverse :: (a -> f b) -> NeAcc a -> f (NeAcc b)
traverse a -> f b
map =
    \case
      Branch NeAcc a
a NeAcc a
b ->
        (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
traverseOnBranch a -> f b
map NeAcc a
a NeAcc a
b
      Leaf a
a ->
        b -> NeAcc b
forall a. a -> NeAcc a
Leaf (b -> NeAcc b) -> f b -> f (NeAcc b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
map a
a
    where
      traverseOnBranch :: Applicative f => (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
      traverseOnBranch :: (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
traverseOnBranch a -> f b
map NeAcc a
a NeAcc a
b =
        case NeAcc a
a of
          Leaf a
c ->
            NeAcc b -> NeAcc b -> NeAcc b
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch (NeAcc b -> NeAcc b -> NeAcc b)
-> (b -> NeAcc b) -> b -> NeAcc b -> NeAcc b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> NeAcc b
forall a. a -> NeAcc a
Leaf (b -> NeAcc b -> NeAcc b) -> f b -> f (NeAcc b -> NeAcc b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
map a
c f (NeAcc b -> NeAcc b) -> f (NeAcc b) -> f (NeAcc b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> NeAcc a -> f (NeAcc b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
map NeAcc a
b
          Branch NeAcc a
c NeAcc a
d ->
            (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
traverseOnBranch a -> f b
map NeAcc a
a (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
d NeAcc a
b)

instance Foldable1 NeAcc where
  {-# INLINE [0] fold1 #-}
  fold1 :: Semigroup m => NeAcc m -> m
  fold1 :: NeAcc m -> m
fold1 =
    \case
      Branch NeAcc m
l NeAcc m
r ->
        NeAcc m -> NeAcc m -> (m -> NeAcc m -> m) -> m
forall a b. NeAcc a -> NeAcc a -> (a -> NeAcc a -> b) -> b
rebalancingLeft NeAcc m
l NeAcc m
r ((m -> m -> m) -> m -> NeAcc m -> m
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>))
      Leaf m
a ->
        m
a

  {-# INLINE [0] foldMap1 #-}
  foldMap1 :: Semigroup m => (a -> m) -> NeAcc a -> m
  foldMap1 :: (a -> m) -> NeAcc a -> m
foldMap1 a -> m
f =
    \case
      Branch NeAcc a
l NeAcc a
r ->
        NeAcc a -> NeAcc a -> (a -> NeAcc a -> m) -> m
forall a b. NeAcc a -> NeAcc a -> (a -> NeAcc a -> b) -> b
rebalancingLeft NeAcc a
l NeAcc a
r ((m -> a -> m) -> m -> NeAcc a -> m
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\m
m a
a -> m
m m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
a) (m -> NeAcc a -> m) -> (a -> m) -> a -> NeAcc a -> m
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m
f)
      Leaf a
a ->
        a -> m
f a
a

  {-# INLINE [0] toNonEmpty #-}
  toNonEmpty :: NeAcc a -> NonEmpty a
  toNonEmpty :: NeAcc a -> NonEmpty a
toNonEmpty =
    NeAcc a -> NonEmpty a
forall a. NeAcc a -> NonEmpty a
findFirst
    where
      findFirst :: NeAcc a -> NonEmpty a
findFirst =
        \case
          Branch NeAcc a
l NeAcc a
r ->
            NeAcc a -> NeAcc a -> NonEmpty a
forall a. NeAcc a -> NeAcc a -> NonEmpty a
findFirstOnBranch NeAcc a
l NeAcc a
r
          Leaf a
a ->
            a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
      findFirstOnBranch :: NeAcc a -> NeAcc a -> NonEmpty a
findFirstOnBranch NeAcc a
l NeAcc a
r =
        case NeAcc a
l of
          Branch NeAcc a
ll NeAcc a
lr ->
            NeAcc a -> NeAcc a -> NonEmpty a
findFirstOnBranch NeAcc a
ll (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
lr NeAcc a
r)
          Leaf a
a ->
            a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| (a -> [a] -> [a]) -> [a] -> NeAcc a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] NeAcc a
r

instance Traversable1 NeAcc where
  {-# INLINE [0] traverse1 #-}
  traverse1 :: (a -> f b) -> NeAcc a -> f (NeAcc b)
traverse1 a -> f b
map =
    \case
      Branch NeAcc a
a NeAcc a
b ->
        (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
traverseOnBranch a -> f b
map NeAcc a
a NeAcc a
b
      Leaf a
a ->
        b -> NeAcc b
forall a. a -> NeAcc a
Leaf (b -> NeAcc b) -> f b -> f (NeAcc b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
map a
a
    where
      traverseOnBranch :: (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
traverseOnBranch a -> f b
map NeAcc a
a NeAcc a
b =
        case NeAcc a
a of
          Leaf a
c ->
            NeAcc b -> NeAcc b -> NeAcc b
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch (NeAcc b -> NeAcc b -> NeAcc b)
-> (b -> NeAcc b) -> b -> NeAcc b -> NeAcc b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> NeAcc b
forall a. a -> NeAcc a
Leaf (b -> NeAcc b -> NeAcc b) -> f b -> f (NeAcc b -> NeAcc b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
map a
c f (NeAcc b -> NeAcc b) -> f (NeAcc b) -> f (NeAcc b)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> f b) -> NeAcc a -> f (NeAcc b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 a -> f b
map NeAcc a
b
          Branch NeAcc a
c NeAcc a
d ->
            (a -> f b) -> NeAcc a -> NeAcc a -> f (NeAcc b)
traverseOnBranch a -> f b
map NeAcc a
a (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
d NeAcc a
b)

instance Alt NeAcc where
  {-# INLINE [1] (<!>) #-}
  <!> :: NeAcc a -> NeAcc a -> NeAcc a
(<!>) =
    NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch

instance Semigroup (NeAcc a) where
  {-# INLINE [1] (<>) #-}
  <> :: NeAcc a -> NeAcc a -> NeAcc a
(<>) =
    NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch

{-# INLINE rebalancingLeft #-}
rebalancingLeft :: NeAcc a -> NeAcc a -> (a -> NeAcc a -> b) -> b
rebalancingLeft :: NeAcc a -> NeAcc a -> (a -> NeAcc a -> b) -> b
rebalancingLeft NeAcc a
l NeAcc a
r a -> NeAcc a -> b
cont =
  case NeAcc a
l of
    Branch NeAcc a
ll NeAcc a
lr ->
      NeAcc a -> NeAcc a -> (a -> NeAcc a -> b) -> b
forall a b. NeAcc a -> NeAcc a -> (a -> NeAcc a -> b) -> b
rebalancingLeft NeAcc a
ll (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
lr NeAcc a
r) a -> NeAcc a -> b
cont
    Leaf a
a ->
      a -> NeAcc a -> b
cont a
a NeAcc a
r

foldM :: Monad m => (a -> b -> m a) -> a -> NeAcc b -> m a
foldM :: (a -> b -> m a) -> a -> NeAcc b -> m a
foldM a -> b -> m a
step !a
acc =
  \case
    Branch NeAcc b
a NeAcc b
b -> (a -> b -> m a) -> a -> NeAcc b -> NeAcc b -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> NeAcc b -> NeAcc b -> m a
foldMOnBranch a -> b -> m a
step a
acc NeAcc b
a NeAcc b
b
    Leaf b
a -> a -> b -> m a
step a
acc b
a
  where
    foldMOnBranch :: Monad m => (a -> b -> m a) -> a -> NeAcc b -> NeAcc b -> m a
    foldMOnBranch :: (a -> b -> m a) -> a -> NeAcc b -> NeAcc b -> m a
foldMOnBranch a -> b -> m a
step a
acc NeAcc b
a NeAcc b
b =
      case NeAcc b
a of
        Leaf b
c -> a -> b -> m a
step a
acc b
c m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
acc' -> (a -> b -> m a) -> a -> NeAcc b -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> NeAcc b -> m a
foldM a -> b -> m a
step a
acc' NeAcc b
b
        Branch NeAcc b
c NeAcc b
d -> (a -> b -> m a) -> a -> NeAcc b -> NeAcc b -> m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> NeAcc b -> NeAcc b -> m a
foldMOnBranch a -> b -> m a
step a
acc NeAcc b
c (NeAcc b -> NeAcc b -> NeAcc b
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc b
d NeAcc b
b)

prependReverseList :: [a] -> NeAcc a -> NeAcc a
prependReverseList :: [a] -> NeAcc a -> NeAcc a
prependReverseList [a]
list NeAcc a
tree =
  case [a]
list of
    a
head : [a]
tail -> [a] -> NeAcc a -> NeAcc a
forall a. [a] -> NeAcc a -> NeAcc a
prependReverseList [a]
tail (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch (a -> NeAcc a
forall a. a -> NeAcc a
Leaf a
head) NeAcc a
tree)
    [a]
_ -> NeAcc a
tree

{-# INLINE uncons #-}
uncons :: NeAcc a -> (a, Maybe (NeAcc a))
uncons :: NeAcc a -> (a, Maybe (NeAcc a))
uncons =
  \case
    Branch NeAcc a
l NeAcc a
r ->
      (NeAcc a -> Maybe (NeAcc a))
-> (a, NeAcc a) -> (a, Maybe (NeAcc a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NeAcc a -> Maybe (NeAcc a)
forall a. a -> Maybe a
Just (NeAcc a -> NeAcc a -> (a, NeAcc a)
forall a. NeAcc a -> NeAcc a -> (a, NeAcc a)
unconsTo NeAcc a
r NeAcc a
l)
    Leaf a
a ->
      (a
a, Maybe (NeAcc a)
forall a. Maybe a
Nothing)

{-# INLINE unconsTo #-}
unconsTo :: NeAcc a -> NeAcc a -> (a, NeAcc a)
unconsTo :: NeAcc a -> NeAcc a -> (a, NeAcc a)
unconsTo NeAcc a
buff =
  \case
    Branch NeAcc a
l NeAcc a
r ->
      NeAcc a -> NeAcc a -> (a, NeAcc a)
forall a. NeAcc a -> NeAcc a -> (a, NeAcc a)
unconsTo (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
r NeAcc a
buff) NeAcc a
l
    Leaf a
a ->
      (a
a, NeAcc a
buff)

unsnoc :: NeAcc a -> (a, Maybe (NeAcc a))
unsnoc :: NeAcc a -> (a, Maybe (NeAcc a))
unsnoc =
  \case
    Branch NeAcc a
l NeAcc a
r ->
      (NeAcc a -> Maybe (NeAcc a))
-> (a, NeAcc a) -> (a, Maybe (NeAcc a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NeAcc a -> Maybe (NeAcc a)
forall a. a -> Maybe a
Just (NeAcc a -> NeAcc a -> (a, NeAcc a)
forall a. NeAcc a -> NeAcc a -> (a, NeAcc a)
unsnocTo NeAcc a
l NeAcc a
r)
    Leaf a
a ->
      (a
a, Maybe (NeAcc a)
forall a. Maybe a
Nothing)

unsnocTo :: NeAcc a -> NeAcc a -> (a, NeAcc a)
unsnocTo :: NeAcc a -> NeAcc a -> (a, NeAcc a)
unsnocTo NeAcc a
buff =
  \case
    Branch NeAcc a
l NeAcc a
r ->
      NeAcc a -> NeAcc a -> (a, NeAcc a)
forall a. NeAcc a -> NeAcc a -> (a, NeAcc a)
unsnocTo (NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch NeAcc a
l NeAcc a
buff) NeAcc a
r
    Leaf a
a ->
      (a
a, NeAcc a
buff)

appendEnumFromTo :: (Enum a, Ord a) => a -> a -> NeAcc a -> NeAcc a
appendEnumFromTo :: a -> a -> NeAcc a -> NeAcc a
appendEnumFromTo a
from a
to =
  if a
from a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
to
    then a -> a -> NeAcc a -> NeAcc a
forall a. (Enum a, Ord a) => a -> a -> NeAcc a -> NeAcc a
appendEnumFromTo (a -> a
forall a. Enum a => a -> a
succ a
from) a
to (NeAcc a -> NeAcc a) -> (NeAcc a -> NeAcc a) -> NeAcc a -> NeAcc a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (NeAcc a -> NeAcc a -> NeAcc a) -> NeAcc a -> NeAcc a -> NeAcc a
forall a b c. (a -> b -> c) -> b -> a -> c
flip NeAcc a -> NeAcc a -> NeAcc a
forall a. NeAcc a -> NeAcc a -> NeAcc a
Branch (a -> NeAcc a
forall a. a -> NeAcc a
Leaf a
from)
    else NeAcc a -> NeAcc a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id