    -- | Simple Finite Maps.
    -- This implementation provides several useful methods that Data.FiniteMap
    -- does not.

    module Data.Graph.Inductive.Internal.FiniteMap(
        -- * Type
        FiniteMap(..),
        -- * Operations
        emptyFM,addToFM,delFromFM,
        updFM,
        accumFM,
        splitFM,
        isEmptyFM,sizeFM,lookupFM,elemFM,
        rangeFM,
        minFM,maxFM,predFM,succFM,
        splitMinFM,
        fmToList
    ) where

    import Data.Maybe (isJust)

    data Ord a => FiniteMap a b =
        Empty | Node Int (FiniteMap a b) (a,b) (FiniteMap a b)
        deriving (Eq)

    ----------------------------------------------------------------------
    -- UTILITIES
    ----------------------------------------------------------------------

    -- pretty printing
    --
    showsMap :: (Show a,Show b,Ord a) => FiniteMap a b -> ShowS
    showsMap Empty            = id
    showsMap (Node _ l (i,x) r) = showsMap l . (' ':) .
                                  shows i . ("->"++) . shows x . showsMap r

    instance (Show a,Show b,Ord a) => Show (FiniteMap a b) where
      showsPrec _ m = showsMap m

    -- other
    --
    splitMax :: Ord a => FiniteMap a b -> (FiniteMap a b,(a,b))
    splitMax (Node _ l x Empty) = (l,x)
    splitMax (Node _ l x r)     = (avlBalance l x m,y) where (m,y) = splitMax r
    splitMax Empty		    = error "splitMax on empty FiniteMap"

    merge :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
    merge l Empty = l
    merge Empty r = r
    merge l r     = avlBalance l' x r where (l',x) = splitMax l

    ----------------------------------------------------------------------
    -- MAIN FUNCTIONS
    ----------------------------------------------------------------------

    emptyFM :: Ord a => FiniteMap a b
    emptyFM  = Empty

    addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
    addToFM Empty            i x              =  node Empty (i,x) Empty
    addToFM (Node h l (j,y) r) i x
        | i<j        =  avlBalance (addToFM l i x) (j,y) r
        | i>j        =  avlBalance l (j,y) (addToFM r i x)
        | otherwise  =  Node h l (j,x) r

    -- | applies function to stored entry
    updFM :: Ord a => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b
    updFM Empty              _ _              =  Empty
    updFM (Node h l (j,x) r) i f
               | i<j        =  let l' = updFM l i f in l' `seq` Node h l' (j,x) r
               | i>j        =  let r' = updFM r i f in r' `seq` Node h l (j,x) r'
               | otherwise  =  Node h l (j,f x) r

    -- | defines or aggregates entries
    accumFM :: Ord a => FiniteMap a b -> a -> (b -> b -> b) -> b -> FiniteMap a b
    accumFM Empty              i _ x              =  node Empty (i,x) Empty
    accumFM (Node h l (j,y) r) i f x
        | i<j        =  avlBalance (accumFM l i f x) (j,y) r
        | i>j        =  avlBalance l (j,y) (accumFM r i f x)
        | otherwise  =  Node h l (j,f x y) r

    delFromFM :: Ord a => FiniteMap a b -> a -> FiniteMap a b
    delFromFM Empty              _              =  Empty
    delFromFM (Node _ l (j,x) r) i
        | i<j        =  avlBalance (delFromFM l i) (j,x) r
        | i>j        =  avlBalance l (j,x) (delFromFM r i)
        | otherwise  =  merge l r

    isEmptyFM :: FiniteMap a b -> Bool
    isEmptyFM Empty = True
    isEmptyFM _     = False

    sizeFM :: Ord a => FiniteMap a b -> Int
    sizeFM Empty          = 0
    sizeFM (Node _ l _ r) = sizeFM l + 1 + sizeFM r

    lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
    lookupFM Empty _ = Nothing
    lookupFM (Node _ l (j,x) r) i | i<j        =  lookupFM l i
                                  | i>j        =  lookupFM r i
                                  | otherwise  =  Just x

    -- | applies lookup to an interval
    rangeFM :: Ord a => FiniteMap a b -> a -> a -> [b]
    rangeFM m i j = rangeFMa m i j []
    --
    rangeFMa Empty _ _ a = a
    rangeFMa (Node _ l (k,x) r) i j a
        | k<i       = rangeFMa r i j a
        | k>j       = rangeFMa l i j a
        | otherwise = rangeFMa l i j (x:rangeFMa r i j a)

    minFM :: Ord a => FiniteMap a b -> Maybe (a,b)
    minFM Empty              = Nothing
    minFM (Node _ Empty x _) = Just x
    minFM (Node _ l     _ _) = minFM l

    maxFM :: Ord a => FiniteMap a b -> Maybe (a,b)
    maxFM Empty              = Nothing
    maxFM (Node _ _ x Empty) = Just x
    maxFM (Node _ _ _ r)     = maxFM r

    predFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b)
    predFM m i = predFM' m i Nothing
    --
    predFM' Empty              _ p              =  p
    predFM' (Node _ l (j,x) r) i p | i<j        =  predFM' l i p
                                   | i>j        =  predFM' r i (Just (j,x))
                                   | isJust ml  =  ml
                                   | otherwise  =  p
                                     where ml = maxFM l

    succFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b)
    succFM m i = succFM' m i Nothing
    --
    succFM' Empty              _ p              =  p
    succFM' (Node _ l (j,x) r) i p | i<j        =  succFM' l i (Just (j,x))
                                   | i>j        =  succFM' r i p
                                   | isJust mr  =  mr
                                   | otherwise  =  p
                                     where mr = minFM r

    elemFM :: Ord a => FiniteMap a b -> a -> Bool
    elemFM m i = case lookupFM m i of {Nothing -> False; _ -> True}

    -- | combines delFrom and lookup
    splitFM :: Ord a => FiniteMap a b -> a -> Maybe (FiniteMap a b,(a,b))
    splitFM Empty              _ =  Nothing
    splitFM (Node _ l (j,x) r) i =
            if i<j then
               case splitFM l i of
                    Just (l',y) -> Just (avlBalance l' (j,x) r,y)
                    Nothing     -> Nothing  else
            if i>j then
               case splitFM r i of
                    Just (r',y) -> Just (avlBalance l (j,x) r',y)
                    Nothing     -> Nothing
            else {- i==j -}        Just (merge l r,(j,x))

    -- | combines splitFM and minFM
    splitMinFM :: Ord a => FiniteMap a b -> Maybe (FiniteMap a b,(a,b))
    splitMinFM Empty              =  Nothing
    splitMinFM (Node _ Empty x r) = Just (r,x)
    splitMinFM (Node _ l x r)     = Just (avlBalance l' x r,y)
                                    where Just (l',y) = splitMinFM l

    fmToList :: Ord a => FiniteMap a b -> [(a,b)]
    fmToList m = scan m []
                 where scan Empty xs = xs
                       scan (Node _ l x r) xs = scan l (x:(scan r xs))

    ----------------------------------------------------------------------
    -- AVL tree helper functions
    ----------------------------------------------------------------------

    height :: Ord a => FiniteMap a b -> Int
    height Empty          = 0
    height (Node h _ _ _) = h

    node :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b
    node l val r = Node h l val r
        where h=1+(height l `max` height r)

    avlBalance :: Ord a => FiniteMap a b -> (a,b) -> FiniteMap a b -> FiniteMap a b
    avlBalance l (i,x) r
        | (hr + 1 < hl) && (bias l < 0) = rotr (node (rotl l) (i,x) r)
        | (hr + 1 < hl)                 = rotr (node l (i,x) r)
        | (hl + 1 < hr) && (0 < bias r) = rotl (node l (i,x) (rotr r))
        | (hl + 1 < hr)                 = rotl (node l (i,x) r)
        | otherwise                     = node l (i,x) r
        where hl=height l; hr=height r

    bias :: Ord a => FiniteMap a b -> Int
    bias (Node _ l _ r) = height l - height r
    bias Empty	    = 0

    rotr :: Ord a => FiniteMap a b -> FiniteMap a b
    rotr Empty			      = Empty
    rotr (Node _ (Node _ l1 v1 r1) v2 r2) = node l1 v1 (node r1 v2 r2)
    rotr (Node _ Empty _ _)		      = error "rotr on invalid FiniteMap"

    rotl :: Ord a => FiniteMap a b -> FiniteMap a b
    rotl Empty			      = Empty
    rotl (Node _ l1 v1 (Node _ l2 v2 r2)) = node (node l1 v1 l2) v2 r2
    rotl (Node _ _ _ Empty)		      = error "rotl on invalid FiniteMap"