Safe Haskell | None |
---|---|
Language | Haskell2010 |
If you just want to perform operations on maps, not write your own instances, Control.Class.Map is probably what you should be importing.
This package provides a number of type-classes that encapulate the idea of a key/value mapping. This includes your standard maps, but also arrays and potentially hashtables. This library only currently provide instances for types in package that are distributed with GHC.
Part of the motivation of this library is also consistency.
Pop quiz: Consider the insert
, but don't check the documentation.
If the key already exists in the map, which of the following occurs?
- The map is unchanged.
- The value at that key is updated.
error
is called.- The result is undefined.
Personally, I had to check the documentation. The answer is actually option "2".
Imagine the potential minefield when changing collection types.
The classes in this library give explicit names for each of these behaviours, and if the implementers of those instances follow those specifications, users should be able to switch between different container types without changing their code nor their code's behaviour.
The naming convention and argument order is somewhat arbitary.
I've tried to follow existing convention but the existing convention is a bit mixed up.
For example insert
for maps is actually called upsert
in this library
because that's what it actually does.
In anycase, I'll attempt to define the broad naming convention here, but there are further details in each class.
There's a number of prefixes to function which affect expected behaviour.
- The unprefixed functions should call
error
if something is unexpected, e.g. a key already exists oninsert
or a key is not in collection ondelete
. They must not just return the structure unchanged, that is the role ofmaybe
prefixed functions. - The "unsafe" prefixed functions may optionally just behave in an undefined fashion
in the above case where one would instead
error
. For example,unsafe
functions may do array lookups without bounds checking, potentially resulting in demons if they access memory they shouldn't. - The "maybe" prefixed functions shall not call
error
if the operation can not be completed but instead return the structure unchanged. - The "safe" prefixed functions actually have a
Maybe
return type which indicate whether the key is not found/already exists on insert.
Functions suffixed with Lookup actually have a different return type and
generally allow one to access the contents of the structure before the change,
the exact form depending on the function in particular. The reason for the
Lookup suffix is that to implement these naively one can do a lookup before
performing the operation. However, for example with deleteLookup
on a map,
it would be more efficient to just lookup the element to delete, grab it and delete
it at the same time, so there is a point in overriding the default implementation.
Finally, you may notice some of the class functions that ordinarily accept a Functor
,
are renamed ending with a ..F_
, and now have the Functor
wrapped in a Coyoneda
.
This is because having Functor
s in class function defintions
does not work with generalised newtype deriving.
The versions of the functions without the following underscores, i.e. ..F
are what users should be using. When defining your own instances for these
functions, it's probably best just apply 'toCoyonedaTransform'/'toCoyonedaTransformF'
to their ordinary definitions. The non underscore style defintions run
'fromCoyonedaTransform'/'fromCoyonedaTransformF' on the class functions.
Ideally rewrite rules included in these modules should reduce this pair of
functions to id
resulting in no runtime difference.
Regarding trailing F
on the latter 'toCoyonedaTransform'/'toCoyonedaTransformF'
function, use that when defining such Coyondea
class functions which have
return types wrapped in Maybe
, namely the ones prefixed with safe...
.
To Do: Monadic versions of these functions, to be used on mutable structures for example.
Also To Do: Range lookups (and perhaps even range deletes?). In theory, for say maps, range lookups are not only possible but also faster than accessing the keys individually. But they've impossible for say hashmaps.
Pull requests welcome on github.
- type family Key t
- type family Value t
- class LookupMap t where
- class LookupMap t => SingletonMap t where
- class LookupMap t => InsertMap t where
- class LookupMap t => UpdateMap t where
- adjustF :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> f t
- unsafeAdjustF :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> f t
- safeAdjustF :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> Maybe (f t)
- class LookupMap t => DeleteMap t where
- optDeleteF :: (DeleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> f t
- unsafeOptDeleteF :: (DeleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> f t
- safeOptDeleteF :: (DeleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> Maybe (f t)
- class (InsertMap t, UpdateMap t) => UpsertMap t where
- adsertF :: (UpsertMap t, Functor f) => (Maybe (Value t) -> f (Value t)) -> Key t -> t -> f t
- class (DeleteMap t, UpdateMap t) => UpleteMap t where
- adleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> f t
- unsafeAdleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> f t
- safeAdleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> Maybe (f t)
- class (UpsertMap t, UpleteMap t) => AlterMap t where
- alterF :: (AlterMap t, Functor f) => (Maybe (Value t) -> f (Maybe (Value t))) -> Key t -> t -> f t
- newtype Strict t = Strict {
- getStrict :: t
- newtype Lazy t = Lazy {
- getLazy :: t
- (!) :: LookupMap t => t -> Key t -> Value t
- fromCoyonedaTransform :: Functor f1 => ((a1 -> Coyoneda f2 a2) -> t1 -> t2 -> Coyoneda f1 a3) -> (a1 -> f2 a2) -> t1 -> t2 -> f1 a3
- fromCoyonedaTransformF :: (Functor f1, Functor f3) => ((a1 -> Coyoneda f2 a2) -> t1 -> t2 -> f3 (Coyoneda f1 a3)) -> (a1 -> f2 a2) -> t1 -> t2 -> f3 (f1 a3)
- toCoyonedaTransform :: Functor f => (forall f'. Functor f' => (a1 -> f' a2) -> t1 -> t2 -> f' a3) -> (a1 -> Coyoneda f a2) -> t1 -> t2 -> Coyoneda f a3
- toCoyonedaTransformF :: Functor f => (forall f'. Functor f' => (a1 -> f' a2) -> t1 -> t2 -> f3 (f' a3)) -> (a1 -> Coyoneda f a2) -> t1 -> t2 -> f3 (Coyoneda f a3)
Documentation
type Key ShortByteString Source # | |
type Key ByteString Source # | |
type Key ByteString Source # | |
type Key IntSet Source # | |
type Key (IntMap v) Source # | |
type Key (Seq a) Source # | |
type Key (Set a) Source # | |
type Key (Lazy t) Source # | |
type Key (Lazy t) Source # | |
type Key (Strict t) Source # | |
type Key (Array i e) Source # | |
type Key (Map k _) Source # | |
type Value ShortByteString Source # | |
type Value ByteString Source # | |
type Value ByteString Source # | |
type Value IntSet Source # | |
type Value (IntMap v) Source # | |
type Value (Seq a) Source # | |
type Value (Set a) Source # | |
type Value (Lazy t) Source # | |
type Value (Lazy t) Source # | |
type Value (Strict t) Source # | |
type Value (Array i e) Source # | |
type Value (Map _ v) Source # | |
class LookupMap t where Source #
LookupMap
is a class that simply represents data types indexable by a key that
you can read from. Whilst obviously not enforced by the class, it's intended that
this only be implemented for types with "fast" lookups, say O(log n) at most.
Hence, LookupMap
is not implemented for list for example.
Not that Set
is an instance of this type, where the keys are just the
set values and the unit type '()' is the "value" type.
You could in theory implement LookupMap
(and indeed associated classes like UpdateMap
and AlterMap
) for structures with
multiple keys, by making the key type a sum type or a list or something.
lookup | (unsafeIndex | index), member
lookup :: Key t -> t -> Maybe (Value t) Source #
lookup k x
returns Just v
if k
is a key, Nothing
otherwise
index :: Key t -> t -> Value t Source #
Like lookup
but throws an error for values that don't exist
unsafeIndex :: Key t -> t -> Value t Source #
Like index
but may be undefined for keys that don't exist
LookupMap ShortByteString Source # | |
LookupMap ByteString Source # | |
LookupMap ByteString Source # | |
LookupMap IntSet Source # | |
LookupMap (IntMap v) Source # | |
LookupMap (Seq a) Source # | |
Ord a => LookupMap (Set a) Source # | |
(IsLazyMap t, LookupMap t) => LookupMap (Lazy t) Source # | |
LookupMap (Lazy (IntMap v)) Source # | |
Ord k => LookupMap (Lazy (Map k v)) Source # | |
(IsStrictMap t, LookupMap t) => LookupMap (Strict t) Source # | |
Ix i => LookupMap (Array i e) Source # | |
Ord k => LookupMap (Map k v) Source # | |
class LookupMap t => SingletonMap t where Source #
Data types you can produce a one element container of.
The reason why this is a separate class instead of just the default instance
is that there are contrainers where one can trivially make a singleton of
but they're not Monoid
s or AlterMap
s, i.e. you can't append or add elements to them
at arbitary keys.
For example, arrays certainly don't have the concept of "insert at key", only update, nor is it obvious how to append them, particularly if their ranges overlap.
But given a key, one should be able to produce a singleton array.
Hence this class.
SingletonMap IntSet Source # | |
SingletonMap (IntMap v) Source # | |
Ord a => SingletonMap (Set a) Source # | |
SingletonMap (Lazy (IntMap v)) Source # | |
Ord k => SingletonMap (Lazy (Map k v)) Source # | |
Ix i => SingletonMap (Array i e) Source # | |
Ord k => SingletonMap (Map k v) Source # | |
class LookupMap t => InsertMap t where Source #
InsertMap
represents types where new key-values pairs can be inserted.
insert :: Key t -> Value t -> t -> t Source #
Attempts to insert a value, calls error
if the key already exists.
unsafeInsert :: Key t -> Value t -> t -> t Source #
Like insert
, but if the key already exists the behaviour is undefined.
maybeInsert :: Key t -> Value t -> t -> t Source #
Like insert
, but if the key already exists return the structure unchanged.
safeInsert :: Key t -> Value t -> t -> Maybe t Source #
safeInsert :: UpsertMap t => Key t -> Value t -> t -> Maybe t Source #
InsertMap IntSet Source # | |
InsertMap (IntMap v) Source # | |
Ord a => InsertMap (Set a) Source # | |
(IsLazyMap t, InsertMap t) => InsertMap (Lazy t) Source # | |
InsertMap (Lazy (IntMap v)) Source # | |
Ord k => InsertMap (Lazy (Map k v)) Source # | |
(IsStrictMap t, InsertMap t) => InsertMap (Strict t) Source # | |
Ord k => InsertMap (Map k v) Source # | |
class LookupMap t => UpdateMap t where Source #
UpdateMap
represents types where existing values can be updated.
The ability for keys to be inserted or deleted is optional.
A good example of a type which conforms to this is Seq
, which
has Int
keys of which their values can be updated in "O(log n)" time.
However Seq
is not an instance of AlterMap
as although
one can insert/delete from Seq
it alters all the other indexes
which would be very unexpected.
unsafeUpdate | update | safeUpdate | safeUpdateLookup | safeAdjustLookup | safeAdjustLookup | safeAdjustF_
update :: Key t -> Value t -> t -> t Source #
Updates the value of a key, calls error
if the key does not exist.
updateLookup :: Key t -> Value t -> t -> (Value t, t) Source #
unsafeUpdate :: Key t -> Value t -> t -> t Source #
Like update
, but if the key does not exist the result is undefined.
unsafeUpdateLookup :: Key t -> Value t -> t -> (Value t, t) Source #
maybeUpdate :: Key t -> Value t -> t -> t Source #
safeUpdate :: Key t -> Value t -> t -> Maybe t Source #
safeUpdateLookup :: Key t -> Value t -> t -> Maybe (Value t, t) Source #
adjust :: (Value t -> Value t) -> Key t -> t -> t Source #
adjust f k x
applies f
to the value at key k
and puts that modified value in it's place.
If the key does not exist it should throw an error.
adjustLookup :: (Value t -> (r, Value t)) -> Key t -> t -> (r, t) Source #
adjustF_ :: Functor f => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t Source #
unsafeAdjust :: (Value t -> Value t) -> Key t -> t -> t Source #
unsafeAdjustLookup :: (Value t -> (r, Value t)) -> Key t -> t -> (r, t) Source #
unsafeAdjustF_ :: Functor f => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t Source #
maybeAdjust :: (Value t -> Value t) -> Key t -> t -> t Source #
safeAdjust :: (Value t -> Value t) -> Key t -> t -> Maybe t Source #
safeAdjustLookup :: (Value t -> (r, Value t)) -> Key t -> t -> Maybe (r, t) Source #
safeAdjustF_ :: Functor f => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Maybe (Coyoneda f t) Source #
safeAdjustF_ :: (UpsertMap t, Functor f) => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Maybe (Coyoneda f t) Source #
UpdateMap IntSet Source # | |
UpdateMap (IntMap v) Source # | |
UpdateMap (Seq a) Source # | |
Ord a => UpdateMap (Set a) Source # | |
(IsLazyMap t, UpdateMap t) => UpdateMap (Lazy t) Source # | |
UpdateMap (Lazy (IntMap v)) Source # | |
Ord k => UpdateMap (Lazy (Map k v)) Source # | |
(IsStrictMap t, UpdateMap t) => UpdateMap (Strict t) Source # | |
Ord k => UpdateMap (Map k v) Source # | |
safeAdjustF :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> Maybe (f t) Source #
class LookupMap t => DeleteMap t where Source #
DeleteMap
represents types where keys can be deleted.
delete :: Key t -> t -> t Source #
Attempt to delete a key and call error
if it's not found.
deleteLookup :: Key t -> t -> (Value t, t) Source #
Like delete
, but also return the value at the key before deletion.
unsafeDelete :: Key t -> t -> t Source #
Like delete
but if the key isn't found the result is undefined
unsafeDeleteLookup :: Key t -> t -> (Value t, t) Source #
Like deleteLookup
but if the key isn't found the result is undefined
maybeDelete :: Key t -> t -> t Source #
Like delete
, but return the structure unmodified if the key does not exist.
safeDelete :: Key t -> t -> Maybe t Source #
safeDeleteLookup :: Key t -> t -> Maybe (Value t, t) Source #
Like safeDelete
, but also return the value of the key before the delete.
optDelete :: (Value t -> Bool) -> Key t -> t -> t Source #
Attempt to optDelete a key based on it's value and call error
if it's not found.
optDeleteLookup :: (Value t -> (r, Bool)) -> Key t -> t -> (r, t) Source #
Like optDelete
, but also return the value at the key before deletion.
optDeleteF_ :: Functor f => (Value t -> Coyoneda f Bool) -> Key t -> t -> Coyoneda f t Source #
unsafeOptDelete :: (Value t -> Bool) -> Key t -> t -> t Source #
Like optDelete
but if the key isn't found the result is undefined
unsafeOptDeleteLookup :: (Value t -> (r, Bool)) -> Key t -> t -> (r, t) Source #
Like optDeleteLookup
but if the key isn't found the result is undefined
unsafeOptDeleteF_ :: Functor f => (Value t -> Coyoneda f Bool) -> Key t -> t -> Coyoneda f t Source #
maybeOptDelete :: (Value t -> Bool) -> Key t -> t -> t Source #
Like optDelete
, but return the structure unmodified if the key does not exist.
safeOptDelete :: (Value t -> Bool) -> Key t -> t -> Maybe t Source #
safeOptDeleteLookup :: (Value t -> (r, Bool)) -> Key t -> t -> Maybe (r, t) Source #
Like safeOptDelete
, but also return the value of the key before the optDelete.
safeOptDeleteF_ :: Functor f => (Value t -> Coyoneda f Bool) -> Key t -> t -> Maybe (Coyoneda f t) Source #
safeOptDeleteF_ :: (UpleteMap t, Functor f) => (Value t -> Coyoneda f Bool) -> Key t -> t -> Maybe (Coyoneda f t) Source #
DeleteMap IntSet Source # | |
DeleteMap (IntMap v) Source # | |
Ord a => DeleteMap (Set a) Source # | |
(IsLazyMap t, DeleteMap t) => DeleteMap (Lazy t) Source # | |
DeleteMap (Lazy (IntMap v)) Source # | |
Ord k => DeleteMap (Lazy (Map k v)) Source # | |
(IsStrictMap t, DeleteMap t) => DeleteMap (Strict t) Source # | |
Ord k => DeleteMap (Map k v) Source # | |
safeOptDeleteF :: (DeleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> Maybe (f t) Source #
class (InsertMap t, UpdateMap t) => UpsertMap t where Source #
Functions for doing inserts that don't fail on the keys being found but instead override existing values.
upsert :: Key t -> Value t -> t -> t Source #
upsertLookup :: Key t -> Value t -> t -> (Maybe (Value t), t) Source #
adsert :: (Maybe (Value t) -> Value t) -> Key t -> t -> t Source #
adsertLookup :: (Maybe (Value t) -> (r, Value t)) -> Key t -> t -> (r, t) Source #
adsertF_ :: Functor f => (Maybe (Value t) -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t Source #
adsertF_ :: (AlterMap t, Functor f) => (Maybe (Value t) -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t Source #
UpsertMap IntSet Source # | |
UpsertMap (IntMap v) Source # | |
Ord a => UpsertMap (Set a) Source # | |
(IsLazyMap t, UpsertMap t) => UpsertMap (Lazy t) Source # | |
UpsertMap (Lazy (IntMap v)) Source # | |
Ord k => UpsertMap (Lazy (Map k v)) Source # | |
(IsStrictMap t, UpsertMap t) => UpsertMap (Strict t) Source # | |
Ord k => UpsertMap (Map k v) Source # | |
adsertF :: (UpsertMap t, Functor f) => (Maybe (Value t) -> f (Value t)) -> Key t -> t -> f t Source #
class (DeleteMap t, UpdateMap t) => UpleteMap t where Source #
adlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> t Source #
adleteLookup :: (Value t -> (r, Maybe (Value t))) -> Key t -> t -> (r, t) Source #
adleteF_ :: Functor f => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Coyoneda f t Source #
unsafeAdlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> t Source #
unsafeAdleteLookup :: (Value t -> (r, Maybe (Value t))) -> Key t -> t -> (r, t) Source #
unsafeAdleteF_ :: Functor f => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Coyoneda f t Source #
maybeAdlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> t Source #
safeAdlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> Maybe t Source #
safeAdleteLookup :: (Value t -> (r, Maybe (Value t))) -> Key t -> t -> Maybe (r, t) Source #
safeAdleteF_ :: Functor f => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Maybe (Coyoneda f t) Source #
safeAdleteF_ :: (AlterMap t, Functor f) => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Maybe (Coyoneda f t) Source #
UpleteMap IntSet Source # | |
UpleteMap (IntMap v) Source # | |
Ord a => UpleteMap (Set a) Source # | |
(IsLazyMap t, UpleteMap t) => UpleteMap (Lazy t) Source # | |
UpleteMap (Lazy (IntMap v)) Source # | |
Ord k => UpleteMap (Lazy (Map k v)) Source # | |
(IsStrictMap t, UpleteMap t) => UpleteMap (Strict t) Source # | |
Ord k => UpleteMap (Map k v) Source # | |
adleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> f t Source #
unsafeAdleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> f t Source #
safeAdleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> Maybe (f t) Source #
class (UpsertMap t, UpleteMap t) => AlterMap t where Source #
AlterMap
is a class that represents key-value mappings where one can do
inserts, deletes, updates, pretty much everything you expect from a simple
key/value store.
alter :: (Maybe (Value t) -> Maybe (Value t)) -> Key t -> t -> t Source #
alter f k x
attempts to gets the value of the key k
.
If key k
exists, as say it is v
, it passes Just v
to f
.
If key k
does not exist, it passes Nothing
to f
.
If the result of f
is Just something
, then alter
either inserts or updates
the key k
, inserting if key k
previously didn't exist and updating if it did.
If the result of f
is Nothing
, and the key k
did exist, we deleted it.
Otherwise, if the result of f
is Nothing
, nd the key k
did not exist,
then do nothing and simply return the structure unmodified.
alterLookup :: (Maybe (Value t) -> (r, Maybe (Value t))) -> Key t -> t -> (r, t) Source #
Like alter
, but returns the value both before and after the alteration.
alterF_ :: Functor f => (Maybe (Value t) -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Coyoneda f t Source #
AlterMap IntSet Source # | |
AlterMap (IntMap v) Source # | |
Ord a => AlterMap (Set a) Source # | |
(IsLazyMap t, AlterMap t) => AlterMap (Lazy t) Source # | |
AlterMap (Lazy (IntMap v)) Source # | |
Ord k => AlterMap (Lazy (Map k v)) Source # | |
(IsStrictMap t, AlterMap t) => AlterMap (Strict t) Source # | |
Ord k => AlterMap (Map k v) Source # | |
alterF :: (AlterMap t, Functor f) => (Maybe (Value t) -> f (Maybe (Value t))) -> Key t -> t -> f t Source #
For certain types like maps in the standard containers library that ships with GHC,
the strict version of the data type: Map
,
and the lazy version of the data type: Map
,
are actually the exact same type. In this case, they're just reexports of the
same type.
That's fine when one has two separate modules with strict and lazy versions one can explicitly use, but the choice can't be automatic based on the type.
As a result, there's no way one can tell whether to use strict or
lazy functions on the data. Wrapping these types in either Strict
or Lazy
specifies how these types are intend to be worked on.
By default however, if one doesn't wrap, the Strict
version is used.
(IsStrictMap t, AlterMap t) => AlterMap (Strict t) Source # | |
(IsStrictMap t, UpleteMap t) => UpleteMap (Strict t) Source # | |
(IsStrictMap t, UpsertMap t) => UpsertMap (Strict t) Source # | |
(IsStrictMap t, DeleteMap t) => DeleteMap (Strict t) Source # | |
(IsStrictMap t, InsertMap t) => InsertMap (Strict t) Source # | |
(IsStrictMap t, UpdateMap t) => UpdateMap (Strict t) Source # | |
(IsStrictMap t, LookupMap t) => LookupMap (Strict t) Source # | |
type Value (Strict t) Source # | |
type Key (Strict t) Source # | |
fromCoyonedaTransform :: Functor f1 => ((a1 -> Coyoneda f2 a2) -> t1 -> t2 -> Coyoneda f1 a3) -> (a1 -> f2 a2) -> t1 -> t2 -> f1 a3 Source #
Hack to allow generalised newtype deriving from https://stackoverflow.com/questions/48848571/generalised-newtype-deriving-on-class-functions-with-functors/48849568#48849568
fromCoyonedaTransformF :: (Functor f1, Functor f3) => ((a1 -> Coyoneda f2 a2) -> t1 -> t2 -> f3 (Coyoneda f1 a3)) -> (a1 -> f2 a2) -> t1 -> t2 -> f3 (f1 a3) Source #