Safe Haskell | None |
---|
Data.Store
Contents
Description
Dictionary with multidimensional keys and type-safe interface.
These modules are intended to be imported qualified to avoid name clashes with prelude, e.g.:
import qualified Data.Store as S import Data.Store (M, O, (.:), (.:.), (:.), (.<), (.<=), (.>), (.>=), (./=), (.==), (.&&), (.||))
Throughout out the documentation, the examples will be based on this code:
{-# LANGUAGE TypeOperators #-} module Example01 where -------------------------------------------------------------------------------- import Control.Applicative import qualified Control.Monad.State as State -------------------------------------------------------------------------------- import qualified Data.Store as S import Data.Store (M, O, (.:), (.:.), (:.)(..), (.<), (.<=), (.>), (.>=), (./=), (.==), (.&&), (.||)) -------------------------------------------------------------------------------- data Content = Content { contentName :: String , contentBody :: String , contentTags :: [String] , contentRating :: Double } type ContentID = Int -- Content has one ID, only one content can have a given ID. -- Content has one name, only one content can have a given name. -- Content has one body, many contents can have the same content. -- Content has many tags, many contents can have the same tag. -- Content has one rating, many contents can have the same rating. data ContentStoreTag = ContentStoreTag type ContentStoreTS = ContentID :. String :. String :. String :. Double type ContentStoreKRS = O :. O :. O :. M :. O type ContentStoreIRS = O :. O :. M :. M :. M type ContentStore = S.Store ContentStoreTag ContentStoreKRS ContentStoreIRS ContentStoreTS Content type ContentStoreKey = S.Key ContentStoreKRS ContentStoreTS type ContentStoreSelection = S.Selection ContentStoreTag ContentStoreKRS ContentStoreIRS ContentStoreTS sContentID :: (ContentStoreTag, S.N0) sContentID = (ContentStoreTag, S.n0) sContentName :: (ContentStoreTag, S.N1) sContentName = (ContentStoreTag, S.n1) sContentBody :: (ContentStoreTag, S.N2) sContentBody = (ContentStoreTag, S.n2) sContentTag :: (ContentStoreTag, S.N3) sContentTag = (ContentStoreTag, S.n3) sContentRating :: (ContentStoreTag, S.N4) sContentRating = (ContentStoreTag, S.n4)
Glossary
- Key (type/value) -- refers either to the type or value of a key of the store.
- Key dimension -- refers to one dimension of a key (e.g.: article's author, article's tag). Refers to the dimension as a whole, together with its properties, etc.
- Key dimension value -- refers to some concrete value from the domain of the dimension.
- Element (type/value) -- refers either to the type or value of the elements (in literature, the term "value" is usually used, be here it would clash far too often) of the store.
The implementation is based on Data.Map, Data.Set, Data.IntMap and Data.IntSet.
The following variables and constants are used in Big-O notation:
- W -- the (constant) number of bits of Int (32 or 64).
- d -- the (constant) number of dimensions of the store.
- k -- the (variable) number of key dimensions values of a key (or
maximum of key dimension values over all keys in case of for example
).update
- s -- the (variable) size of the output of the operation or the (variable) number of elements affected by the operation. This is of then the number of key-element pairs that correspond to a selection.
- s(sel) -- the (variable) number of key-element pairs that correspond to a selection sel if sel would otherwise be ambigious.
- c -- the (variable) complexity of selection.
- c -- the (variable) complexity of selection sel if sel would otherwise be ambiguous.
- data Store tag krs irs ts v
- type Key = GenericKey KeyDimension
- data KeyDimension r t
- type family RawKey kspec tspec :: *
- data M
- data O
- data h :. t = h :. t
- class (Ord k, Enum k, Bounded k) => Auto k
- empty :: Empty a => a
- singleton :: Empty (Index irs ts) => Key krs ts -> v -> Store tag krs irs ts v
- insert :: Key krs ts -> v -> Store tag krs irs ts v -> Maybe (RawKey krs ts, Store tag krs irs ts v)
- insert' :: Key krs ts -> e -> Store tag krs irs ts e -> (RawKey krs ts, Store tag krs irs ts e)
- unsafeInsert :: Key krs ts -> e -> Store tag krs irs ts e -> (RawKey krs ts, Store tag krs irs ts e)
- updateWithKey :: IsSelection sel => (RawKey krs ts -> v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Maybe (Store tag krs irs ts v)
- updateWithKey' :: IsSelection sel => (RawKey krs ts -> v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts v
- update :: IsSelection sel => (v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Maybe (Store tag krs irs ts v)
- update' :: IsSelection sel => (v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts v
- updateElements :: IsSelection sel => (v -> Maybe v) -> sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts v
- delete :: IsSelection sel => sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts v
- map :: (v1 -> v2) -> Store tag krs irs ts v1 -> Store tag krs irs ts v2
- foldr :: (v -> b -> b) -> b -> Store tag krs irs ts v -> b
- foldrWithKey :: (RawKey krs ts -> v -> b -> b) -> b -> Store tag krs irs ts v -> b
- foldl :: (b -> v -> b) -> b -> Store tag krs irs ts v -> b
- foldlWithKey :: (b -> RawKey krs ts -> v -> b) -> b -> Store tag krs irs ts v -> b
- toList :: Store tag krs irs ts v -> [(RawKey krs ts, v)]
- elements :: Store tag krs irs ts v -> [v]
- keys :: Store tag krs irs ts v -> [RawKey krs ts]
- fromList :: Empty (Index irs ts) => [(Key krs ts, v)] -> Maybe (Store tag krs irs ts v)
- fromList' :: Empty (Index irs ts) => [(Key krs ts, v)] -> Store tag krs irs ts v
- unsafeFromList :: Empty (Index irs ts) => [(Key krs ts, v)] -> Store tag krs irs ts v
- size :: Store tag krs irs ts v -> Int
- lookup :: IsSelection sel => sel tag krs irs ts -> Store tag krs irs ts v -> [(RawKey krs ts, v)]
- data Selection tag krs irs ts
- not :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs ts
- (.<) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs ts
- (.<=) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs ts
- (.>) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs ts
- (.>=) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs ts
- (./=) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs ts
- (.==) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs ts
- (.&&) :: (IsSelection s1, IsSelection s2) => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
- (.||) :: (IsSelection s1, IsSelection s2) => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs ts
- dimA :: Auto t => KeyDimension O t
- dimO :: Ord t => t -> KeyDimension O t
- dimM :: Ord t => [t] -> KeyDimension M t
- (.:) :: dim r t -> GenericKey dim rs1 ts1 -> GenericKey dim (r :. rs1) (t :. ts1)
- (.:.) :: dim r1 t1 -> dim r2 t2 -> GenericKey dim (r1 :. r2) (t1 :. t2)
- data S n = S n
- data Z
- type N0 = Z
- type N1 = S N0
- type N2 = S N1
- type N3 = S N2
- type N4 = S N3
- type N5 = S N4
- type N6 = S N5
- type N7 = S N6
- type N8 = S N7
- type N9 = S N8
- type N10 = S N9
- n0 :: N0
- n1 :: N1
- n2 :: N2
- n3 :: N3
- n4 :: N4
- n5 :: N5
- n6 :: N6
- n7 :: N7
- n8 :: N8
- n9 :: N9
- n10 :: N10
- showIndex :: Show (Index irs ts) => Store tag krs irs ts v -> String
- printIndex :: Show (Index irs ts) => Store tag krs irs ts v -> IO ()
- moduleName :: String
Types
data Store tag krs irs ts v Source
The store data type has four type arguments that define what and how things are stored.
The krs
(key relation specification) and irs
(index relation
specification) define the relations between the dimensions of the key
and the elements. To that end, we use
and
O
type-level tags and
M
'Data.Store.Type.Internal.(:.)'
data type to create tuple of these
tags (to describe all the dimensions).
The possible relations are as follows:
- One-one: Every intem is indexed under exactly one key dimension value. One key dimension value corresponds to at most one elements.
- One-many: Every element is indexed under exactly one key dimension value. One key dimension value can correspond to many elements.
- Many-one: Every element can be indexed under multiple (zero or more) key dimension values. One key dimension value corresponds to at most one elements.
- Many-many: Every element cab be indexed under multiple (zero or more) key dimension value. One key dimension value can correspond to many elements.
The ts
(type specification) defines the type of the key's dimensions
and finally v
is the type of the elements stored.
In our example with Content
, we have five dimensions: ID, name, body,
tags and rating. We would like our store to have these properties:
-
Content
has one ID, only one content can have a given ID. -
Content
has one name, only one content can have a given name. -
Content
has one body, many contents can have the same content. -
Content
has many tags, many contents can have tte same tag. -
Content
has one rating, many contents can have the same rating.
So in our case, we define:
type ContentStoreKRS = O :. O :. O :. M :. O type ContentStoreIRS = O :. O :. M :. M :. M type ContentStoreTS = ContentID :. String :. String :. String :. Double type ContentStore = Store ContentStoreKRS ContentStoreIRS ContentStoreTS Content
See also:
Instances
Typeable5 Store | |
Functor (Store tag krs irs ts) | |
(Show (IKey krs ts), Show v) => Show (Store tag krs irs ts v) | |
Empty (Index irs ts) => Monoid (Store tag krs irs ts v) | |
(Serialize (IKey krs ts), Serialize (Index irs ts), Serialize v) => Serialize (Store tag krs irs ts v) | |
(NFData e, NFData (IKey krs ts), NFData (Index irs ts)) => NFData (Store tag krs irs ts e) | |
(SafeCopy (IKey krs ts), SafeCopy (Index irs ts), SafeCopy v) => SafeCopy (Store tag krs irs ts v) | |
Empty (Index irs ts) => Empty (Store tag krs irs ts e) |
type Key = GenericKey KeyDimensionSource
data KeyDimension r t Source
This is type-level tag for tagging dimensions of key and the index of a store.
You can think of
as an abbreviation for
many.
M
- When
dimension is tagged withKey
, it means that a single element can be indexed under multiple key dimension values. Example:M
Content
(element) has many tags. - When
dimension is tagged withIndex
, it means that a multiple elements can be indexed under a single key dimension values. Example: One rating can be shared by manyM
Content
s (elements).
See also:
Instances
GetDimension Z (Index M t) | |
Show t => Show (Index M t) | |
Show t => Show (IKey M t) | |
Show t => Show (Key M t) | |
(Ord t, Serialize t) => Serialize (IndexDimension M t) | |
(Ord t, Serialize t) => Serialize (IKeyDimension M t) | |
(Ord t, Serialize t, Serialize (Index rt tt)) => Serialize (Index (:. M rt) (:. t tt)) | |
(Ord t, Serialize t) => Serialize (Index M t) | |
NFData t => NFData (Index M t) | |
NFData t => NFData (IKey M t) | |
(Ord t, SafeCopy t) => SafeCopy (IndexDimension M t) | |
(Ord t, SafeCopy t) => SafeCopy (IKeyDimension M t) | |
(Ord t, SafeCopy t, SafeCopy (Index rt tt)) => SafeCopy (Index (:. M rt) (:. t tt)) | |
(Ord t, SafeCopy t) => SafeCopy (Index M t) | |
(Ord t, Empty (Index rt tt)) => Empty (Index (:. M rt) (:. t tt)) | |
Ord t => Empty (Index M t) | |
Serialize (dim M t) => Serialize (GenericKey dim M t) | |
SafeCopy (dim M t) => SafeCopy (GenericKey dim M t) |
This is type-level tag for tagging dimensions of key and the index of a store.
You can think of
as an abbreviation for
one.
O
- When
dimension is tagged withKey
, it means that a single element is indexed under exactly one key dimension value. Example:O
Content
(element) has exactly one title. - When
dimension is tagged withIndex
, it means that at most one element can be indexed under one key dimension value. Example: OneO
ContentID
corresponds to at most oneContent
(element).
See also:
Instances
GetDimension Z (Index O t) | |
Show t => Show (Index O t) | |
Show t => Show (IKey O t) | |
Show t => Show (Key O t) | |
(Ord t, Serialize t) => Serialize (IndexDimension O t) | |
(Ord t, Serialize t) => Serialize (IKeyDimension O t) | |
(Ord t, Serialize t, Serialize (Index rt tt)) => Serialize (Index (:. O rt) (:. t tt)) | |
(Ord t, Serialize t) => Serialize (Index O t) | |
NFData t => NFData (Index O t) | |
NFData t => NFData (IKey O t) | |
(Ord t, SafeCopy t) => SafeCopy (IndexDimension O t) | |
(Ord t, SafeCopy t) => SafeCopy (IKeyDimension O t) | |
(Ord t, SafeCopy t, SafeCopy (Index rt tt)) => SafeCopy (Index (:. O rt) (:. t tt)) | |
(Ord t, SafeCopy t) => SafeCopy (Index O t) | |
(Ord t, Empty (Index rt tt)) => Empty (Index (:. O rt) (:. t tt)) | |
Ord t => Empty (Index O t) | |
Serialize (dim O t) => Serialize (GenericKey dim O t) | |
SafeCopy (dim O t) => SafeCopy (GenericKey dim O t) |
Data type for creating tuples, it is used to:
- Create type-level tuples of relation tags for relation specification of the key and the index of the store.
M :. O :. O :. M
- Create type-level tuples of types for type specification of the key and index of the store.
Int :. Double :. String :. String
- Create value-level tuples to return raw key (with resolved auto-increment dimensions).
[1, 2, 3] :. 3.5 :. "Foo" :. ["Bar1", "Bar2"]
Constructors
h :. t |
Instances
GetDimension Z (Index (:. r rt) (:. t tt)) | |
GetDimension n (Index rt tt) => GetDimension (S n) (Index (:. r rt) (:. t tt)) | |
(Show h, Show t) => Show (:. h t) | |
(Show t, Show (Index rt tt)) => Show (Index (:. r rt) (:. t tt)) | |
(Show t, Show (IKey rt tt)) => Show (IKey (:. r rt) (:. t tt)) | |
(Show t, Show (Key rt tt)) => Show (Key (:. r rt) (:. t tt)) | |
(Ord t, Serialize t, Serialize (Index rt tt)) => Serialize (Index (:. O rt) (:. t tt)) | |
(Ord t, Serialize t, Serialize (Index rt tt)) => Serialize (Index (:. M rt) (:. t tt)) | |
(NFData a, NFData b) => NFData (:. a b) | |
(NFData t, NFData (Index rt tt)) => NFData (Index (:. r rt) (:. t tt)) | |
(NFData t, NFData (IKey rt tt)) => NFData (IKey (:. r rt) (:. t tt)) | |
(Ord t, SafeCopy t, SafeCopy (Index rt tt)) => SafeCopy (Index (:. O rt) (:. t tt)) | |
(Ord t, SafeCopy t, SafeCopy (Index rt tt)) => SafeCopy (Index (:. M rt) (:. t tt)) | |
(Ord t, Empty (Index rt tt)) => Empty (Index (:. O rt) (:. t tt)) | |
(Ord t, Empty (Index rt tt)) => Empty (Index (:. M rt) (:. t tt)) | |
(Serialize (GenericKey dim rt tt), Serialize (dim r t)) => Serialize (GenericKey dim (:. r rt) (:. t tt)) | |
(SafeCopy (GenericKey dim rt tt), SafeCopy (dim r t)) => SafeCopy (GenericKey dim (:. r rt) (:. t tt)) |
Creating
singleton :: Empty (Index irs ts) => Key krs ts -> v -> Store tag krs irs ts vSource
The expression (
) is store that contains
only the singleton
k v(k, v)
as a key-element pair.
Inserting
insert :: Key krs ts -> v -> Store tag krs irs ts v -> Maybe (RawKey krs ts, Store tag krs irs ts v)Source
The expression (
) is either
insert
k e oldNothing
if inserting the (k, e)
key-element pair would cause
a collision or (Just (rk, new)
), where rk
is the raw key of
k
and new
is store containing the same key-element pairs as old
plus
(k, e)
.
Examples:
>>>
let content = Content "name" "body" ["t1", "t2"] 0.5
>>>
insert (contentKey content) content store
> Just (1 :. "name" :. "body" :. ["t1", "t2"] :. 0.5, <updated_store>)
See also:
insert' :: Key krs ts -> e -> Store tag krs irs ts e -> (RawKey krs ts, Store tag krs irs ts e)Source
unsafeInsert :: Key krs ts -> e -> Store tag krs irs ts e -> (RawKey krs ts, Store tag krs irs ts e)Source
UNSAFE! This function can corrupt the store.
The expression (
) is unsafeInsert
k v old(rk, new)
,
where rk
is the raw key of k
and new
is a store that contains
the same key-element pairs as old
plus (k, e)
.
Any key-value pairs from old
colliding with (k, e)
will cause UNDEFINED BEHAVIOUR.
See also:
Updating
updateWithKey :: IsSelection sel => (RawKey krs ts -> v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Maybe (Store tag krs irs ts v)Source
The expression (
)
is (updateWithKey
tr sel oldJust new
) where new
is a store containing the same key-element
pairs as old
except for any key-element pairs (k, e)
that match the
selection sel
, those are updated as follows:
- If
(tr k e)
isNothing
the pair is not included innew
. * If(tr k e)
is (Just (e', Nothing)
) the pair is replaced by pair(k, e')
. * If(tr k e)
is (Just (e', Just k')
) the pair is replaced by pair(k', e')
.
If any of the updated key-element pairs would cause a collision, the
result is Nothing
.
Complexity: O(c + s * (min(n, W) + q * log n))
See also:
updateWithKey' :: IsSelection sel => (RawKey krs ts -> v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts vSource
The expression (
)
is updateWithKey'
tr sel oldnew
where new
is a store containing the same key-element
pairs as old
except for any key-element pairs (k, e)
that match the
selection sel
, those are updated as follows:
- If
(tr k e)
isNothing
the pair is not included innew
. * If(tr k e)
is (Just (e', Nothing)
) the pair is replaced by pair(k, e')
. * If(tr k e)
is (Just (e', Just k')
) the pair is replaced by pair(k', e')
.
Any pairs of the original store old
that would, after the update, cause collisons
are not included in new
.
Complexity: O(c + d * s * (min(n, W) + q * log n))
See also:
update :: IsSelection sel => (v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Maybe (Store tag krs irs ts v)Source
The expression (
) is equivalent
to (update
tr sel s
) where
(updateWithKey
tr' sel str' = (_ v -> tr v) = const tr
).
Complexity: O(c + s * (min(n, W) + q * log n))
update' :: IsSelection sel => (v -> Maybe (v, Maybe (Key krs ts))) -> sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts vSource
The expression (
) is equivalent
to (update'
tr sel s
) where
(updateWithKey'
tr' sel str' = (_ v -> tr v) = const tr
).
Complexity: O(c + d * s * (min(n, W) + q * log n))
updateElements :: IsSelection sel => (v -> Maybe v) -> sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts vSource
The expression (
) is equivalent
to (updateElements
tr sel s
) where
(update
tr' sel str' = (maybe Nothing (v -> Just (v, Nothing)) . tr)
).
Complexity: O(c + s * min(n, W))
delete :: IsSelection sel => sel tag krs irs ts -> Store tag krs irs ts v -> Store tag krs irs ts vSource
Traversing
map :: (v1 -> v2) -> Store tag krs irs ts v1 -> Store tag krs irs ts v2Source
The expression (
) is store where every element of
map
tr oldold
was transformed using the function tr
.
Folding
foldr :: (v -> b -> b) -> b -> Store tag krs irs ts v -> bSource
The expression (
) folds the store
using the given right-associative binary operator.
foldr
f z s
foldrWithKey :: (RawKey krs ts -> v -> b -> b) -> b -> Store tag krs irs ts v -> bSource
The expression (
) folds the store
using the given right-associative operator.
foldrWithKey
f z s
foldl :: (b -> v -> b) -> b -> Store tag krs irs ts v -> bSource
The expression (
) folds the store
using the given left-associative binary operator.
foldl
f z s
foldlWithKey :: (b -> RawKey krs ts -> v -> b) -> b -> Store tag krs irs ts v -> bSource
The expression (
) folds the store
using the given left-associative operator.
foldlWithKey
f z s
List
toList :: Store tag krs irs ts v -> [(RawKey krs ts, v)]Source
The expression (
) is a list of key-element pairs that are stored in toList
storestore
.
elements :: Store tag krs irs ts v -> [v]Source
The expression (
) is a list of elements that
are stored in elements
storestore
.
keys :: Store tag krs irs ts v -> [RawKey krs ts]Source
The expression (
) is a list of pairs raw
keys that are stored in keys
storestore
.
Querying
size :: Store tag krs irs ts v -> IntSource
The expression (
) is the number of elements
in size
storestore
.
lookup :: IsSelection sel => sel tag krs irs ts -> Store tag krs irs ts v -> [(RawKey krs ts, v)]Source
The expression (
) is
list of (raw key)-element pairs that match the selection.
lookup
sel store
Complexity: O(c + s * min(n, W))
Selection
Functions from this category are used to create selections.
Example:
-- Select any content with rating between 3 and 4. let sel1 = sContentRating .> 3 -- Select any content that is tagged with "haskell" or "category-theory" -- and is not tagged with "fluff". let sel2 = (sContentTag .== "haskell" .|| sContentTag .== "category-theory") .&& not' (sContentTag .== "fluff") -- Selection that is intersection of sel1 and sel2. let sel3 = sel1 .&& sel2
These selections can be then used in functions like lookup, update, delete, etc.
>>>
lookup sel3 store
> -- key-element pairs that match the selection
>>>
delete (not' sel3) store
> -- store with the key-element pairs that do not match the selection
>>>
updateElements (\v -> Just v { contentRating = 5 }) sel3 store
> -- store with the selected key-element pairs updated
not :: IsSelection sel => sel tag krs irs ts -> Selection tag krs irs tsSource
The expression (not' sel
) is a selection that includes all values
except those that match the selection sel
.
(.<) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs tsSource
The expression (sDim .< c
) is a selection that includes value
x
if and only if it is indexed in the sDim
dimension with a key k
such that k < c
.
Complexity of
: O(log n + k)
resolve
(.<=) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs tsSource
The expression (sDim .<= c
) is a selection that includes value
x
if and only if it is indexed in the sDim
dimension with a key k
such that k <= c
.
Complexity of
: O(log n + k)
resolve
(.>) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs tsSource
The expression (sDim .> c
) is a selection that includes value
x
if and only if it is indexed in the sDim
dimension with a key k
such that k > c
.
Complexity of
: O(log n + k)
resolve
(.>=) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs tsSource
The expression (sDim .>= c
) is a selection that includes value
x
if and only if it is indexed in the sDim
dimension with a key k
such that k >= c
.
Complexity of
: O(log n + k)
resolve
(./=) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs tsSource
The expression (sDim ./= c
) is a selection that includes value
x
if and only if it is indexed in the sDim
dimension with a key k
such that k /= c
.
Complexity of
: O(n)
resolve
(.==) :: GetDimension n (Index irs ts) => (tag, n) -> DimensionType n irs ts -> Selection tag krs irs tsSource
The expression (sDim .== c
) is a selection that includes value
x
if and only if it is indexed in the sDim
dimension with a key k
such that k == c
.
Complexity of
: O(log n)
resolve
(.&&) :: (IsSelection s1, IsSelection s2) => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs tsSource
The expression (s1 .&& s2
) is a selection that includes the
intersection of the selections s1
and s2
.
Complexity of
: O(c(s1) + c(s2) + s(s1) + s(s2)
resolve
(.||) :: (IsSelection s1, IsSelection s2) => s1 tag krs irs ts -> s2 tag krs irs ts -> Selection tag krs irs tsSource
The expression (s1 .|| s2
) is a selection that includes the
union of the selections s1
and s2
.
Complexity of
: O(c(s1) + c(s2) + s(s1) + s(s2)
resolve
Constructing Key
Functions from this category are used to create a key for your store. Function for
creating a key for our Content
data type could look like this:
makeContentKey :: ContentID -> String -> String -> [String] -> Double -> ContentStoreKey makeContentKey cid cn cb cts cr = S.dimO cid .: S.dimO cn .: S.dimO cb .: S.dimM cts .:. S.dimO cr
Notice that this function allows you to specify all the dimensions of the key, including the ID dimension. Usually we do not need this level of flexibility a would use function like this instead:
contentKey :: Content -> ContentStoreKey contentKey (Content cn cb cts cr) = S.dimA .: S.dimO cn .: S.dimO cb .: S.dimM cts .:. S.dimO cr
This function creates a key for given element of type Content
(element), the ID
dimension is automatic, which means that the assigned ID will be succ
max
where max
is the value of the maximum ID in the store when
inserting.
See also:
dimA :: Auto t => KeyDimension O tSource
Function for creating an auto-increment dimension. Can be used instead
of (dimO x
) if the type is an instance of the
type-class.
Auto
dimO :: Ord t => t -> KeyDimension O tSource
Function for creating dimensions with the relation "one-anything".
dimM :: Ord t => [t] -> KeyDimension M tSource
Function for creating dimensions with the relation "many-anything".
(.:) :: dim r t -> GenericKey dim rs1 ts1 -> GenericKey dim (r :. rs1) (t :. ts1)Source
Function for connecting one dimension and rest of the key.
(.:.) :: dim r1 t1 -> dim r2 t2 -> GenericKey dim (r1 :. r2) (t1 :. t2)Source
Function for connecting one dimensions with another (most often the last dimension of the key).
Utility
Type-level successor of a number.
Constructors
S n |
Instances
GetDimension n (Index rt tt) => GetDimension (S n) (Index (:. r rt) (:. t tt)) |
Type-level zero.
Instances
GetDimension Z (Index (:. r rt) (:. t tt)) | |
GetDimension Z (Index O t) | |
GetDimension Z (Index M t) |
Debugging
The name of this module.