data-store-0.3.0.4: Type safe, in-memory dictionary with multidimensional keys.

Safe HaskellNone

Data.Store.Internal.Type

Synopsis

Documentation

data M Source

This is type-level tag for tagging dimensions of key and the index of a store. You can think of M as an abbreviation for many.

  • When Key dimension is tagged with M, it means that a single element can be indexed under multiple key dimension values. Example: Content (element) has many tags.
  • When Index dimension is tagged with M, it means that a multiple elements can be indexed under a single key dimension values. Example: One rating can be shared by many Contents (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) 

data O Source

This is type-level tag for tagging dimensions of key and the index of a store. You can think of O as an abbreviation for one.

  • When Key dimension is tagged with O, it means that a single element is indexed under exactly one key dimension value. Example: Content (element) has exactly one title.
  • When Index dimension is tagged with O, it means that at most one element can be indexed under one key dimension value. Example: One ContentID corresponds to at most one Content (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 Z Source

Type-level zero.

Constructors

Z 

Instances

GetDimension Z (Index (:. r rt) (:. t tt)) 
GetDimension Z (Index O t) 
GetDimension Z (Index M t) 

data S n Source

Type-level successor of a number.

Constructors

S n 

Instances

GetDimension n (Index rt tt) => GetDimension (S n) (Index (:. r rt) (:. t tt)) 

type N0 = ZSource

type N1 = S N0Source

type N2 = S N1Source

type N3 = S N2Source

type N4 = S N3Source

type N5 = S N4Source

type N6 = S N5Source

type N7 = S N6Source

type N8 = S N7Source

type N9 = S N8Source

type N10 = S N9Source

type family DimensionRelation n rs ts :: *Source

type family DimensionType n rs ts :: *Source

type family RawDimensionType n a :: *Source

type family RawKey kspec tspec :: *Source

The pupose of the RawKey type family is to derive a type of a "raw key" that is easier to pattern match against than Key.

Example:

 RawKey (O :. O :. O :. M :. O) (ContentID :. String :. String :. String :. Double) ~ (ContentID :. String :. String :. [String] :. Double)

class (Ord k, Enum k, Bounded k) => Auto k Source

Instances

(Ord k, Enum k, Bounded k) => Auto k 

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 O and M type-level tags and '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:

  • O
  • M
  • 'Data.Store.Internal.Type.(:.)'
  • Key

Constructors

Store 

Fields

storeV :: !(IntMap (IKey krs ts, v))
 
storeI :: !(Index irs ts)
 
storeNID :: !Int
 

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) 

data GenericKey dim rs ts whereSource

Constructors

KN :: !(dim r t) -> !(GenericKey dim rt tt) -> GenericKey dim (r :. rt) (t :. tt) 
K1 :: !(dim r t) -> GenericKey dim r t 

Instances

Typeable2 (GenericKey dim) 
(Show t, Show (IKey rt tt)) => Show (IKey (:. r rt) (:. t tt)) 
Show t => Show (IKey O t) 
Show t => Show (IKey M t) 
(Show t, Show (Key rt tt)) => Show (Key (:. r rt) (:. t tt)) 
Show t => Show (Key O t) 
Show t => Show (Key M t) 
(NFData t, NFData (IKey rt tt)) => NFData (IKey (:. r rt) (:. t tt)) 
NFData t => NFData (IKey O t) 
NFData t => NFData (IKey M t) 
Eq (GenericKey IKeyDimension rs ts) 
(Serialize (GenericKey dim rt tt), Serialize (dim r t)) => Serialize (GenericKey dim (:. r rt) (:. t tt)) 
Serialize (dim M t) => Serialize (GenericKey dim M t) 
Serialize (dim O t) => Serialize (GenericKey dim O t) 
(SafeCopy (GenericKey dim rt tt), SafeCopy (dim r t)) => SafeCopy (GenericKey dim (:. r rt) (:. t tt)) 
SafeCopy (dim M t) => SafeCopy (GenericKey dim M t) 
SafeCopy (dim O t) => SafeCopy (GenericKey dim O t) 

data Index rs ts whereSource

Constructors

IN :: Ord t => !(IndexDimension r t) -> !(Index rt tt) -> Index (r :. rt) (t :. tt) 
I1 :: Ord t => !(IndexDimension r t) -> Index r t 

Instances

Typeable2 Index 
GetDimension Z (Index (:. r rt) (:. t tt)) 
GetDimension Z (Index O t) 
GetDimension Z (Index M t) 
GetDimension n (Index rt tt) => GetDimension (S n) (Index (:. r rt) (:. t tt)) 
(Show t, Show (Index rt tt)) => Show (Index (:. r rt) (:. t tt)) 
Show t => Show (Index O t) 
Show t => Show (Index M t) 
(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)) 
(Ord t, Serialize t) => Serialize (Index O t) 
(Ord t, Serialize t) => Serialize (Index M t) 
(NFData t, NFData (Index rt tt)) => NFData (Index (:. r rt) (:. t tt)) 
NFData t => NFData (Index O t) 
NFData t => NFData (Index M t) 
(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, SafeCopy t) => SafeCopy (Index O t) 
(Ord t, SafeCopy t) => SafeCopy (Index M t) 
(Ord t, Empty (Index rt tt)) => Empty (Index (:. O rt) (:. t tt)) 
(Ord t, Empty (Index rt tt)) => Empty (Index (:. M rt) (:. t tt)) 
Ord t => Empty (Index O t) 
Ord t => Empty (Index M t) 

data KeyDimension r t whereSource

Constructors

KeyDimensionO :: Ord t => t -> KeyDimension O t 
KeyDimensionM :: Ord t => [t] -> KeyDimension M t 
KeyDimensionA :: Auto t => KeyDimension O t 

Instances

Typeable2 KeyDimension 
Show t => Show (KeyDimension r t) 
(Show t, Show (Key rt tt)) => Show (Key (:. r rt) (:. t tt)) 
Show t => Show (Key O t) 
Show t => Show (Key M t) 

data IKeyDimension r t whereSource

Constructors

IKeyDimensionO :: Ord t => t -> IKeyDimension O t 
IKeyDimensionM :: Ord t => [t] -> IKeyDimension M t 

Instances

Typeable2 IKeyDimension 
Eq (IKeyDimension r t) 
Show t => Show (IKeyDimension r t) 
(Show t, Show (IKey rt tt)) => Show (IKey (:. r rt) (:. t tt)) 
Show t => Show (IKey O t) 
Show t => Show (IKey M t) 
(Ord t, Serialize t) => Serialize (IKeyDimension O t) 
(Ord t, Serialize t) => Serialize (IKeyDimension M t) 
NFData t => NFData (IKeyDimension r t) 
(NFData t, NFData (IKey rt tt)) => NFData (IKey (:. r rt) (:. t tt)) 
NFData t => NFData (IKey O t) 
NFData t => NFData (IKey M t) 
(Ord t, SafeCopy t) => SafeCopy (IKeyDimension O t) 
(Ord t, SafeCopy t) => SafeCopy (IKeyDimension M t) 
Eq (GenericKey IKeyDimension rs ts) 

data IndexDimension r t whereSource

Constructors

IndexDimensionO :: Ord t => !(Map t Int) -> IndexDimension O t 
IndexDimensionM :: Ord t => !(Map t IntSet) -> IndexDimension M t 

class GetDimension n a whereSource

Methods

getDimension :: n -> a -> RawDimensionType n aSource

Instances

GetDimension Z (Index (:. r rt) (:. t tt)) 
GetDimension Z (Index O t) 
GetDimension Z (Index M t) 
GetDimension n (Index rt tt) => GetDimension (S n) (Index (:. r rt) (:. t tt)) 

data TT Source

data FF Source

type family EmptyProxyIsSpecial t :: *Source

class Empty a whereSource

Methods

empty :: aSource

Instances

(Ord t, Empty (Index rt tt)) => Empty (Index (:. O rt) (:. t tt)) 
(Ord t, Empty (Index rt tt)) => Empty (Index (:. M rt) (:. t tt)) 
Ord t => Empty (Index O t) 
Ord t => Empty (Index M t) 
Empty (Index irs ts) => Empty (Store tag krs irs ts e) 

class EmptyProxy flag a whereSource

Methods

emptyProxy :: flag -> aSource

data h :. t Source

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))