{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_HADDOCK ignore-exports #-}

-- |
-- Module      : Data.Tree.BST.Unsafe
-- Description : Unsafe BST trees
-- Copyright   : (c) Nicolás Rodríguez, 2021
-- License     : GPL-3
-- Maintainer  : Nicolás Rodríguez
-- Stability   : experimental
-- Portability : POSIX
--
-- Implementation of unsafe BST trees. These trees have no type level
-- information useful for compile time verification of invariants.
module Data.Tree.BST.Unsafe
  ( emptyBST,
    insertBST,
    lookupBST,
    deleteBST,
  )
where

import Data.Kind (Type)
import Prelude
  ( Int,
    Maybe (Just, Nothing),
    Ordering (EQ, GT, LT),
    Show,
    compare,
  )

-- | Nodes for unsafe `BST` trees. They only hold information
-- at the value level: some value of type @a@ and a key
-- of type `Int`.
data Node :: Type -> Type where
  Node :: Show a => Int -> a -> Node a

deriving stock instance Show (Node a)

-- | Constructor of unsafe `BST` trees.
data BST :: Type -> Type where
  E :: BST a
  F :: BST a -> Node a -> BST a -> BST a
  deriving stock (Int -> BST a -> ShowS
[BST a] -> ShowS
BST a -> String
(Int -> BST a -> ShowS)
-> (BST a -> String) -> ([BST a] -> ShowS) -> Show (BST a)
forall a. Int -> BST a -> ShowS
forall a. [BST a] -> ShowS
forall a. BST a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BST a] -> ShowS
$cshowList :: forall a. [BST a] -> ShowS
show :: BST a -> String
$cshow :: forall a. BST a -> String
showsPrec :: Int -> BST a -> ShowS
$cshowsPrec :: forall a. Int -> BST a -> ShowS
Show)

-- | Empty `BST` tree.
emptyBST :: BST a
emptyBST :: forall a. BST a
emptyBST = BST a
forall a. BST a
E

-- | Entry point for inserting a new key and value.
-- If the key is already present in the tree, update the value.
insertBST :: Show a => Int -> a -> BST a -> BST a
insertBST :: forall a. Show a => Int -> a -> BST a -> BST a
insertBST Int
x a
v BST a
E = BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
forall a. BST a
E (Int -> a -> Node a
forall a. Show a => Int -> a -> Node a
Node Int
x a
v) BST a
forall a. BST a
E
insertBST Int
x' a
v' t :: BST a
t@(F BST a
_ (Node Int
x a
_) BST a
_) = Node a -> BST a -> Ordering -> BST a
forall a. Node a -> BST a -> Ordering -> BST a
insertBST' (Int -> a -> Node a
forall a. Show a => Int -> a -> Node a
Node Int
x' a
v') BST a
t (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x' Int
x)

-- | Insertion algorithm. It has the additional parameter of type
-- `Ordering`, which guides the recursion.
insertBST' :: Node a -> BST a -> Ordering -> BST a
insertBST' :: forall a. Node a -> BST a -> Ordering -> BST a
insertBST' Node a
node (F BST a
l Node a
_ BST a
r) Ordering
EQ = BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
l Node a
node BST a
r
insertBST' Node a
n' (F BST a
E Node a
n BST a
r) Ordering
LT = BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F (BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
forall a. BST a
E Node a
n' BST a
forall a. BST a
E) Node a
n BST a
r
insertBST' n' :: Node a
n'@(Node Int
x a
_) (F l :: BST a
l@(F BST a
_ (Node Int
ln a
_) BST a
_) Node a
n BST a
r) Ordering
LT =
  BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F (Node a -> BST a -> Ordering -> BST a
forall a. Node a -> BST a -> Ordering -> BST a
insertBST' Node a
n' BST a
l (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
ln)) Node a
n BST a
r
insertBST' Node a
n' (F BST a
l Node a
n BST a
E) Ordering
GT = BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
l Node a
n (BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
forall a. BST a
E Node a
n' BST a
forall a. BST a
E)
insertBST' n' :: Node a
n'@(Node Int
x a
_) (F BST a
l Node a
n r :: BST a
r@(F BST a
_ (Node Int
rn a
_) BST a
_)) Ordering
GT =
  BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
l Node a
n (Node a -> BST a -> Ordering -> BST a
forall a. Node a -> BST a -> Ordering -> BST a
insertBST' Node a
n' BST a
r (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
rn))

-- | Lookup the given key in the tree.
-- It returns `Nothing` if tree is empty or if it doesn't have the key.
lookupBST :: Int -> BST a -> Maybe a
lookupBST :: forall a. Int -> BST a -> Maybe a
lookupBST Int
_ BST a
E = Maybe a
forall a. Maybe a
Nothing
lookupBST Int
x t :: BST a
t@(F BST a
_ (Node Int
n a
_) BST a
_) = Int -> BST a -> Ordering -> Maybe a
forall a. Int -> BST a -> Ordering -> Maybe a
lookupBST' Int
x BST a
t (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
n)

-- | Lookup algorithm. It has the additional parameter of type
-- `Ordering`, which guides the recursion.
lookupBST' :: Int -> BST a -> Ordering -> Maybe a
lookupBST' :: forall a. Int -> BST a -> Ordering -> Maybe a
lookupBST' Int
_ BST a
E Ordering
_ = Maybe a
forall a. Maybe a
Nothing
lookupBST' Int
_ (F BST a
_ (Node Int
_ a
a) BST a
_) Ordering
EQ = a -> Maybe a
forall a. a -> Maybe a
Just a
a
lookupBST' Int
_ (F BST a
E Node a
_ BST a
_) Ordering
LT = Maybe a
forall a. Maybe a
Nothing
lookupBST' Int
_ (F BST a
_ Node a
_ BST a
E) Ordering
GT = Maybe a
forall a. Maybe a
Nothing
lookupBST' Int
x (F l :: BST a
l@(F BST a
_ (Node Int
ln a
_) BST a
_) Node a
_ BST a
_) Ordering
LT = Int -> BST a -> Ordering -> Maybe a
forall a. Int -> BST a -> Ordering -> Maybe a
lookupBST' Int
x BST a
l (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
ln)
lookupBST' Int
x (F BST a
_ Node a
_ r :: BST a
r@(F BST a
_ (Node Int
rn a
_) BST a
_)) Ordering
GT = Int -> BST a -> Ordering -> Maybe a
forall a. Int -> BST a -> Ordering -> Maybe a
lookupBST' Int
x BST a
r (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
rn)

-- | Delete the node with the maximum key value.
maxKeyDelete :: BST a -> BST a
maxKeyDelete :: forall a. BST a -> BST a
maxKeyDelete BST a
E = BST a
forall a. BST a
E
maxKeyDelete (F BST a
l Node a
_ BST a
E) = BST a
l
maxKeyDelete (F BST a
l Node a
node r :: BST a
r@F {}) =
  BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
l Node a
node (BST a -> BST a
forall a. BST a -> BST a
maxKeyDelete BST a
r)

-- | Get the node with maximum key value.
-- | It returns `Nothing` if tree is empty.
maxNode :: BST a -> Maybe (Node a)
maxNode :: forall a. BST a -> Maybe (Node a)
maxNode BST a
E = Maybe (Node a)
forall a. Maybe a
Nothing
maxNode (F BST a
_ Node a
node BST a
E) = Node a -> Maybe (Node a)
forall a. a -> Maybe a
Just Node a
node
maxNode (F BST a
_ (Node Int
_ a
_) r :: BST a
r@F {}) = BST a -> Maybe (Node a)
forall a. BST a -> Maybe (Node a)
maxNode BST a
r

-- | Delete the node with the given key.
-- If the key is not in the tree, return the same tree.
deleteBST :: Int -> BST a -> BST a
deleteBST :: forall a. Int -> BST a -> BST a
deleteBST Int
_ BST a
E = BST a
forall a. BST a
E
deleteBST Int
x t :: BST a
t@(F BST a
_ (Node Int
n a
_) BST a
_) = Int -> BST a -> Ordering -> BST a
forall a. Int -> BST a -> Ordering -> BST a
deleteBST' Int
x BST a
t (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
n)

-- | Deletion algorithm. It has the additional parameter of type
-- `Ordering`, which guides the recursion.
deleteBST' :: Int -> BST a -> Ordering -> BST a
deleteBST' :: forall a. Int -> BST a -> Ordering -> BST a
deleteBST' Int
_ (F BST a
E Node a
_ BST a
E) Ordering
EQ = BST a
forall a. BST a
E
deleteBST' Int
_ (F BST a
E Node a
_ r :: BST a
r@F {}) Ordering
EQ = BST a
r
deleteBST' Int
_ (F l :: BST a
l@F {} Node a
_ BST a
E) Ordering
EQ = BST a
l
deleteBST' Int
_ (F l :: BST a
l@F {} Node a
_ r :: BST a
r@F {}) Ordering
EQ =
  BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F (BST a -> BST a
forall a. BST a -> BST a
maxKeyDelete BST a
l) Node a
mNode BST a
r
  where
    Just Node a
mNode = BST a -> Maybe (Node a)
forall a. BST a -> Maybe (Node a)
maxNode BST a
l
deleteBST' Int
_ t :: BST a
t@(F BST a
E Node a
_ BST a
_) Ordering
LT = BST a
t
deleteBST' Int
x (F l :: BST a
l@(F BST a
_ (Node Int
ln a
_) BST a
_) Node a
node BST a
r) Ordering
LT =
  BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F (Int -> BST a -> Ordering -> BST a
forall a. Int -> BST a -> Ordering -> BST a
deleteBST' Int
x BST a
l (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
ln)) Node a
node BST a
r
deleteBST' Int
_ t :: BST a
t@(F BST a
_ Node a
_ BST a
E) Ordering
GT = BST a
t
deleteBST' Int
x (F BST a
l Node a
node r :: BST a
r@(F BST a
_ (Node Int
rn a
_) BST a
_)) Ordering
GT =
  BST a -> Node a -> BST a -> BST a
forall a. BST a -> Node a -> BST a -> BST a
F BST a
l Node a
node (Int -> BST a -> Ordering -> BST a
forall a. Int -> BST a -> Ordering -> BST a
deleteBST' Int
x BST a
r (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
rn))