{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-| 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 'Data.Map.Strict.insert', but don't check the documentation. If the key already exists in the map, which of the following occurs? 1. The map is unchanged. 2. The value at that key is updated. 3. 'error' is called. 4. 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 'Data.Map.Strict.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. 1. The unprefixed functions should call 'error' if something is unexpected, e.g. a key already exists on 'insert' or a key is not in collection on 'delete'. They must not just return the structure unchanged, that is the role of 'maybe' prefixed functions. 2. 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. 3. The "maybe" prefixed functions shall not call 'error' if the operation can not be completed but instead return the structure unchanged. 4. 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. -} module Control.Class.Impl.Map ( Key, Value, LookupMap(..), SingletonMap(..), InsertMap(..), UpdateMap(..), adjustF, unsafeAdjustF, safeAdjustF, DeleteMap(..), optDeleteF, unsafeOptDeleteF, safeOptDeleteF, UpsertMap(..), adsertF, UpleteMap(..), adleteF, unsafeAdleteF, safeAdleteF, AlterMap(..), alterF, Strict(..), Lazy(..), (!), fromCoyonedaTransform, fromCoyonedaTransformF, toCoyonedaTransform, toCoyonedaTransformF, ) where import qualified Data.Map.Strict import qualified Data.Map.Lazy import qualified Data.IntMap.Strict import qualified Data.IntMap.Lazy import qualified Data.Set import Data.Set (Set) import qualified Data.IntSet import Data.IntSet (IntSet) import qualified Data.Sequence import Data.Sequence (Seq) import Data.Ix (Ix) import qualified Data.Array.IArray import Prelude hiding (lookup) import qualified Control.Class.Impl.Map.CPP import Data.Maybe (fromMaybe, isJust) import Data.Functor.Identity (Identity(Identity, runIdentity)) import Data.Functor.Compose (Compose(Compose, getCompose)) import Data.Maybe.HT (toMaybe) import Data.Coerce (Coercible, coerce) import Data.Functor.Coyoneda (Coyoneda, liftCoyoneda, lowerCoyoneda) import Data.Array (Array) import qualified Data.ByteString import qualified Data.ByteString.Unsafe import qualified Data.ByteString.Lazy import qualified Data.ByteString.Short import Data.Word (Word8) import Data.Int (Int64) {-# ANN module "HLint: ignore Use if" #-} type family Key t type family Value t {-| Hack to allow generalised newtype deriving from https://stackoverflow.com/questions/48848571/generalised-newtype-deriving-on-class-functions-with-functors/48849568#48849568 -} {-# INLINE[1] fromCoyonedaTransform #-} fromCoyonedaTransform :: Functor f1 => ((a1 -> Coyoneda f2 a2) -> t1 -> t2 -> Coyoneda f1 a3) -> (a1 -> f2 a2) -> t1 -> t2 -> f1 a3 fromCoyonedaTransform g f k x = lowerCoyoneda $ g (liftCoyoneda . f) k x {-# INLINE[1] fromCoyonedaTransformF #-} fromCoyonedaTransformF :: (Functor f1, Functor f3) => ((a1 -> Coyoneda f2 a2) -> t1 -> t2 -> f3 (Coyoneda f1 a3)) -> (a1 -> f2 a2) -> t1 -> t2 -> f3 (f1 a3) fromCoyonedaTransformF g f k x = lowerCoyoneda <$> g (liftCoyoneda . f) k x {-# INLINE[1] toCoyonedaTransform #-} toCoyonedaTransform :: Functor f => (forall f'. Functor f' => (a1 -> f' a2) -> t1 -> t2 -> f' a3) -> ((a1 -> Coyoneda f a2) -> t1 -> t2 -> Coyoneda f a3) toCoyonedaTransform = id {-# INLINE[1] toCoyonedaTransformF #-} 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)) toCoyonedaTransformF = id {-# RULES -- An attempt to remove going to and from Coyonedas. "fromToCoyonedaTransform" forall (x :: forall f2' f1'. (a1 -> f2' a2) -> t1 -> t2 -> f1' a3). fromCoyonedaTransform (toCoyonedaTransform x) = x "fromToCoyonedaTransformF" forall (x :: forall f2' f1'. (a1 -> f2' a2) -> t1 -> t2 -> f3 (f1' a3)). fromCoyonedaTransformF (toCoyonedaTransformF x) = x -- How do I write these rules? Should I even write these rules? -- "fromToCoyonedaTransform" fromCoyonedaTransform . toCoyonedaTransform = id -- "fromToCoyonedaTransformF" fromCoyonedaTransformF . toCoyonedaTransformF = id #-} {-| '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 'Data.Set.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. -} class LookupMap t where {-# MINIMAL lookup | ((unsafeIndex | index), member) #-} {-| @lookup k x@ returns @Just v@ if @k@ is a key, @Nothing@ otherwise -} lookup :: Key t -> t -> Maybe (Value t) lookup k x = case member k x of True -> Just (unsafeIndex k x) False -> Nothing {-| Like 'lookup' but throws an error for values that don't exist -} index :: Key t -> t -> Value t index k x = fromMaybe (error "index: Key does not exist.") (lookup k x) {-| Like 'index' but may be undefined for keys that don't exist -} unsafeIndex :: Key t -> t -> Value t unsafeIndex = index member :: Key t -> t -> Bool member k x = isJust (lookup k x) notMember :: Key t -> t -> Bool notMember k x = not (member k x) {-| 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. -} class LookupMap t => SingletonMap t where singleton :: Key t -> Value t -> t -- default singleton :: (Monoid t, AlterMap t) => Key t -> Value t -> t -- singleton k v = insert k v mempty {-| '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 'Data.Sequence.Seq', which has 'Int' keys of which their values can be updated in "O(log n)" time. However 'Data.Sequence.Seq' is not an instance of 'AlterMap' as although one can insert/delete from 'Data.Sequence.Seq' it alters all the other indexes which would be very unexpected. -} class LookupMap t => UpdateMap t where {-# MINIMAL unsafeUpdate | update | safeUpdate | safeUpdateLookup | safeAdjustLookup | safeAdjustLookup | safeAdjustF_ #-} {-| Updates the value of a key, calls 'error' if the key does not exist. -} update :: Key t -> Value t -> t -> t update k v x = fromMaybe (error "update: Key not found.") (safeUpdate k v x) updateLookup :: Key t -> Value t -> t -> (Value t, t) updateLookup k v x = fromMaybe (error "updateLookup: Key not found.") (safeUpdateLookup k v x) {-| Like 'update', but if the key does not exist the result is undefined. -} unsafeUpdate :: Key t -> Value t -> t -> t unsafeUpdate = update unsafeUpdateLookup :: Key t -> Value t -> t -> (Value t, t) unsafeUpdateLookup = updateLookup maybeUpdate :: Key t -> Value t -> t -> t maybeUpdate k v x = fromMaybe x (safeUpdate k v x) safeUpdate :: Key t -> Value t -> t -> Maybe t safeUpdate k v x = snd <$> safeUpdateLookup k v x safeUpdateLookup :: Key t -> Value t -> t -> Maybe (Value t, t) safeUpdateLookup k v = safeAdjustLookup g k where g old_v = (old_v, v) {-| @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. -} adjust :: (Value t -> Value t) -> Key t -> t -> t adjust f k x = fromMaybe (error "Adjust: Key not found.") (safeAdjust f k x) adjustLookup :: (Value t -> (r, Value t)) -> Key t -> t -> (r, t) adjustLookup f k x = fromMaybe (error "AdjustLookup: Key not found.") (safeAdjustLookup f k x) adjustF_ :: Functor f => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t adjustF_ f k x = fromMaybe (error "AdjustF: Key not found.") (safeAdjustF_ f k x) unsafeAdjust :: (Value t -> Value t) -> Key t -> t -> t unsafeAdjust f k x = runIdentity $ unsafeAdjustF (Identity . f) k x unsafeAdjustLookup :: (Value t -> (r, Value t)) -> Key t -> t -> (r, t) unsafeAdjustLookup = unsafeAdjustF unsafeAdjustF_ :: Functor f => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t unsafeAdjustF_ = adjustF_ maybeAdjust :: (Value t -> Value t) -> Key t -> t -> t maybeAdjust f k x = fromMaybe x (safeAdjust f k x) safeAdjust :: (Value t -> Value t) -> Key t -> t -> Maybe t safeAdjust f k x = runIdentity <$> safeAdjustF (Identity . f) k x safeAdjustLookup :: (Value t -> (r, Value t)) -> Key t -> t -> Maybe (r, t) safeAdjustLookup = safeAdjustF safeAdjustF_ :: Functor f => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Maybe (Coyoneda f t) default safeAdjustF_ :: (UpsertMap t, Functor f) => (Value t -> Coyoneda f (Value t)) -> Key t -> t -> Maybe (Coyoneda f t) safeAdjustF_ = defaultSafeAdjustFBasedOnAdsertF unsafeAdjustF :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> f t unsafeAdjustF = fromCoyonedaTransform unsafeAdjustF_ adjustF :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> f t adjustF = fromCoyonedaTransform adjustF_ safeAdjustF :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> Maybe (f t) safeAdjustF = fromCoyonedaTransformF safeAdjustF_ defaultSafeAdjustFBasedOnAdsertF :: (UpsertMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> Maybe (f t) defaultSafeAdjustFBasedOnAdsertF f k x = getCompose $ adsertF (Compose . fmap f) k x defaultSafeAdjustFBasedOnUnsafeUpdate :: (UpdateMap t, Functor f) => (Value t -> f (Value t)) -> Key t -> t -> Maybe (f t) defaultSafeAdjustFBasedOnUnsafeUpdate f k x = g <$> lookup k x where g old_val = let new_x_func new_val = unsafeUpdate k new_val x in new_x_func <$> f old_val {-| 'InsertMap' represents types where new key-values pairs can be inserted. -} class LookupMap t => InsertMap t where {-# MINIMAL unsafeInsert | insert | safeInsert #-} {-| Attempts to insert a value, calls 'error' if the key already exists. -} insert :: Key t -> Value t -> t -> t insert k v x = fromMaybe (error "Insert: Key already exists.") (safeInsert k v x) {-| Like 'insert', but if the key already exists the behaviour is undefined. -} unsafeInsert :: Key t -> Value t -> t -> t unsafeInsert = insert {-| Like 'insert', but if the key already exists return the structure unchanged. -} maybeInsert :: Key t -> Value t -> t -> t maybeInsert k v x = fromMaybe x (safeInsert k v x) {-| Like 'insert', but if the key already exists return 'Nothing'. -} safeInsert :: Key t -> Value t -> t -> Maybe t default safeInsert :: UpsertMap t => Key t -> Value t -> t -> Maybe t safeInsert = defaultSafeInsertBasedOnAdsertF defaultSafeInsertBasedOnAdsertF :: UpsertMap t => Key t -> Value t -> t -> Maybe t defaultSafeInsertBasedOnAdsertF k v = adsertF (fmap (const v)) k {-| 'DeleteMap' represents types where keys can be deleted. -} class LookupMap t => DeleteMap t where {-# MINIMAL unsafeDelete | delete | safeDelete | safeDeleteLookup #-} {-| Attempt to delete a key and call 'error' if it's not found. -} delete :: Key t -> t -> t delete k x = fromMaybe (error "delete: key not found.") (safeDelete k x) {-| Like 'delete', but also return the value at the key before deletion. -} deleteLookup :: Key t -> t -> (Value t, t) deleteLookup k x = fromMaybe (error "deleteLookup: key not found.") (safeDeleteLookup k x) {-| Like 'delete' but if the key isn't found the result is undefined -} unsafeDelete :: Key t -> t -> t unsafeDelete = delete {-| Like 'deleteLookup' but if the key isn't found the result is undefined -} unsafeDeleteLookup :: Key t -> t -> (Value t, t) unsafeDeleteLookup = deleteLookup {-| Like 'delete', but return the structure unmodified if the key does not exist. -} maybeDelete :: Key t -> t -> t maybeDelete k x = fromMaybe x (safeDelete k x) {-| Like 'delete', but return 'Nothing' the key does not exist. -} safeDelete :: Key t -> t -> Maybe t safeDelete k x = snd <$> safeDeleteLookup k x {-| Like 'safeDelete', but also return the value of the key before the delete. -} safeDeleteLookup :: Key t -> t -> Maybe (Value t, t) safeDeleteLookup = safeOptDeleteLookup g where g val = (val, True) {-| Attempt to optDelete a key based on it's value and call 'error' if it's not found. -} optDelete :: (Value t -> Bool) -> Key t -> t -> t optDelete f k x = fromMaybe (error "optDelete: key not found.") (safeOptDelete f k x) {-| Like 'optDelete', but also return the value at the key before deletion. -} optDeleteLookup :: (Value t -> (r, Bool)) -> Key t -> t -> (r, t) optDeleteLookup f k x = fromMaybe (error "optDeleteLookup: key not found.") (safeOptDeleteLookup f k x) optDeleteF_ :: Functor f => (Value t -> Coyoneda f Bool) -> Key t -> t -> Coyoneda f t optDeleteF_ f k x = fromMaybe (error "optDeleteF: key not found.") (safeOptDeleteF f k x) {-| Like 'optDelete' but if the key isn't found the result is undefined -} unsafeOptDelete :: (Value t -> Bool) -> Key t -> t -> t unsafeOptDelete f k x = runIdentity $ unsafeOptDeleteF (Identity . f) k x {-| Like 'optDeleteLookup' but if the key isn't found the result is undefined -} unsafeOptDeleteLookup :: (Value t -> (r, Bool)) -> Key t -> t -> (r, t) unsafeOptDeleteLookup = unsafeOptDeleteF unsafeOptDeleteF_ :: Functor f => (Value t -> Coyoneda f Bool) -> Key t -> t -> Coyoneda f t unsafeOptDeleteF_ = optDeleteF {-| Like 'optDelete', but return the structure unmodified if the key does not exist. -} maybeOptDelete :: (Value t -> Bool) -> Key t -> t -> t maybeOptDelete f k x = fromMaybe x (safeOptDelete f k x) {-| Like 'optDelete', but return 'Nothing' the key does not exist. -} safeOptDelete :: (Value t -> Bool) -> Key t -> t -> Maybe t safeOptDelete f k x = runIdentity <$> safeOptDeleteF (Identity . f) k x {-| Like 'safeOptDelete', but also return the value of the key before the optDelete. -} safeOptDeleteLookup :: (Value t -> (r, Bool)) -> Key t -> t -> Maybe (r, t) safeOptDeleteLookup = safeOptDeleteF safeOptDeleteF_ :: Functor f => (Value t -> Coyoneda f Bool) -> Key t -> t -> Maybe (Coyoneda f t) default safeOptDeleteF_ :: (UpleteMap t, Functor f) => (Value t -> Coyoneda f Bool) -> Key t -> t -> Maybe (Coyoneda f t) safeOptDeleteF_ = defaultOptDeleteFBasedOnSafeAdleteF unsafeOptDeleteF :: (DeleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> f t unsafeOptDeleteF = fromCoyonedaTransform unsafeOptDeleteF_ optDeleteF :: (DeleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> f t optDeleteF = fromCoyonedaTransform optDeleteF_ safeOptDeleteF :: (DeleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> Maybe (f t) safeOptDeleteF = fromCoyonedaTransformF safeOptDeleteF_ defaultOptDeleteFBasedOnSafeAdleteF :: (UpleteMap t, Functor f) => (Value t -> f Bool) -> Key t -> t -> Maybe (f t) defaultOptDeleteFBasedOnSafeAdleteF f = safeAdleteF g where g val = (`toMaybe` val) <$> f val {-| Functions for doing inserts that don't fail on the keys being found but instead override existing values. -} class (InsertMap t, UpdateMap t) => UpsertMap t where upsert :: Key t -> Value t -> t -> t upsert k v x = snd (upsertLookup k v x) upsertLookup :: Key t -> Value t -> t -> (Maybe (Value t), t) upsertLookup k v = adsertLookup g k where g old_v = (old_v, v) adsert :: (Maybe (Value t) -> Value t) -> Key t -> t -> t adsert f k x = snd $ adsertLookup g k x where g maybe_old_v = ((), f maybe_old_v) adsertLookup :: (Maybe (Value t) -> (r, Value t)) -> Key t -> t -> (r, t) adsertLookup = adsertF adsertF_ :: Functor f => (Maybe (Value t) -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t default adsertF_ :: (AlterMap t, Functor f) => (Maybe (Value t) -> Coyoneda f (Value t)) -> Key t -> t -> Coyoneda f t adsertF_ = defaultAdsertFBasedOnAlterF adsertF :: (UpsertMap t, Functor f) => (Maybe (Value t) -> f (Value t)) -> Key t -> t -> f t adsertF = fromCoyonedaTransform adsertF_ defaultAdsertFBasedOnAlterF :: (AlterMap t, Functor f) => (Maybe (Value t) -> f (Value t)) -> Key t -> t -> f t defaultAdsertFBasedOnAlterF f = alterF (fmap Just . f) class (DeleteMap t, UpdateMap t) => UpleteMap t where adlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> t adlete f k x = fromMaybe (error "Adlete: Key not found.") (safeAdlete f k x) adleteLookup :: (Value t -> (r, Maybe (Value t))) -> Key t -> t -> (r, t) adleteLookup f k x = fromMaybe (error "AdleteLookup: Key not found.") (safeAdleteLookup f k x) adleteF_ :: Functor f => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Coyoneda f t adleteF_ f k x = fromMaybe (error "AdleteF: Key not found.") (safeAdleteF_ f k x) unsafeAdlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> t unsafeAdlete f k x = runIdentity $ unsafeAdleteF (Identity . f) k x unsafeAdleteLookup :: (Value t -> (r, Maybe (Value t))) -> Key t -> t -> (r, t) unsafeAdleteLookup = unsafeAdleteF unsafeAdleteF_ :: Functor f => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Coyoneda f t unsafeAdleteF_ = adleteF maybeAdlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> t maybeAdlete f k x = fromMaybe x (safeAdlete f k x) safeAdlete :: (Value t -> Maybe (Value t)) -> Key t -> t -> Maybe t safeAdlete f k x = runIdentity <$> safeAdleteF (Identity . f) k x safeAdleteLookup :: (Value t -> (r, Maybe (Value t))) -> Key t -> t -> Maybe (r, t) safeAdleteLookup = safeAdleteF safeAdleteF_ :: Functor f => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Maybe (Coyoneda f t) default safeAdleteF_ :: (AlterMap t, Functor f) => (Value t -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Maybe (Coyoneda f t) safeAdleteF_ = defaultSafeAdleteFBasedOnAlterF safeAdleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> Maybe (f t) safeAdleteF = fromCoyonedaTransformF safeAdleteF_ unsafeAdleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> f t unsafeAdleteF = fromCoyonedaTransform unsafeAdleteF_ adleteF :: (UpleteMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> f t adleteF = fromCoyonedaTransform adleteF_ defaultSafeAdleteFBasedOnAlterF :: (AlterMap t, Functor f) => (Value t -> f (Maybe (Value t))) -> Key t -> t -> Maybe (f t) defaultSafeAdleteFBasedOnAlterF f k x = getCompose $ alterF (Compose . fmap f) k x {-| '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. -} class (UpsertMap t, UpleteMap t) => AlterMap t where {-| @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. -} alter :: (Maybe (Value t) -> Maybe (Value t)) -> Key t -> t -> t alter f k x = let g v = ((), f v) in snd (alterLookup g k x) {-| Like 'alter', but returns the value both before and after the alteration. -} alterLookup :: (Maybe (Value t) -> (r, Maybe (Value t))) -> Key t -> t -> (r, t) alterLookup = alterF alterF_ :: Functor f => (Maybe (Value t) -> Coyoneda f (Maybe (Value t))) -> Key t -> t -> Coyoneda f t alterF_ = defaultAlterFBasedOnUnsafeInsertUpdateDelete alterF :: (AlterMap t, Functor f) => (Maybe (Value t) -> f (Maybe (Value t))) -> Key t -> t -> f t alterF = fromCoyonedaTransform alterF_ defaultAlterFBasedOnUnsafeInsertUpdateDelete :: (InsertMap t, UpdateMap t, DeleteMap t, Functor f) => (Maybe (Value t) -> f (Maybe (Value t))) -> Key t -> t -> f t defaultAlterFBasedOnUnsafeInsertUpdateDelete f k x = let maybe_old_val = lookup k x new_x_func = case maybe_old_val of Nothing -> \maybe_new_val -> case maybe_new_val of Nothing -> x Just new_val -> unsafeInsert k new_val x Just _ -> \maybe_new_val -> case maybe_new_val of Nothing -> unsafeDelete k x Just new_val -> unsafeUpdate k new_val x in new_x_func <$> f maybe_old_val {-| 'AppendMap' is a class describing key-value stores where one can add a value to container without giving a key, and the container will automatically generate a key that doesn't exist in the container. 'Data.Sequence.Seq' is a good example of a structure with this ability. Again, it's intended for this to only be defined when the operation is "fast", say "O(log n)" on average or less. -} class LookupMap t => AppendMap t where {-| @appendGetKey v x@ adds the value @v@ to @x@ and returns both the updated @x@ and the new key @k@ selected. -} appendGetKey :: Value t -> t -> (Key t, t) {-| Like 'appendGetKey' but don't worry about returning the key. -} append :: Value t -> t -> t append v x = snd (appendGetKey v x) {-| For certain types like maps in the standard containers library that ships with GHC, the strict version of the data type: 'Data.Map.Strict.Map', and the lazy version of the data type: 'Data.Map.Lazy.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. -} newtype Strict t = Strict { getStrict :: t } {-| See 'Strict' documentation for a discussion of the 'Lazy' wrapper. -} newtype Lazy t = Lazy { getLazy :: t } class IsStrictMap t class IsLazyMap t type instance Key (Strict t) = Key t type instance Value (Strict t) = Value t type instance Key (Lazy t) = Key t type instance Value (Lazy t) = Value t instance IsStrictMap t => IsStrictMap (Strict t) deriving instance {-# OVERLAPPABLE #-} (IsStrictMap t, LookupMap t) => LookupMap (Strict t) deriving instance {-# OVERLAPPABLE #-} (IsStrictMap t, InsertMap t) => InsertMap (Strict t) deriving instance {-# OVERLAPPABLE #-} (IsStrictMap t, UpdateMap t) => UpdateMap (Strict t) deriving instance {-# OVERLAPPABLE #-} (IsStrictMap t, DeleteMap t) => DeleteMap (Strict t) deriving instance {-# OVERLAPPABLE #-} (IsStrictMap t, UpsertMap t) => UpsertMap (Strict t) deriving instance {-# OVERLAPPABLE #-} (IsStrictMap t, UpleteMap t) => UpleteMap (Strict t) deriving instance {-# OVERLAPPABLE #-} (IsStrictMap t, AlterMap t) => AlterMap (Strict t) type instance Key (Lazy t) = Key t type instance Value (Lazy t) = Value t instance IsLazyMap t => IsLazyMap (Lazy t) deriving instance {-# OVERLAPPABLE #-} (IsLazyMap t, LookupMap t) => LookupMap (Lazy t) deriving instance {-# OVERLAPPABLE #-} (IsLazyMap t, InsertMap t) => InsertMap (Lazy t) deriving instance {-# OVERLAPPABLE #-} (IsLazyMap t, UpdateMap t) => UpdateMap (Lazy t) deriving instance {-# OVERLAPPABLE #-} (IsLazyMap t, DeleteMap t) => DeleteMap (Lazy t) deriving instance {-# OVERLAPPABLE #-} (IsLazyMap t, UpsertMap t) => UpsertMap (Lazy t) deriving instance {-# OVERLAPPABLE #-} (IsLazyMap t, UpleteMap t) => UpleteMap (Lazy t) deriving instance {-# OVERLAPPABLE #-} (IsLazyMap t, AlterMap t) => AlterMap (Lazy t) unwrapCoerce1 :: (Coercible (f t2) t2) => (t1 -> t2 -> t3) -> t1 -> f t2 -> t3 unwrapCoerce1 f = g where g x1 x2 = f x1 (coerce x2) rewrapCoerce1 :: (Coercible (f t2) t2, Coercible t3 (f t3)) => (t1 -> t2 -> t3) -> t1 -> f t2 -> f t3 rewrapCoerce1 f = g where g x1 x2 = coerce (f x1 (coerce x2)) rewrapCoerce2 :: (Coercible (f t3) t3, Coercible t4 (f t4)) => (t1 -> t2 -> t3 -> t4) -> t1 -> t2 -> f t3 -> f t4 rewrapCoerce2 f = g where g x1 x2 x3 = coerce (f x1 x2 (coerce x3)) rewrapCoerce2F :: (Coercible (f t3) t3, Coercible t4 (f t4), Functor g) => (t1 -> t2 -> t3 -> g t4) -> t1 -> t2 -> f t3 -> g (f t4) rewrapCoerce2F f = g where g x1 x2 x3 = coerce <$> f x1 x2 (coerce x3) type instance Key (Data.Map.Strict.Map k _) = k type instance Value (Data.Map.Strict.Map _ v) = v instance IsStrictMap (Data.Map.Strict.Map k v) instance Ord k => SingletonMap (Data.Map.Strict.Map k v) where singleton = Data.Map.Strict.singleton instance Ord k => LookupMap (Data.Map.Strict.Map k v) where lookup = Data.Map.Strict.lookup index = flip (Data.Map.Strict.!) member = Data.Map.Strict.member notMember = Data.Map.Strict.notMember instance Ord k => InsertMap (Data.Map.Strict.Map k v) where unsafeInsert = Data.Map.Strict.insert instance Ord k => UpdateMap (Data.Map.Strict.Map k v) where unsafeUpdate = Data.Map.Strict.insert unsafeAdjust = Data.Map.Strict.adjust maybeAdjust = Data.Map.Strict.adjust instance Ord k => DeleteMap (Data.Map.Strict.Map k v) where unsafeDelete = Data.Map.Strict.delete maybeDelete = Data.Map.Strict.delete instance Ord k => UpsertMap (Data.Map.Strict.Map k v) where upsert = Data.Map.Strict.insert instance Ord k => UpleteMap (Data.Map.Strict.Map k v) where adlete = Data.Map.Strict.update instance Ord k => AlterMap (Data.Map.Strict.Map k v) where alter = Data.Map.Strict.alter alterF_ = toCoyonedaTransform Data.Map.Strict.alterF instance Ord k => LookupMap (Lazy (Data.Map.Lazy.Map k v)) where lookup = unwrapCoerce1 Data.Map.Lazy.lookup index = unwrapCoerce1 $ flip (Data.Map.Lazy.!) member = unwrapCoerce1 Data.Map.Lazy.member notMember = unwrapCoerce1 Data.Map.Lazy.notMember instance Ord k => SingletonMap (Lazy (Data.Map.Lazy.Map k v)) where singleton k v = Lazy (Data.Map.Lazy.singleton k v) instance Ord k => InsertMap (Lazy (Data.Map.Lazy.Map k v)) where unsafeInsert = rewrapCoerce2 Data.Map.Lazy.insert instance Ord k => UpdateMap (Lazy (Data.Map.Lazy.Map k v)) where unsafeUpdate = rewrapCoerce2 Data.Map.Lazy.insert unsafeAdjust = rewrapCoerce2 Data.Map.Lazy.adjust maybeAdjust = rewrapCoerce2 Data.Map.Lazy.adjust instance Ord k => DeleteMap (Lazy (Data.Map.Lazy.Map k v)) where unsafeDelete = rewrapCoerce1 Data.Map.Lazy.delete maybeDelete = rewrapCoerce1 Data.Map.Lazy.delete instance Ord k => UpsertMap (Lazy (Data.Map.Lazy.Map k v)) where upsert = rewrapCoerce2 Data.Map.Lazy.insert instance Ord k => UpleteMap (Lazy (Data.Map.Lazy.Map k v)) where adlete = rewrapCoerce2 Data.Map.Lazy.update instance Ord k => AlterMap (Lazy (Data.Map.Lazy.Map k v)) where alter = rewrapCoerce2 Data.Map.Lazy.alter alterF_ = toCoyonedaTransform (rewrapCoerce2F Data.Map.Lazy.alterF) type instance Key (Data.IntMap.Strict.IntMap v) = Int type instance Value (Data.IntMap.Strict.IntMap v) = v instance IsStrictMap (Data.IntMap.Strict.IntMap v) instance LookupMap (Data.IntMap.Strict.IntMap v) where lookup = Data.IntMap.Strict.lookup index = flip (Data.IntMap.Strict.!) member = Data.IntMap.Strict.member notMember = Data.IntMap.Strict.notMember instance SingletonMap (Data.IntMap.Strict.IntMap v) where singleton = Data.IntMap.Strict.singleton instance InsertMap (Data.IntMap.Strict.IntMap v) where unsafeInsert = Data.IntMap.Strict.insert instance UpdateMap (Data.IntMap.Strict.IntMap v) where unsafeUpdate = Data.IntMap.Strict.insert unsafeAdjust = Data.IntMap.Strict.adjust maybeAdjust = Data.IntMap.Strict.adjust instance DeleteMap (Data.IntMap.Strict.IntMap v) where unsafeDelete = Data.IntMap.Strict.delete maybeDelete = Data.IntMap.Strict.delete instance UpsertMap (Data.IntMap.Strict.IntMap v) where upsert = Data.IntMap.Strict.insert instance UpleteMap (Data.IntMap.Strict.IntMap v) where adlete = Data.IntMap.Strict.update instance AlterMap (Data.IntMap.Strict.IntMap v) where alter = Data.IntMap.Strict.alter alterF_ = toCoyonedaTransform Data.IntMap.Strict.alterF instance LookupMap (Lazy (Data.IntMap.Lazy.IntMap v)) where lookup = unwrapCoerce1 Data.IntMap.Lazy.lookup index = unwrapCoerce1 $ flip (Data.IntMap.Lazy.!) member = unwrapCoerce1 Data.IntMap.Lazy.member notMember = unwrapCoerce1 Data.IntMap.Lazy.notMember instance SingletonMap (Lazy (Data.IntMap.Lazy.IntMap v)) where singleton k v = Lazy $ Data.IntMap.Lazy.singleton k v instance InsertMap (Lazy (Data.IntMap.Lazy.IntMap v)) where unsafeInsert = rewrapCoerce2 Data.IntMap.Lazy.insert instance UpdateMap (Lazy (Data.IntMap.Lazy.IntMap v)) where unsafeUpdate = rewrapCoerce2 Data.IntMap.Lazy.insert unsafeAdjust = rewrapCoerce2 Data.IntMap.Lazy.adjust maybeAdjust = rewrapCoerce2 Data.IntMap.Lazy.adjust instance DeleteMap (Lazy (Data.IntMap.Lazy.IntMap v)) where unsafeDelete = rewrapCoerce1 Data.IntMap.Lazy.delete maybeDelete = rewrapCoerce1 Data.IntMap.Lazy.delete instance UpsertMap (Lazy (Data.IntMap.Lazy.IntMap v)) where upsert = rewrapCoerce2 Data.IntMap.Lazy.insert instance UpleteMap (Lazy (Data.IntMap.Lazy.IntMap v)) where adlete = rewrapCoerce2 Data.IntMap.Lazy.update instance AlterMap (Lazy (Data.IntMap.Lazy.IntMap v)) where alter = rewrapCoerce2 Data.IntMap.Lazy.alter alterF_ = toCoyonedaTransform (rewrapCoerce2F Data.IntMap.Lazy.alterF) type instance Key (Set a) = a type instance Value (Set a) = () {- I've made 'Set's both strict and lazy. Why? Well all maps are assumed to have strict keys. Strict maps store strict values, and lazy maps store lazy values. But what does this mean? Strict maps will not store completely unevaluated thunks as values, they will evaluate them to at least WHNF. Lazy maps will not evaluate their value arguments at all. What do sets do? Well sets have a fake value type, '()'. They essentially only store keys, not values. Are they strict value wise? Well yes in a sense that they don't store unevaluated thunks. Are they lazy value wise? Well yes as they don't evalute their value arguments (they don't really have any). In the end this is largely academic I suspect anyway. -} instance IsStrictMap (Set a) instance IsLazyMap (Set a) instance Ord a => SingletonMap (Set a) where singleton k _ = Data.Set.singleton k instance Ord a => LookupMap (Set a) where lookup k x = toMaybe (member k x) () member = Data.Set.member index k x = if member k x then () else error "Class 'LookupMap', instance 'Set', function 'index': Index not found." unsafeIndex _ _ = () instance Ord a => InsertMap (Set a) where unsafeInsert k _ = Data.Set.insert k {-| Note that 'Data.Set.insert' may replace a key with an "equal" key i.e. on that is equal under '(==)' of the 'Eq' class. So technically this function may returned a modified set even if the key is already in the set. But I don't think this is an unreasonable violation of the specification. -} maybeInsert k _ = Data.Set.insert k instance Ord a => DeleteMap (Set a) where unsafeDelete = Data.Set.delete maybeDelete = Data.Set.delete instance Ord a => UpdateMap (Set a) where unsafeUpdate _ _ = id unsafeAdjust _ _ = id instance Ord a => UpsertMap (Set a) where upsert k _ = Data.Set.insert k instance Ord a => UpleteMap (Set a) instance Ord a => AlterMap (Set a) type instance Key IntSet = Int type instance Value IntSet = () instance SingletonMap IntSet where singleton k _ = Data.IntSet.singleton k instance LookupMap IntSet where lookup k x = toMaybe (member k x) () member = Data.IntSet.member index k x = case member k x of True -> () False -> error "Class 'LookupMap', instance 'IntSet', function 'index': Index not found." unsafeIndex _ _ = () instance InsertMap IntSet where unsafeInsert k _ = Data.IntSet.insert k maybeInsert k _ = Data.IntSet.insert k instance DeleteMap IntSet where unsafeDelete = Data.IntSet.delete maybeDelete = Data.IntSet.delete instance UpdateMap IntSet where unsafeUpdate _ _ x = x unsafeAdjust _ _ x = x instance UpsertMap IntSet where upsert k _ = Data.IntSet.insert k instance UpleteMap IntSet instance AlterMap IntSet type instance Key (Seq a) = Int type instance Value (Seq a) = a instance LookupMap (Seq a) where lookup = Control.Class.Impl.Map.CPP.seqLookup index = flip Data.Sequence.index member k x = 0 <= k && k < length x instance UpdateMap (Seq a) where unsafeAdjust = Data.Sequence.adjust' maybeAdjust = Data.Sequence.adjust' unsafeUpdate = Data.Sequence.update maybeUpdate = Data.Sequence.update safeAdjustF_ = defaultSafeAdjustFBasedOnUnsafeUpdate instance AppendMap (Seq a) where append v x = x Data.Sequence.|> v appendGetKey v x = (Data.Sequence.length x, append v x) type instance Key (Array i e) = i type instance Value (Array i e) = e instance IsLazyMap (Array i e) instance Ix i => LookupMap (Array i e) where index = flip (Data.Array.IArray.!) member k x = let (lbound, ubound) = Data.Array.IArray.bounds x in (lbound <= k && k <= ubound) instance Ix i => SingletonMap (Array i e) where singleton k v = Data.Array.IArray.array (k,k) [(k,v)] type instance Key Data.ByteString.ByteString = Int type instance Value Data.ByteString.ByteString = Word8 instance LookupMap Data.ByteString.ByteString where index = flip Data.ByteString.index member k x = 0 <= k && k < Data.ByteString.length x unsafeIndex = flip Data.ByteString.Unsafe.unsafeIndex type instance Key Data.ByteString.Lazy.ByteString = Int64 type instance Value Data.ByteString.Lazy.ByteString = Word8 instance LookupMap Data.ByteString.Lazy.ByteString where index = flip Data.ByteString.Lazy.index member k x = 0 <= k && k < Data.ByteString.Lazy.length x type instance Key Data.ByteString.Short.ShortByteString = Int type instance Value Data.ByteString.Short.ShortByteString = Word8 instance LookupMap Data.ByteString.Short.ShortByteString where index = flip Data.ByteString.Short.index member k x = 0 <= k && k < Data.ByteString.Short.length x (!) :: LookupMap t => t -> Key t -> Value t (!) = flip index