enummapmap-0.6.0: Map of maps using Enum types as keys

Copyright(c) Daan Leijen 2002 (c) Andriy Palamarchuk 2008 (c) Matthew West 2012
LicenseBSD-style
Stabilityexperimental
PortabilityUses GHC extensions
Safe HaskellNone
LanguageHaskell2010

Data.EnumMapMap.Strict

Contents

Description

Strict EnumMapMap. Based upon Data.IntMap.Strict, this version uses multi dimensional keys and Enum types instead of Ints. Keys are built using the :& operator and terminated with K. They are stored using Ints so 2 keys that Enum to the same Int value will overwrite each other. The intension is that the Enum types will actually be newtype Ints.

newtype AppleID = AppleID Int
newtype TreeID = TreeID Int
type Orchard = EnumMapMap (TreeID :& K AppleID) Apple
apple = lookup (TreeID 4 :& K AppleID 32) orchard

The K type is different to that used in Data.EnumMapMap.Lazy so only strict operations can be performed on a strict EnumMapMap.

The functions are strict on values and keys.

Synopsis

Key types

data k :& t infixr 3 Source

Multiple keys are joined by the (:&) constructor.

multiKey :: Int :& Int :& K Int
multiKey = 5 :& 6 :& K 5

Constructors

!k :& !t infixr 3 

Instances

(Foldable (EnumMapMap t), Enum k, Eq k, IsKey t, HasSKey t) => Foldable (EnumMapMap ((:&) k t)) 
(Enum k1, (~) * k1 k2) => SubKey (S k1) ((:&) k2 t2) () 
(Enum k1, (~) * k1 k2) => SubKey (K k1) ((:&) k2 t2) v 
(Enum k1, (~) * k1 k2) => SubKey (K k1) ((:&) k2 t2) v 
(Eq k, Eq t) => Eq ((:&) k t) 
(Show v, Show (EnumMapMap t v)) => Show (EnumMapMap ((:&) k t) v) 
(Show k, Show t) => Show ((:&) k t) 
(NFData v, NFData (EnumMapMap t v)) => NFData (EnumMapMap ((:&) k t) v) 
(NFData k, NFData t) => NFData ((:&) k t) 
(Enum a, SafeCopy b) => SafeCopy ((:&) a b) 
(Eq k, Enum k, IsKey t, HasSKey t) => IsKey ((:&) k t) 
Typeable (* -> * -> *) (:&) 
(Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) => SubKey ((:&) k t1) ((:&) k t2) v 
type Result (S k1) ((:&) k2 t2) () = EnumMapSet t2 
type Result (K k1) ((:&) k2 t2) v = EnumMapMap t2 v 
type Result (K k1) ((:&) k2 t2) v = EnumMapMap t2 v 
data EnumMapMap ((:&) k t) = KCC (EMM k (EnumMapMap t v)) 
type Result ((:&) k t1) ((:&) k t2) v = Result t1 t2 v 

newtype K k Source

Keys are terminated with the K type

singleKey :: K Int
singleKey = K 5

Constructors

K k 

Instances

Eq k => Eq (K k) 
Show k => Show (K k) 
(Eq k, Enum k) => Foldable (EnumMapMap (K k)) 
NFData k => NFData (K k) 
Enum k => SafeCopy (K k) 
(Enum k, Eq k) => IsKey (K k) 
Enum k => SubKey (K k) (K k) v 
(Enum k1, (~) * k1 k2) => SubKey (K k1) ((:&) k2 t2) v 
Show v => Show (EnumMapMap (K k) v) 
NFData v => NFData (EnumMapMap (K k) v) 
(SafeCopy (K k), SafeCopy v, IsKey (K k), (~) * (Result (K k) (K k) v) v, SubKey (K k) (K k) v) => SafeCopy (EnumMapMap (K k) v) 
Typeable (* -> *) K 
data EnumMapMap (K k) = KEC (EMM k v) 
type Result (K k) (K k) v = v 
type Result (K k1) ((:&) k2 t2) v = EnumMapMap t2 v 

class Eq k => IsKey k where Source

Associated Types

data EnumMapMap k :: * -> * Source

A map of keys to values. The keys are Enum types but are stored as Ints so any keys with the same Int value are treated as the same. The aim is to provide typesafe indexing.

Methods

emptySubTrees :: EnumMapMap k v -> Bool Source

No subtrees should be empty. Returns True if one is.

joinKey :: IsKey (Plus k k2) => EnumMapMap k (EnumMapMap k2 v) -> EnumMapMap (Plus k k2) v Source

Join a key so that an EnumMapMap of EnumMapMaps becomes an EnumMapMap.

newtype ID = ID Int deriving Enum
emm :: EnumMapMap (K Int) (EnumMapMap (K ID) Bool)
res :: EnumMapMap (Int :& K ID) Bool
res = joinKey emm

joinKey is the opposite of splitKey.

emm = empty :: EnumMapMap (Int :& Int :& K ID) Bool)
emm == joinKey $ splitKey d2 emm

unsafeJoinKey :: EnumMapMap k (EnumMapMap k2 v) -> EnumMapMap (Plus k k2) v Source

Join a key so that an EnumMapMap of EnumMapMaps becomes an EnumMapMap. The unsafe version does not check for empty subtrees, so it is faster.

newtype ID = ID Int deriving Enum
emm :: EnumMapMap (K Int) (EnumMapMap (K ID) Bool)
res :: EnumMapMap (Int :& K ID) Bool
res = unsafeJoinKey emm

empty :: EnumMapMap k v Source

The empty EnumMapMap.

null :: EnumMapMap k v -> Bool Source

Is the EnumMapMap empty?

Submaps can never be empty, so the following should always hold true:

emm :: EnumMapMap (Int :& Int :& K ID) Bool)
null $ splitKey x emm == False

size :: EnumMapMap k v -> Int Source

Number of elements in the EnumMapMap.

alter :: (Maybe v -> Maybe v) -> k -> EnumMapMap k v -> EnumMapMap k v Source

The expression (alter f k emm) alters the value at k, or absence thereof. alter can be used to insert, delete, or update a value in an EnumMapMap.

map :: (v -> t) -> EnumMapMap k v -> EnumMapMap k t Source

Map a function over all values in the EnumMapMap.

mapMaybe :: (v -> Maybe t) -> EnumMapMap k v -> EnumMapMap k t Source

Map values and collect the Just results.

mapMaybeWithKey :: (k -> v -> Maybe t) -> EnumMapMap k v -> EnumMapMap k t Source

Map keys/values and collect the Just results.

mapWithKey :: (k -> v -> t) -> EnumMapMap k v -> EnumMapMap k t Source

Map a function over all key/value pairs in the EnumMapMap.

traverseWithKey :: Applicative t => (k -> a -> t b) -> EnumMapMap k a -> t (EnumMapMap k b) Source

TraverseWithKey behaves exactly like a regular traverse except that the traversing function also has access to the key associated with a value.

foldr :: (v -> t -> t) -> t -> EnumMapMap k v -> t Source

Fold the values in the EnumMapMap using the given right-associative binary operator

foldrWithKey :: (k -> v -> t -> t) -> t -> EnumMapMap k v -> t Source

Fold the keys and values in the EnumMapMap using the given right-associative binary operator.

toList :: SubKey k k v => EnumMapMap k v -> [(k, v)] Source

Convert the EnumMapMap to a list of key/value pairs.

fromList :: (SubKey k k v, Result k k v ~ v) => [(k, v)] -> EnumMapMap k v Source

Create an EnumMapMap from a list of key/value pairs.

elems :: EnumMapMap k v -> [v] Source

List of elements in ascending order of keys

keys :: EnumMapMap k v -> [k] Source

List of keys

keysSet :: HasSKey k => EnumMapMap k v -> EnumMapMap (Skey k) () Source

The EnumMapSet of the keys. EnumMapMap keys can be converted into EnumMapSet keys using toS, and back again using toK.

fromSet :: HasSKey k => (k -> v) -> EnumMapMap (Skey k) () -> EnumMapMap k v Source

Build an EnumMapMap from an EnumMapSet and a function which for each key computes it's value

findMin :: EnumMapMap k v -> (k, v) Source

The minimal key and value of the EnumMapMap.

findMin empty -- ERROR, no minimal key
findMin $ fromList [(K 1, "a", K 3, "b")] == (K 1, a)

minViewWithKey :: EnumMapMap k v -> Maybe ((k, v), EnumMapMap k v) Source

Retrieves the minimal (key,value) pair of the EnumMapMap, and the EnumMapMap stripped of that element, or Nothing if passed an empty map.

deleteFindMin :: EnumMapMap k v -> ((k, v), EnumMapMap k v) Source

union :: EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v Source

The (left-biased) union of two EnumMapMaps. It prefers the first EnumMapMap when duplicate keys are encountered.

unions :: [EnumMapMap k v] -> EnumMapMap k v Source

The union of a list of maps.

unionsWith :: (v -> v -> v) -> [EnumMapMap k v] -> EnumMapMap k v Source

The union of a list of maps with a combining function

unionWith :: (v -> v -> v) -> EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v Source

The union with a combining function.

unionWithKey :: (k -> v -> v -> v) -> EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v Source

The union with a combining function.

difference :: EnumMapMap k v1 -> EnumMapMap k v2 -> EnumMapMap k v1 Source

Difference between two EnumMapMaps (based on keys).

differenceWith :: (v1 -> v2 -> Maybe v1) -> EnumMapMap k v1 -> EnumMapMap k v2 -> EnumMapMap k v1 Source

Difference with a combining function.

differenceWithKey :: (k -> v1 -> v2 -> Maybe v1) -> EnumMapMap k v1 -> EnumMapMap k v2 -> EnumMapMap k v1 Source

Difference with a combining function.

intersection :: EnumMapMap k v1 -> EnumMapMap k v2 -> EnumMapMap k v1 Source

The (left-biased) intersection of two EnumMapMap (based on keys).

intersectionWith :: (v1 -> v2 -> v3) -> EnumMapMap k v1 -> EnumMapMap k v2 -> EnumMapMap k v3 Source

The intersection with a combining function.

intersectionWithKey :: (k -> v1 -> v2 -> v3) -> EnumMapMap k v1 -> EnumMapMap k v2 -> EnumMapMap k v3 Source

The intersection with a combining function.

Instances

(Enum k, Eq k) => IsKey (S k) 
(Enum k, Eq k) => IsKey (K k) 
(Enum k, Eq k) => IsKey (K k) 
(Eq k, Enum k, IsKey t, HasSKey t) => IsKey ((:&) k t) 

class SubKey k1 k2 v where Source

Minimal complete definition

member, singleton, lookup, insert, insertWithKey, delete

Associated Types

type Result k1 k2 v :: * Source

k1 should be a prefix of k2. If k1 ~ k2 then the Result will be v.

Result (K ID1) (ID1 :& K ID2) v        ~ EnumMapMap (K ID2) v
Result (ID1 :& K ID2) (ID1 :& K ID2) v ~ v
Result (ID1 :& K ID2) (K ID1) v        -- ERROR
Result (ID2 :& K ID1) (ID1 :& K ID2)   -- ERROR

Methods

member :: k1 -> EnumMapMap k2 v -> Bool Source

Is the key present in the EnumMapMap?

singleton :: k1 -> Result k1 k2 v -> EnumMapMap k2 v Source

An EnumMapMap with one element

singleton (5 :& K 3) "a" == fromList [(5 :& K 3, "a")]
singleton (K 5) $ singleton (K 2) "a" == fromList [(5 :& K 3, "a")]

lookup :: (IsKey k1, IsKey k2) => k1 -> EnumMapMap k2 v -> Maybe (Result k1 k2 v) Source

Lookup up the value at a key in the EnumMapMap.

emm = fromList [(3 :& K 1, "a")]
lookup (3 :& K 1) emm == Just "a"
lookup (2 :& K 1) emm == Nothing

If the given key has less dimensions then the EnumMapMap then a submap is returned.

emm2 = fromList [(3 :& 2 :& K 1, "a"), (3 :& 2 :& K 4, "a")]
lookup (3 :& K 2) emm2 == Just $ fromList [(K 1, "a"), (K 4, "a")]

insert :: (IsKey k1, IsKey k2) => k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v Source

Insert a new key/value pair into the EnumMapMap. Can also insert submaps.

insertWith :: (IsKey k1, IsKey k2) => (Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v) -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v Source

Insert with a combining function. Can also insert submaps.

insertWithKey :: (IsKey k1, IsKey k2) => (k1 -> Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v) -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v Source

Insert with a combining function. Can also insert submaps.

delete :: (IsKey k1, IsKey k2) => k1 -> EnumMapMap k2 v -> EnumMapMap k2 v Source

Remove a key and it's value from the EnumMapMap. If the key is not present the original EnumMapMap is returned.

Instances

Enum k => SubKey (S k) (S k) () 
Enum k => SubKey (K k) (K k) v 
Enum k => SubKey (K k) (K k) v 
(Enum k1, (~) * k1 k2) => SubKey (S k1) ((:&) k2 t2) () 
(Enum k1, (~) * k1 k2) => SubKey (K k1) ((:&) k2 t2) v 
(Enum k1, (~) * k1 k2) => SubKey (K k1) ((:&) k2 t2) v 
(Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) => SubKey ((:&) k t1) ((:&) k t2) v 

d1 :: Z Source

Split after 1 key.

emm :: EnumMapMap (T1 :& T2 :& K T3) v
splitKey d1 emm :: EnumMapMap (T1 :& K T2) (EnumMapMap (K T3) v)

d2 :: N Z Source

Split after 2 keys.

emm :: EnumMapMap (T1 :& T2 :& K T3) v
splitKey d1 emm :: EnumMapMap (K T1) (EnumMapMap (T2 :& K T3) v)

d3 :: N (N Z) Source

d4 :: N (N (N Z)) Source

d5 :: N (N (N (N Z))) Source

d6 :: N (N (N (N (N Z)))) Source

d7 :: N (N (N (N (N (N Z))))) Source

d8 :: N (N (N (N (N (N (N Z)))))) Source

d9 :: N (N (N (N (N (N (N (N Z))))))) Source

d10 :: N (N (N (N (N (N (N (N (N Z)))))))) Source

Map Type

Query

Construction

Insertion

Delete/Update

Combine

Union

Difference

differenceSet :: (SubKeyS k s, IsKey k, IsKey s) => EnumMapMap k v -> EnumMapMap s () -> EnumMapMap k v Source

The difference between an EnumMapMap and an EnumMapSet. If a key is present in the EnumMapSet it will not be present in the result.

Intersection

intersectSet :: (SubKeyS k s, IsKey k, IsKey s) => EnumMapMap k v -> EnumMapMap s () -> EnumMapMap k v Source

The intersection of an EnumMapMap and an EnumMapSet. If a key is present in the EnumMapSet then it will be present in the resulting EnumMapMap. Works with EnumMapSets that are submaps of the EnumMapMap.

Map

Folds

Lists and Sets

Min/Max

Split/Join Keys

toK :: HasSKey k => Skey k -> k Source

Convert a key terminated with S into one terminated with K.

s = 1 :& 2 :& S 3
toK s == 1 :& 2 :& K 3

toS :: HasSKey k => k -> Skey k Source

Convert a key terminated with K into one terminated with S.

k = 1 :& 2 :& 'K' 3
toS k == 1 :& 2 :& 'S' 3

splitKey :: IsSplit k z => z -> EnumMapMap k v -> EnumMapMap (Head k z) (EnumMapMap (Tail k z) v) Source

Split a key so that an EnumMapMap becomes an EnumMapMap of EnumMapMaps.

newtype ID = ID Int deriving Enum
emm = empty :: EnumMapMap (Int :& K ID) Bool
res :: EnumMapMap (K ID) Bool
res = lookup (K 5) $ splitKey d1 emm

If the level is too high then the compilation will fail with an error

emm = empty :: EnumMapMap (Int :& Int :& K Int) Bool -- 3 levels
res1 = splitKey d4 emm -- ERROR! Instance not found...
res2 = splitKey d3 emm -- ERROR! Instance not found...
res3 = splitKey d2 emm -- Good