{- | 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.DefaultPersistence"
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 indexOf 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.
-}{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses
, FunctionalDependencies, FlexibleInstances, UndecidableInstances
, TypeSynonymInstances, IncoherentInstances #-}moduleData.TCache.IndexQuery(index,(.==.),(.<.),(.<=.),(.>=.),(.>.),indexOf,recordsWith,(.&&.),(.||.),select,Queriable,setIndexPersist,getIndexPersist)whereimportData.TCacheimportData.TCache.DefsimportData.ListimportData.TypeableimportControl.Concurrent.STMimportData.Maybe(catMaybes)importqualifiedData.MapasMimportData.IORefimportqualifiedData.MapasMimportSystem.IO.UnsafeimportData.ByteString.Lazy.Char8(pack,unpack)class(Readreg,Reada,Showreg,Showa,IResourcereg,Typeablereg,Typeablea,Orda)=>Queriableregainstance(Readreg,Reada,Showreg,Showa,IResourcereg,Typeablereg,Typeablea,Orda)=>Queriablerega--instance Queriable reg a => IResource (Index reg a) where-- keyResource = key-- writeResource =defWriteResource-- readResourceByKey = defReadResourceByKey-- delResource = defDelResourcedataIndexrega=Index(M.Mapa[DBRefreg])deriving(Show,Typeable)instance(IResourcereg,Typeablereg,Orda,Reada)=>Read(Indexrega)wherereadsPrecn('I':'n':'d':'e':'x':' ':str)=map(\(r,s)->(Indexr,s))rswherers=readsPrecnstrreadsPrec_s=error$"indexQuery: can not read index: \""++s++"\""instance(Queriablerega)=>Serializable(Indexrega)whereserialize=pack.showdeserialize=read.unpacksetPersist=const$unsafePerformIO$readIORef_indexPersist_indexPersist=unsafePerformIO$newIORefNothing-- | Set the default persistence for the indexes---- Must be called before any other TCache sentencesetIndexPersistp=writeIORef_indexPersist$JustpgetIndexPersist=unsafePerformIO$readIORef_indexPersistkeyIndextregtv="index "++showtreg++showtvinstance(Typeablereg,Typeablea)=>Indexable(Indexrega)wherekeymap=keyIndextypeofregtypeofawhere[typeofreg,typeofa]=typeRepArgs$!typeOfmapinstance(Queriablerega,Typeablereg,Typeablea)=>IResource(Indexrega)wherekeyResource=keywriteResource=defWriteResourcereadResourceByKey=defReadResourceByKeydelResource=defDelResourcegetIndex::(Queriablerega)=>(reg->a)->a->STM(DBRef(Indexrega),Indexrega,[DBRefreg])getIndexselectorval=dolet[one,two]=typeRepArgs$!typeOfselectorletrindex=getDBRef$!keyIndexonetwogetIndexrrindexvalgetIndexr::(Queriablerega)=>DBRef(Indexrega)->a->STM(DBRef(Indexrega),Indexrega,[DBRefreg])getIndexrrindexval=domindex<-readDBRefrindexletindex=casemindexofJust(Indexindex)->index;_->M.emptyletdbrefs=caseM.lookupvalindexofJustdbrefs->dbrefsNothing->[]return(rindex,Indexindex,dbrefs)selectorIndex::(Queriablerega,IResourcereg)=>(reg->a)->DBRef(Indexrega)->DBRefreg->Maybereg->STM()selectorIndexselectorrindexpobjectmobj=domoldobj<-readDBRefpobjectchoicemoldobjmobjwherechoicemoldobjmobj=case(moldobj,mobj)of(Nothing,Nothing)->return()(Justoldobj,Justobj)->ifselectoroldobj==selectorobjthenreturn()elsedochoicemoldobjNothingchoiceNothingmobj(Justoldobj,Nothing)->do-- delete the old selector value from the indexletval=selectoroldobj(rindex,Indexindex,dbrefs)<-getIndexrrindexvalletdbrefs'=Data.List.deletepobjectdbrefswriteDBRefrindex$Index(M.insertvaldbrefs'index)(Nothing,Justobj)->do-- add the new value to the indexletval=selectorobj(rindex,Indexindex,dbrefs)<-getIndexrrindexvalletdbrefs'=nub$Data.List.insertpobjectdbrefswriteDBRefrindex$Index(M.insertvaldbrefs'index){- | Register a trigger for indexing the values of the field passed as parameter.
the indexed field can be used to perform relational-like searches
-}index::(Queriablerega)=>(reg->a)->IO()indexsel=dolet[one,two]=typeRepArgs$!typeOfselrindex=getDBRef$!keyIndexonetwoaddTrigger$selectorIndexselrindexletproto=IndexM.empty`asTypeOf`indexselselwithResources[proto]$initprotowhereinitproto[Nothing]=[proto]init_[Just_]=[]indexsel::(reg->a)->Indexregaindexsel=undefined-- | implement the relational-like operators, operating on record fieldsclassRelationOpsfield1field2res|field1field2->reswhere(.==.)::field1->field2->STMres(.>.)::field1->field2->STMres(.>=.)::field1->field2->STMres(.<=.)::field1->field2->STMres(.<.)::field1->field2->STMres-- Instance of relations betweeen fields and values-- field .op. valueinstance(Queriablerega)=>RelationOps(reg->a)a[DBRefreg]where(.==.)fieldvalue=do(_,_,dbrefs)<-getIndexfieldvaluereturndbrefs(.>.)fieldvalue=retrievefieldvalue(>)(.<.)fieldvalue=retrievefieldvalue(<)(.<=.)fieldvalue=retrievefieldvalue(<=)(.>=.)fieldvalue=retrievefieldvalue(>=)join::(Queriablerecv,Queriablerec'v)=>(v->v->Bool)->(rec->v)->(rec'->v)->STM[([DBRefrec],[DBRefrec'])]joinopfield1field2=doidxs<-indexOffield1idxs'<-indexOffield2return$mixidxsidxs'whereopv(v,_)(v',_)=v`op`v'mixxsys=letzlist=[(x,y)|x<-xs,y<-ys,x`opv`y]inmap(\((_,xs),(_,ys))->(xs,ys))zlisttypeJoinDataregreg'=[([DBRefreg],[DBRefreg'])]-- Instance of relations betweeen fields-- field1 .op. field2instance(Queriablerega,Queriablereg'a)=>RelationOps(reg->a)(reg'->a)(JoinDataregreg')where(.==.)=join(==)(.>.)=join(>)(.>=.)=join(>=)(.<=.)=join(<=)(.<.)=join(<)infixr5.==.,.>.,.>=.,.<=.,.<.classSetOperationssetset'setResult|setset'->setResultwhere(.||.)::STMset->STMset'->STMsetResult(.&&.)::STMset->STMset'->STMsetResultinstanceSetOperations[DBRefa][DBRefa][DBRefa]where(.&&.)fxsfys=doxs<-fxsys<-fysreturn$intersectxsys(.||.)fxsfys=doxs<-fxsys<-fysreturn$unionxsysinfixr4.&&.infixr3.||.instanceSetOperations(JoinDataaa')[DBRefa](JoinDataaa')where(.&&.)fxsfys=doxss<-fxsys<-fysreturn[(intersectxsys,zs)|(xs,zs)<-xss](.||.)fxsfys=doxss<-fxsys<-fysreturn[(unionxsys,zs)|(xs,zs)<-xss]instanceSetOperations[DBRefa](JoinDataaa')(JoinDataaa')where(.&&.)fxsfys=fys.&&.fxs(.||.)fxsfys=fys.||.fxsinstanceSetOperations(JoinDataaa')[DBRefa'](JoinDataaa')where(.&&.)fxsfys=doxss<-fxsys<-fysreturn[(zs,intersectxsys)|(zs,xs)<-xss](.||.)fxsfys=doxss<-fxsys<-fysreturn[(zs,unionxsys)|(zs,xs)<-xss]-- | return all the (indexed) values which this field has and a DBRef pointer to the registerindexOf::(Queriablerega)=>(reg->a)->STM[(a,[DBRefreg])]indexOfselector=dolet[one,two]=typeRepArgs$!typeOfselectorletrindex=getDBRef$!keyIndexonetwomindex<-readDBRefrindexcasemindexofJust(Indexindex)->return$M.toListindex;_->doletfields=show$typeOfselectorerror$"the index for "++fields++" do not exist. At main, use \"Data.TCache.IdexQuery.index\" to start indexing this field"retrieve::Queriablerega=>(reg->a)->a->(a->a->Bool)->STM[DBRefreg]retrievefieldvalueop=doindex<-indexOffieldlethiguer=map(\(v,vals)->ifopvvaluethenvalselse[])indexreturn$concathiguer-- from a Query result, return the records, rather than the referencesrecordsWith::(IResourcea,Typeablea)=>STM[DBRefa]->STM[a]recordsWithdbrefs=dbrefs>>=mapMreadDBRef>>=return.catMaybesclassSelectselectorares|selectora->reswhereselect::selector->a->res{-
instance (Select sel1 a res1, Select sel2 b res2 )
=> Select (sel1, sel2) (a , b) (res1, res2) where
select (sel1,sel2) (x, y) = (select sel1 x, select sel2 y)
-}instance(Typeablereg,IResourcereg)=>Select(reg->a)(STM[DBRefreg])(STM[a])whereselectselxs=return.mapsel=<<return.catMaybes=<<mapMreadDBRef=<<xsinstance(Typeablereg,IResourcereg,Select(reg->a)(STM[DBRefreg])(STM[a]),Select(reg->b)(STM[DBRefreg])(STM[b]))=>Select((reg->a),(reg->b))(STM[DBRefreg])(STM[(a,b)])whereselect(sel,sel')xs=mapM(\x->return(selx,sel'x))=<<return.catMaybes=<<mapMreadDBRef=<<xsinstance(Typeablereg,IResourcereg,Select(reg->a)(STM[DBRefreg])(STM[a]),Select(reg->b)(STM[DBRefreg])(STM[b]),Select(reg->c)(STM[DBRefreg])(STM[c]))=>Select((reg->a),(reg->b),(reg->c))(STM[DBRefreg])(STM[(a,b,c)])whereselect(sel,sel',sel'')xs=mapM(\x->return(selx,sel'x,sel''x))=<<return.catMaybes=<<mapMreadDBRef=<<xsinstance(Typeablereg,IResourcereg,Select(reg->a)(STM[DBRefreg])(STM[a]),Select(reg->b)(STM[DBRefreg])(STM[b]),Select(reg->c)(STM[DBRefreg])(STM[c]),Select(reg->d)(STM[DBRefreg])(STM[d]))=>Select((reg->a),(reg->b),(reg->c),(reg->d))(STM[DBRefreg])(STM[(a,b,c,d)])whereselect(sel,sel',sel'',sel''')xs=mapM(\x->return(selx,sel'x,sel''x,sel'''x))=<<return.catMaybes=<<mapMreadDBRef=<<xs-- for join's (field1 op field2)instance(Typeablereg,IResourcereg,Typeablereg',IResourcereg',Select(reg->a)(STM[DBRefreg])(STM[a]),Select(reg'->b)(STM[DBRefreg'])(STM[b]))=>Select((reg->a),(reg'->b))(STM(JoinDataregreg'))(STM[([a],[b])])whereselect(sel,sel')xss=xss>>=mapMselect1whereselect1(xs,ys)=dorxs<-return.mapsel=<<return.catMaybes=<<mapMreadDBRefxsrys<-return.mapsel'=<<return.catMaybes=<<mapMreadDBRefysreturn(rxs,rys)