Fork of elm-core's Dict, removing the limitation of the keys' types. (0.19.1)

AnyDict.elm

module AnyDict exposing
    ( AnyDict, isContentEqual
    , empty, singleton, insert, update, remove
    , isEmpty, member, get, getMin, findl, findr, size
    , keys, values, toList, fromList
    , map, foldl, foldr, filter, partition
    , union, intersect, diff, merge
    )

{-| Fork of [elm-core's Dict](/packages/elm/core/1.0.5/Dict), removing the limitation of the keys' types.

Insert, remove, and query operations all take _O(log n)_ time.


# Dictionaries

@docs AnyDict, isContentEqual


# Build

@docs empty, singleton, insert, update, remove


# Query

@docs isEmpty, member, get, getMin, findl, findr, size


# Lists

@docs keys, values, toList, fromList


# Transform

@docs map, foldl, foldr, filter, partition


# Combine

@docs union, intersect, diff, merge

-}

-- DICTIONARIES
-- The color of a node. Leaves are considered Black.


type NColor
    = Red
    | Black


{-| A dictionary of keys and values. So a `Dict String User` is a dictionary
that lets you look up a `String` (such as user names) and find the associated
`User`.

    import Dict exposing (Dict)

    users : Dict String User
    users =
        Dict.fromList
            [ ( "Alice", User "Alice" 28 1.65 )
            , ( "Bob", User "Bob" 19 1.82 )
            , ( "Chuck", User "Chuck" 33 1.75 )
            ]

    type alias User =
        { name : String
        , age : Int
        , height : Float
        }

-}
type AnyDict k v
    = AnyDict (k -> k -> Order) (Dict k v)


type Dict k v
    = RBNode_elm_builtin NColor k v (Dict k v) (Dict k v)
    | RBEmpty_elm_builtin


{-| Check for equality ignoring the comparing function.
-}
isContentEqual : AnyDict k v -> AnyDict k v -> Bool
isContentEqual (AnyDict _ a) (AnyDict _ b) =
    a == b


{-| Create an empty dictionary.
-}
empty : (k -> k -> Order) -> AnyDict k v
empty comparer =
    AnyDict comparer RBEmpty_elm_builtin


{-| Get the value associated with a key. If the key is not found, return
`Nothing`. This is useful when you are not sure if a key will be in the
dictionary.

    animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]

    get "Tom"   animals == Just Cat
    get "Jerry" animals == Just Mouse
    get "Spike" animals == Nothing

-}
get : k -> AnyDict k v -> Maybe v
get targetKey_ (AnyDict comparer dict) =
    let
        get_ targetKey dict_ =
            case dict_ of
                RBEmpty_elm_builtin ->
                    Nothing

                RBNode_elm_builtin _ key value left right ->
                    case comparer targetKey key of
                        LT ->
                            get_ targetKey left

                        EQ ->
                            Just value

                        GT ->
                            get_ targetKey right
    in
    get_ targetKey_ dict


{-| Determine if a key is in a dictionary.
-}
member : k -> AnyDict k v -> Bool
member key dict =
    case get key dict of
        Just _ ->
            True

        Nothing ->
            False


{-| Determine the number of key-value pairs in the dictionary.
-}
size : AnyDict k v -> Int
size (AnyDict _ dict) =
    sizeHelp 0 dict


sizeHelp : Int -> Dict k v -> Int
sizeHelp n dict =
    case dict of
        RBEmpty_elm_builtin ->
            n

        RBNode_elm_builtin _ _ _ left right ->
            sizeHelp (sizeHelp (n + 1) right) left


{-| Determine if a dictionary is empty.

    isEmpty empty == True

-}
isEmpty : AnyDict k v -> Bool
isEmpty (AnyDict _ dict) =
    case dict of
        RBEmpty_elm_builtin ->
            True

        RBNode_elm_builtin _ _ _ _ _ ->
            False


{-| Insert a key-value pair into a dictionary. Replaces value when there is
a collision.
-}
insert : k -> v -> AnyDict k v -> AnyDict k v
insert key value (AnyDict comparer dict) =
    -- Dict node is always Black
    AnyDict comparer <|
        case insertHelp comparer key value dict of
            RBNode_elm_builtin Red k v l r ->
                RBNode_elm_builtin Black k v l r

            x ->
                x


insertHelp : (k -> k -> Order) -> k -> v -> Dict k v -> Dict k v
insertHelp comparer key value dict =
    case dict of
        RBEmpty_elm_builtin ->
            -- New nodes are always red. If it violates the rules, it will be fixed
            -- when balancing.
            RBNode_elm_builtin Red key value RBEmpty_elm_builtin RBEmpty_elm_builtin

        RBNode_elm_builtin nColor nKey nValue nLeft nRight ->
            case comparer key nKey of
                LT ->
                    balance nColor nKey nValue (insertHelp comparer key value nLeft) nRight

                EQ ->
                    RBNode_elm_builtin nColor nKey value nLeft nRight

                GT ->
                    balance nColor nKey nValue nLeft (insertHelp comparer key value nRight)


balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
balance color key value left right =
    case right of
        RBNode_elm_builtin Red rK rV rLeft rRight ->
            case left of
                RBNode_elm_builtin Red lK lV lLeft lRight ->
                    RBNode_elm_builtin
                        Red
                        key
                        value
                        (RBNode_elm_builtin Black lK lV lLeft lRight)
                        (RBNode_elm_builtin Black rK rV rLeft rRight)

                _ ->
                    RBNode_elm_builtin color rK rV (RBNode_elm_builtin Red key value left rLeft) rRight

        _ ->
            case left of
                RBNode_elm_builtin Red lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight ->
                    RBNode_elm_builtin
                        Red
                        lK
                        lV
                        (RBNode_elm_builtin Black llK llV llLeft llRight)
                        (RBNode_elm_builtin Black key value lRight right)

                _ ->
                    RBNode_elm_builtin color key value left right


{-| Remove a key-value pair from a dictionary. If the key is not found,
no changes are made.
-}
remove : k -> AnyDict k v -> AnyDict k v
remove key (AnyDict comparer dict) =
    AnyDict comparer <|
        -- Dict node is always Black
        case removeHelp comparer key dict of
            RBNode_elm_builtin Red k v l r ->
                RBNode_elm_builtin Black k v l r

            x ->
                x


{-| The easiest thing to remove from the tree, is a red node. However, when searching for the
node to remove, we have no way of knowing if it will be red or not. This remove implementation
makes sure that the bottom node is red by moving red colors down the tree through rotation
and color flips. Any violations this will cause, can easily be fixed by balancing on the way
up again.
-}
removeHelp : (k -> k -> Order) -> k -> Dict k v -> Dict k v
removeHelp comparer targetKey dict =
    case dict of
        RBEmpty_elm_builtin ->
            RBEmpty_elm_builtin

        RBNode_elm_builtin color key value left right ->
            if comparer targetKey key == LT then
                case left of
                    RBNode_elm_builtin Black _ _ lLeft _ ->
                        case lLeft of
                            RBNode_elm_builtin Red _ _ _ _ ->
                                RBNode_elm_builtin color key value (removeHelp comparer targetKey left) right

                            _ ->
                                case moveRedLeft dict of
                                    RBNode_elm_builtin nColor nKey nValue nLeft nRight ->
                                        balance nColor nKey nValue (removeHelp comparer targetKey nLeft) nRight

                                    RBEmpty_elm_builtin ->
                                        RBEmpty_elm_builtin

                    _ ->
                        RBNode_elm_builtin color key value (removeHelp comparer targetKey left) right

            else
                removeHelpEQGT comparer targetKey (removeHelpPrepEQGT targetKey dict color key value left right)


removeHelpPrepEQGT : k -> Dict k v -> NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
removeHelpPrepEQGT targetKey dict color key value left right =
    case left of
        RBNode_elm_builtin Red lK lV lLeft lRight ->
            RBNode_elm_builtin
                color
                lK
                lV
                lLeft
                (RBNode_elm_builtin Red key value lRight right)

        _ ->
            case right of
                RBNode_elm_builtin Black _ _ (RBNode_elm_builtin Black _ _ _ _) _ ->
                    moveRedRight dict

                RBNode_elm_builtin Black _ _ RBEmpty_elm_builtin _ ->
                    moveRedRight dict

                _ ->
                    dict


{-| When we find the node we are looking for, we can remove by replacing the key-value
pair with the key-value pair of the left-most node on the right side (the closest pair).
-}
removeHelpEQGT : (k -> k -> Order) -> k -> Dict k v -> Dict k v
removeHelpEQGT comparer targetKey dict =
    case dict of
        RBNode_elm_builtin color key value left right ->
            if comparer targetKey key == EQ then
                case getMinHelper right of
                    RBNode_elm_builtin _ minKey minValue _ _ ->
                        balance color minKey minValue left (removeMin right)

                    RBEmpty_elm_builtin ->
                        RBEmpty_elm_builtin

            else
                balance color key value left (removeHelp comparer targetKey right)

        RBEmpty_elm_builtin ->
            RBEmpty_elm_builtin


getMinHelper : Dict k v -> Dict k v
getMinHelper dict =
    case dict of
        RBNode_elm_builtin _ _ _ ((RBNode_elm_builtin _ _ _ _ _) as left) _ ->
            getMinHelper left

        _ ->
            dict


{-| Retrieve the node with the smallest key.
-}
getMin : AnyDict k v -> Maybe ( k, v )
getMin (AnyDict _ dict) =
    case getMinHelper dict of
        RBNode_elm_builtin _ minKey minValue _ _ ->
            Just ( minKey, minValue )

        RBEmpty_elm_builtin ->
            Nothing


removeMin : Dict k v -> Dict k v
removeMin dict =
    case dict of
        RBNode_elm_builtin color key value ((RBNode_elm_builtin lColor _ _ lLeft _) as left) right ->
            case lColor of
                Black ->
                    case lLeft of
                        RBNode_elm_builtin Red _ _ _ _ ->
                            RBNode_elm_builtin color key value (removeMin left) right

                        _ ->
                            case moveRedLeft dict of
                                RBNode_elm_builtin nColor nKey nValue nLeft nRight ->
                                    balance nColor nKey nValue (removeMin nLeft) nRight

                                RBEmpty_elm_builtin ->
                                    RBEmpty_elm_builtin

                _ ->
                    RBNode_elm_builtin color key value (removeMin left) right

        _ ->
            RBEmpty_elm_builtin


moveRedLeft : Dict k v -> Dict k v
moveRedLeft dict =
    case dict of
        RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV ((RBNode_elm_builtin Red rlK rlV rlL rlR) as rLeft) rRight) ->
            RBNode_elm_builtin
                Red
                rlK
                rlV
                (RBNode_elm_builtin Black k v (RBNode_elm_builtin Red lK lV lLeft lRight) rlL)
                (RBNode_elm_builtin Black rK rV rlR rRight)

        RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) ->
            case clr of
                Black ->
                    RBNode_elm_builtin
                        Black
                        k
                        v
                        (RBNode_elm_builtin Red lK lV lLeft lRight)
                        (RBNode_elm_builtin Red rK rV rLeft rRight)

                Red ->
                    RBNode_elm_builtin
                        Black
                        k
                        v
                        (RBNode_elm_builtin Red lK lV lLeft lRight)
                        (RBNode_elm_builtin Red rK rV rLeft rRight)

        _ ->
            dict


moveRedRight : Dict k v -> Dict k v
moveRedRight dict =
    case dict of
        RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV (RBNode_elm_builtin Red llK llV llLeft llRight) lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) ->
            RBNode_elm_builtin
                Red
                lK
                lV
                (RBNode_elm_builtin Black llK llV llLeft llRight)
                (RBNode_elm_builtin Black k v lRight (RBNode_elm_builtin Red rK rV rLeft rRight))

        RBNode_elm_builtin clr k v (RBNode_elm_builtin lClr lK lV lLeft lRight) (RBNode_elm_builtin rClr rK rV rLeft rRight) ->
            case clr of
                Black ->
                    RBNode_elm_builtin
                        Black
                        k
                        v
                        (RBNode_elm_builtin Red lK lV lLeft lRight)
                        (RBNode_elm_builtin Red rK rV rLeft rRight)

                Red ->
                    RBNode_elm_builtin
                        Black
                        k
                        v
                        (RBNode_elm_builtin Red lK lV lLeft lRight)
                        (RBNode_elm_builtin Red rK rV rLeft rRight)

        _ ->
            dict


{-| Update the value of a dictionary for a specific key with a given function.
-}
update : k -> (Maybe v -> Maybe v) -> AnyDict k v -> AnyDict k v
update targetKey alter dictionary =
    case alter (get targetKey dictionary) of
        Just value ->
            insert targetKey value dictionary

        Nothing ->
            remove targetKey dictionary


{-| Create a dictionary with one key-value pair.
-}
singleton : (k -> k -> Order) -> k -> v -> AnyDict k v
singleton comparer key value =
    AnyDict comparer <|
        -- Dict node is always Black
        RBNode_elm_builtin Black key value RBEmpty_elm_builtin RBEmpty_elm_builtin



-- COMBINE


{-| Combine two dictionaries. If there is a collision, preference is given
to the first dictionary.
-}
union : AnyDict k v -> AnyDict k v -> AnyDict k v
union t1 t2 =
    foldl insert t2 t1


{-| Keep a key-value pair when its key appears in the second dictionary.
Preference is given to values in the first dictionary.
-}
intersect : AnyDict k v -> AnyDict k v -> AnyDict k v
intersect t1 t2 =
    filter (\k _ -> member k t2) t1


{-| Keep a key-value pair when its key does not appear in the second dictionary.
-}
diff : AnyDict k a -> AnyDict k b -> AnyDict k a
diff t1 t2 =
    foldl (\k v t -> remove k t) t1 t2


{-| The most general way of combining two dictionaries. You provide three
accumulators for when a given key appears:

1.  Only in the left dictionary.
2.  In both dictionaries.
3.  Only in the right dictionary.

You then traverse all the keys from lowest to highest, building up whatever
you want.

-}
merge :
    (k -> a -> result -> result)
    -> (k -> a -> b -> result -> result)
    -> (k -> b -> result -> result)
    -> (k -> k -> Order)
    -> AnyDict k a
    -> AnyDict k b
    -> result
    -> result
merge leftStep bothStep rightStep comparer leftDict rightDict initialResult =
    let
        stepState rKey rValue ( list, result ) =
            case list of
                [] ->
                    ( list, rightStep rKey rValue result )

                ( lKey, lValue ) :: rest ->
                    case comparer lKey rKey of
                        LT ->
                            stepState rKey rValue ( rest, leftStep lKey lValue result )

                        GT ->
                            ( list, rightStep rKey rValue result )

                        EQ ->
                            ( rest, bothStep lKey lValue rValue result )

        ( leftovers, intermediateResult ) =
            foldl stepState ( toList leftDict, initialResult ) rightDict
    in
    List.foldl (\( k, v ) result -> leftStep k v result) intermediateResult leftovers



-- TRANSFORM


{-| Apply a function to all values in a dictionary.
-}
map : (k -> a -> b) -> AnyDict k a -> AnyDict k b
map func (AnyDict comparer dict) =
    let
        map_ dict_ =
            case dict_ of
                RBEmpty_elm_builtin ->
                    RBEmpty_elm_builtin

                RBNode_elm_builtin color key value left right ->
                    RBNode_elm_builtin color key (func key value) (map_ left) (map_ right)
    in
    AnyDict comparer <| map_ dict


{-| Fold over the key-value pairs in a dictionary from lowest key to highest key.

    import Dict exposing (Dict)

    getAges : Dict String User -> List String
    getAges users =
        Dict.foldl addAge [] users

    addAge : String -> User -> List String -> List String
    addAge _ user ages =
        user.age :: ages

    -- getAges users == [33,19,28]

-}
foldl : (k -> v -> b -> b) -> b -> AnyDict k v -> b
foldl func acc_ (AnyDict _ dict) =
    let
        foldl_ acc dict_ =
            case dict_ of
                RBEmpty_elm_builtin ->
                    acc

                RBNode_elm_builtin _ key value left right ->
                    foldl_ (func key value (foldl_ acc left)) right
    in
    foldl_ acc_ dict


{-| Fold over the key-value pairs in a dictionary from highest key to lowest key.

    import Dict exposing (Dict)

    getAges : Dict String User -> List String
    getAges users =
        Dict.foldr addAge [] users

    addAge : String -> User -> List String -> List String
    addAge _ user ages =
        user.age :: ages

    -- getAges users == [28,19,33]

-}
foldr : (k -> v -> b -> b) -> b -> AnyDict k v -> b
foldr func acc_ (AnyDict _ dict) =
    let
        foldr_ acc t =
            case t of
                RBEmpty_elm_builtin ->
                    acc

                RBNode_elm_builtin _ key value left right ->
                    foldr_ (func key value (foldr_ acc right)) left
    in
    foldr_ acc_ dict


{-| Keep only the key-value pairs that pass the given test.
-}
filter : (k -> v -> Bool) -> AnyDict k v -> AnyDict k v
filter isGood ((AnyDict comparer _) as dict) =
    foldl
        (\k v d ->
            if isGood k v then
                insert k v d

            else
                d
        )
        (empty comparer)
        dict


{-| Partition a dictionary according to some test. The first dictionary
contains all key-value pairs which passed the test, and the second contains
the pairs that did not.
-}
partition : (k -> v -> Bool) -> AnyDict k v -> ( AnyDict k v, AnyDict k v )
partition isGood ((AnyDict comparer _) as dict) =
    let
        add key value ( t1, t2 ) =
            if isGood key value then
                ( insert key value t1, t2 )

            else
                ( t1, insert key value t2 )
    in
    foldl add ( empty comparer, empty comparer ) dict



-- LISTS


{-| Get all of the keys in a dictionary, sorted from lowest to highest.

    keys (fromList [ ( 0, "Alice" ), ( 1, "Bob" ) ]) == [ 0, 1 ]

-}
keys : AnyDict k v -> List k
keys dict =
    foldr (\key value keyList -> key :: keyList) [] dict


{-| Get all of the values in a dictionary, in the order of their keys.

    values (fromList [ ( 0, "Alice" ), ( 1, "Bob" ) ]) == [ "Alice", "Bob" ]

-}
values : AnyDict k v -> List v
values dict =
    foldr (\key value valueList -> value :: valueList) [] dict


{-| Convert a dictionary into an association list of key-value pairs, sorted by keys.
-}
toList : AnyDict k v -> List ( k, v )
toList dict =
    foldr (\key value list -> ( key, value ) :: list) [] dict


{-| Convert an association list into a dictionary.
-}
fromList : (k -> k -> Order) -> List ( k, v ) -> AnyDict k v
fromList comparer assocs =
    List.foldl (\( key, value ) dict -> insert key value dict) (empty comparer) assocs


{-| Retrieve the first node that matches a predicate.
-}
findl : (k -> v -> Bool) -> AnyDict k v -> Maybe ( k, v )
findl predicate (AnyDict _ dict) =
    let
        find_ dict_ =
            case dict_ of
                RBEmpty_elm_builtin ->
                    Nothing

                RBNode_elm_builtin _ key value left right ->
                    if predicate key value then
                        Just ( key, value )

                    else
                        case find_ left of
                            Nothing ->
                                find_ right

                            found ->
                                found
    in
    find_ dict


{-| Retrieve the last node that matches a predicate.
-}
findr : (k -> v -> Bool) -> AnyDict k v -> Maybe ( k, v )
findr predicate (AnyDict _ dict) =
    let
        find_ dict_ =
            case dict_ of
                RBEmpty_elm_builtin ->
                    Nothing

                RBNode_elm_builtin _ key value left right ->
                    if predicate key value then
                        Just ( key, value )

                    else
                        case find_ right of
                            Nothing ->
                                find_ left

                            found ->
                                found
    in
    find_ dict