Restricting Exports

Consider an implementation of an \((a,b)\)-tree data structure. We would probably put it into a module called Data.ABTree:

Data/ABTree.hs

module Data.ABTree where

import Data.List (intercalate)

data ABNode t = ABLeaf t
              | ABNode Int t [ABNode t]

data ABTree t = ABTree Int Int (Maybe (ABNode t))

abKey :: ABNode t -> t
abKey (ABLeaf   x)   = x
abKey (ABNode _ x _) = x

abMakeNode :: Int -> [ABNode t] -> ABNode t
abMakeNode deg vs = ABNode deg (abKey $ head vs) vs

abEmptyTree :: Int -> Int -> ABTree t
abEmptyTree a b = ABTree a b Nothing

abElem :: Ord t => t -> ABTree t -> Bool
abElem = flip $ abOp
    (\_ _ _       -> False )
    (\x y _       -> x == y)

abInsert :: Ord t => ABTree t -> t -> ABTree t
abInsert = abOp
    (\a b y            -> ABTree a b (Just (ABLeaf y)))
    (\x y k            -> k $ [ABLeaf x | x < y] ++ [ABLeaf y] ++ [ABLeaf x | x > y])

abDelete :: Ord t => ABTree t -> t -> ABTree t
abDelete = abOp
    (\a b _            -> ABTree a b Nothing)
    (\x y k            -> k [ABLeaf x | x /= y])

abOp :: Ord t
     => (Int -> Int -> t -> b)
     -> (t -> t -> (([ABNode t] -> ABTree t) -> b))
     -> ABTree t -> t -> b
abOp emptyOp _      (ABTree a b Nothing)  y = emptyOp a b y
abOp _       leafOp (ABTree a b (Just r)) y = subtreeOp r (abMakeTree a b)
  where
    subtreeOp (ABLeaf x)        k = leafOp x y k
    subtreeOp (ABNode deg _ vs) k = subtreeOp m (\x -> k $ abRebalanceChildren a b deg ls x rs)
      where
        (ls, m, rs) = split (\v -> abKey v <= y) vs

abMakeTree :: Int -> Int -> [ABNode t] -> ABTree t
abMakeTree a b rs = case rs of
    []                             -> ABTree a b Nothing
    [ABNode _ _ [r]]               -> ABTree a b (Just r)
    [r@(ABNode deg _ _)] | deg > b -> ABTree a b (Just $ abMakeNode 2 $ abSplitNode r)
    [r]                            -> ABTree a b (Just r)
    rs                             -> ABTree a b (Just $ abMakeNode 2 rs)

abRebalanceChildren :: Int -> Int -> Int -> [ABNode t] -> [ABNode t] -> [ABNode t] -> [ABNode t]
abRebalanceChildren a b deg ls ms rs = case ms of
    [m@(ABNode mdeg _ _)]
        | mdeg > b -> [abMakeNode (deg + 1) (unsplit ls (abSplitNode m ++ rs))]
        | mdeg < a -> case (ls, rs) of
            (_, r:rs') -> abRebalanceChildren a b (deg - 1) ls  [abMergeNodes m r] rs'
            (l:ls', _) -> abRebalanceChildren a b (deg - 1) ls' [abMergeNodes l m] rs
            _          -> error "BUG: Internal node had degree 1"
    _              -> [abMakeNode (deg + length ms - 1) (unsplit ls (ms ++ rs))]

abSplitNode :: ABNode t -> [ABNode t]
abSplitNode (ABLeaf _)        = error "BUG: abSplitNode called on a leaf"
abSplitNode (ABNode deg _ vs) = [abMakeNode ldeg ls, abMakeNode rdeg rs]
  where
    ldeg     = deg `div` 2
    rdeg     = deg - ldeg
    (ls, rs) = splitAt ldeg vs

abMergeNodes :: ABNode t -> ABNode t -> ABNode t
abMergeNodes (ABNode ldeg _ ls) (ABNode rdeg _ rs) = abMakeNode (ldeg + rdeg) (ls ++ rs)
abMergeNodes _                  _                  = error "BUG: Called abMergeNodes on a leaf"

split :: (a -> Bool) -> [a] -> ([a], a, [a])
split pred = go []
  where
    go []      (r:rs') = go [r] rs'
    go (l:ls') []      = (ls', l, [])
    go ls@(l:ls') rs@(r:rs')
        | pred r      = go (r:ls) rs'
        | otherwise   = (ls', l, rs)

unsplit :: [a] -> [a] -> [a]
unsplit = flip $ foldl (flip (:))

The public interface to an \((a,b)\)-tree consists of the data type ABTree, and functions abEmptyTree, abElem, abInsert, and abDelete. All other functions in this module should be considered implementation details of these functions that should not be shared with other modules. By changing the module header to

module Data.ABTree
    ( ABTree
    , abEmptyTree
    , abElem
    , abInsert
    , abDelete
    ) where

we state that only the ABTree type and the four functions in this list should be exported. This list after the module name is called an export list. Any data type, type class or function not included in this list is now private to our module.