-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
-- A few simple utility functions.
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Utils
        ( -- * Simple AVL related utilities
         empty,isEmpty,isNonEmpty,singleton,pair,tryGetSingleton,

        ) where

import Data.Tree.AVL.Internals.Types (AVL(..))

-- | The empty AVL tree.
{-# INLINE empty #-}
empty :: AVL e
empty :: forall e. AVL e
empty = AVL e
forall e. AVL e
E

-- | Returns 'True' if an AVL tree is empty.
--
-- Complexity: O(1)
isEmpty :: AVL e -> Bool
isEmpty :: forall e. AVL e -> Bool
isEmpty AVL e
E = Bool
True
isEmpty AVL e
_ = Bool
False
{-# INLINE isEmpty #-}

-- | Returns 'True' if an AVL tree is non-empty.
--
-- Complexity: O(1)
isNonEmpty :: AVL e -> Bool
isNonEmpty :: forall e. AVL e -> Bool
isNonEmpty AVL e
E = Bool
False
isNonEmpty AVL e
_ = Bool
True
{-# INLINE isNonEmpty #-}

-- | Creates an AVL tree with just one element.
--
-- Complexity: O(1)
singleton :: e -> AVL e
singleton :: forall e. e -> AVL e
singleton e
e = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e AVL e
forall e. AVL e
E
{-# INLINE singleton #-}

-- | Create an AVL tree of two elements, occuring in same order as the arguments.
pair :: e -> e -> AVL e
pair :: forall e. e -> e -> AVL e
pair e
e0 e
e1 = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E) e
e1 AVL e
forall e. AVL e
E
{-# INLINE pair #-}

-- | If the AVL tree is a singleton (has only one element @e@) then this function returns @('Just' e)@.
-- Otherwise it returns Nothing.
--
-- Complexity: O(1)
tryGetSingleton :: AVL e -> Maybe e
tryGetSingleton :: forall e. AVL e -> Maybe e
tryGetSingleton (Z AVL e
E e
e AVL e
_) = e -> Maybe e
forall a. a -> Maybe a
Just e
e -- Right subtree must be E too, but no need to waste time checking
tryGetSingleton AVL e
_         = Maybe e
forall a. Maybe a
Nothing
{-# INLINE tryGetSingleton #-}