TCache-0.9.0.3: A Transactional cache with user-defined persistence

Safe HaskellSafe-Infered

Data.TCache.IndexQuery

Description

This module implements an experimental typed query language for TCache build on pure haskell. It is minimally intrusive (no special data definitions, no special syntax, no template haskell). It uses the same register fields from the data definitions. Both for query conditions and selections. It is executed in haskell, no external database support is needed.

it includes

  • A method for triggering the index-ation of the record fields that you want to query
  • A typed query language of these record fields, with:
  • Relational operators: .==. .>. .>=. .<=. .<. .&&. .||. to compare fields with values (returning lists of DBRefs) or fields between them, returning joins (lists of pairs of lists of DBRefs that meet the condition).
  • a select method to extract tuples of field values from the DBRefs
  • a recordsWith clause to extract entire registers

An example that register the owner and name fields fo the Car register and the name of the Person register, create the Bruce register, return the Bruce DBRef, create two Car registers with bruce as owner and query for the registers with bruce as owner and its name alpabeticaly higuer than "Bat mobile"

import Data.TCache
import Data.TCache.IndexQuery
import Data.TCache.FilePersistence
import Data.Typeable

data Person= Person {pname :: String} deriving  (Show, Read, Eq, Typeable)
data Car= Car{owner :: DBRef Person , cname:: String} deriving (Show, Read, Eq, Typeable)

instance Indexable Person where key Person{pname= n} = "Person " ++ n
instance Indexable Car where key Car{cname= n} = "Car " ++ n

main =  do
   index owner
   index pname
   index cname
   bruce <- atomically $ newDBRef $ Person "bruce"
   atomically $  mapM_ newDBRef [Car bruce "Bat Mobile", Car bruce "Porsche"]
   r <- atomically $ cname .==. "Porsche"
   print r
   r <- atomically $ select (cname, owner) $  (owner .==. bruce) .&&. (cname .>=. "Bat Mobile")
   print r

Will produce:

 [DBRef "Car Porsche"]
 [("Porsche",DBRef "Person bruce")]

NOTES:

  • the index is instance of Indexable and Serializable. This can be used to persist in the user-defined storoage. If Data.TCache.FilePersistence is included the indexes will be written in files.
  • The Join feature has not been properly tested
  • Record fields are recognized by its type, so if we define two record fields with the same type:
 data Person = Person {name , surname :: String}

then a query for name .==. Bruce is indistinguishable from surname .==. Bruce

Will return all the registers with surname Bruce as well. So if two or more fields in a registers are to be indexed, they must have different types.

Synopsis

Documentation

index :: Queriable reg a => (reg -> a) -> IO ()Source

Register a trigger for indexing the values of the field passed as parameter. the indexed field can be used to perform relational-like searches

class RelationOps field1 field2 res | field1 field2 -> res whereSource

implement the relational-like operators, operating on record fields

Methods

(.==.) :: field1 -> field2 -> STM resSource

(.>.) :: field1 -> field2 -> STM resSource

(.>=.) :: field1 -> field2 -> STM resSource

(.<=.) :: field1 -> field2 -> STM resSource

(.<.) :: field1 -> field2 -> STM resSource

Instances

Queriable reg a => RelationOps (reg -> a) a [DBRef reg] 
(Queriable reg a, Queriable reg' a) => RelationOps (reg -> a) (reg' -> a) (JoinData reg reg') 

(.&&.) :: SetOperations set set' setResult => STM set -> STM set' -> STM setResultSource

(.||.) :: SetOperations set set' setResult => STM set -> STM set' -> STM setResultSource

class Select selector a res | selector a -> res whereSource

Methods

select :: selector -> a -> resSource

Instances

(Typeable reg, IResource reg) => Select (reg -> a) (STM [DBRef reg]) (STM [a]) 
(Typeable reg, IResource reg, Typeable reg', IResource reg', Select (reg -> a) (STM [DBRef reg]) (STM [a]), Select (reg' -> b) (STM [DBRef reg']) (STM [b])) => Select (reg -> a, reg' -> b) (STM (JoinData reg reg')) (STM [([a], [b])]) 
(Typeable reg, IResource reg, Select (reg -> a) (STM [DBRef reg]) (STM [a]), Select (reg -> b) (STM [DBRef reg]) (STM [b])) => Select (reg -> a, reg -> b) (STM [DBRef reg]) (STM [(a, b)]) 
(Typeable reg, IResource reg, Select (reg -> a) (STM [DBRef reg]) (STM [a]), Select (reg -> b) (STM [DBRef reg]) (STM [b]), Select (reg -> c) (STM [DBRef reg]) (STM [c])) => Select (reg -> a, reg -> b, reg -> c) (STM [DBRef reg]) (STM [(a, b, c)]) 
(Typeable reg, IResource reg, Select (reg -> a) (STM [DBRef reg]) (STM [a]), Select (reg -> b) (STM [DBRef reg]) (STM [b]), Select (reg -> c) (STM [DBRef reg]) (STM [c]), Select (reg -> d) (STM [DBRef reg]) (STM [d])) => Select (reg -> a, reg -> b, reg -> c, reg -> d) (STM [DBRef reg]) (STM [(a, b, c, d)])