-- | DSH compiler module exposes the function fromQ that can be used to-- execute DSH programs on a database. It transform the DSH program into-- FerryCore which is then translated into SQL (through a table algebra). The SQL-- code is executed on the database and then processed to form a Haskell value.moduleDatabase.DSH.Compiler(fromQ,debugPlan,debugCore,debugPlanOpt,debugSQL,debugCoreDot)whereimportDatabase.DSH.InternalsasDimportDatabase.DSH.ImpossibleimportDatabase.DSH.CSVimportDatabase.DSH.CompileasCimportDatabase.Ferry.SyntaxTypedasFimportDatabase.Ferry.CompilerimportqualifiedData.MapasMimportData.CharimportDatabase.HDBCimportControl.Monad.StateimportControl.ApplicativeimportData.Text(unpack)importData.List(nub)importqualifiedData.ListasL{-
N monad, version of the state monad that can provide fresh variable names.
-}typeNconn=StateT(conn,Int,M.MapString[(String,FType->Bool)])IO-- | Provide a fresh identifier name during compilationfreshVar::NconnIntfreshVar=do(c,i,env)<-getput(c,i+1,env)returni-- | Get from the state the connection to the database getConnection::IConnectionconn=>NconnconngetConnection=do(c,_,_)<-getreturnc-- | Lookup information that describes a table. If the information is -- not present in the state then the connection is used to retrieve the-- table information from the Database.tableInfo::IConnectionconn=>String->Nconn[(String,FType->Bool)]tableInfot=do(c,i,env)<-getcaseM.lookuptenvofNothing->doinf<-lift$getTableInfoctput(c,i,M.inserttinfenv)returninfJustv->returnv-- | Turn a given integer into a variable beginning with prefix "__fv_" prefixVar::Int->StringprefixVar=(++)"__fv_".show-- | Execute the transformation computation. During-- compilation table information can be retrieved from-- the database, therefor the result is wrapped in the IO-- Monad. runN::IConnectionconn=>conn->Nconna->IOarunNc=liftMfst.fliprunStateT(c,1,M.empty)-- * Convert DB queries into Haskell values-- | Execute the query on the databasefromQ::(QAa,IConnectionconn)=>conn->Qa->IOafromQc(Qe)=fmapfrExp(evaluatece)-- | Convert the query into unoptimised algebraic plandebugPlan::(IConnectionconn,Reifya)=>conn->Expa->IOStringdebugPlan=doCompile-- | Convert the query into optimised algebraic plandebugPlanOpt::(IConnectionconn,Reifya)=>conn->Expa->IOStringdebugPlanOptqc=dop<-doCompileqc(C.Algebrar)<-algToAlg(C.Algebrap::AlgebraXMLa)returnrdebugCore::(IConnectionconn,Reifya)=>conn->Expa->IOStringdebugCoreca=docore<-runNc$transformEareturn$showcoredebugCoreDot::(IConnectionconn,Reifya)=>conn->Expa->IOStringdebugCoreDotca=docore<-runNc$transformEareturn$(\(Rightd)->d)$dotcore-- | Convert the query into SQLdebugSQL::(IConnectionconn,Reifya)=>conn->Expa->IOStringdebugSQLqc=dop<-doCompileqc(C.SQLr)<-algToSQL(C.Algebrap::AlgebraXMLa)returnr-- | evaluate compiles the given Q query into an executable plan, executes this and returns -- the result as norm. For execution it uses the given connection. If the boolean flag is set-- to true it outputs the intermediate algebraic plan to disk.evaluate::(Reifya,IConnectionconn)=>conn->Expa->IO(Expa)evaluatecq=doalgPlan'<-doCompilecqletalgPlan=C.AlgebraalgPlan'::AlgebraXMLan<-executePlancalgPlandisconnectcreturnn-- | Transform a query into an algebraic plan. doCompile::(IConnectionconn,Reifya)=>conn->Expa->IOStringdoCompileca=docore<-runNc$transformEareturn$typedCoreToAlgebracore-- | Transform the Query into a ferry core program.transformE::forallaconn.(IConnectionconn,Reifya)=>Expa->NconnCoreExprtransformE(UnitE)=return$Constant([]:=>int)$CInt1transformE(BoolEb)=return$Constant([]:=>bool)$CBoolbtransformE(CharEc)=return$Constant([]:=>string)$CString[c]transformE(IntegerEi)=return$Constant([]:=>int)$CIntitransformE(DoubleEd)=return$Constant([]:=>float)$CFloatdtransformE(TextEt)=return$Constant([]:=>string)$CString$unpackttransformE(PairEe1e2)=doletty=reify(undefined::a)c1<-transformEe1c2<-transformEe2return$Rec([]:=>transformTyty)[RecElem(typeOfc1)"1"c1,RecElem(typeOfc2)"2"c2]transformE(ListEes)=letty=reify(undefined::a)qt=([]:=>transformTyty)infoldr(F.Consqt)(Nilqt)<$>mapMtransformEestransformE(AppEGroupWithKey(PairE(gfn::Exp(ta->rt))(e::Expel)))=dolettel=reify(undefined::el)fn'<-transformLamArggfnlet(_:=>tfn@(FFn_rt))=typeOffn'letgtr=list$rec[(RLabel"1",rt),(RLabel"2",transformTy$ListTtel)]e'<-transformArgelet(_:=>te)=typeOfe'fv<-transformLamArg(LamEid::Exp(el->el))let(_:=>tfv)=typeOffvreturn$App([]:=>gtr)(App([]:=>te.->gtr)(App([]:=>tfn.->te.->gtr)(Var([]:=>tfv.->tfn.->te.->gtr)"groupWith")fv)fn')e'transformE(AppED.Cons(PairEe1e2))=doe1'<-transformEe1e2'<-transformEe2let(_:=>t)=typeOfe1'return$F.Cons([]:=>listt)e1'e2'transformE(AppECond(PairEe1(PairEe2e3)))=doe1'<-transformEe1e2'<-transformEe2e3'<-transformEe3let(_:=>t)=typeOfe2'return$If([]:=>t)e1'e2'e3'transformE(AppEFst(PairEe1e2))=doletty=reify(undefined::a)lettr=transformTytye1'<-transformArg(PairEe1e2)let(_:=>ta)=typeOfe1'return$App([]:=>tr)(transformFFst(ta.->tr))e1'transformE(AppESnd(PairEe1e2))=doletty=reify(undefined::a)lettr=transformTytye1'<-transformArg(PairEe1e2)let(_:=>ta)=typeOfe1'return$App([]:=>tr)(transformFSnd(ta.->tr))e1'transformE(AppEf2(PairE(LamEf)e))=doletty=reify(undefined::a)lettr=transformTytyf'<-transformLamArg(LamEf)e'<-transformArgelet(_:=>t1)=typeOff'let(_:=>t2)=typeOfe'return$App([]:=>tr)(App([]:=>t2.->tr)(transformFf2(t1.->t2.->tr))f')e'transformE(AppEf2(PairEe1e2))=doletty=reify(undefined::a)lettr=transformTytyifisOpf2thendoe1'<-transformEe1e2'<-transformEe2return$BinOp([]:=>tr)(transformOpf2)e1'e2'elsedoe1'<-transformArge1e2'<-transformArge2let(_:=>ta1)=typeOfe1'let(_:=>ta2)=typeOfe2'return$App([]:=>tr)(App([]:=>ta2.->tr)(transformFf2(ta1.->ta2.->tr))e1')e2'transformE(AppEf1e1)=doletty=reify(undefined::a)lettr=transformTytye1'<-transformArge1let(_:=>ta)=typeOfe1'return$App([]:=>tr)(transformFf1(ta.->tr))e1'transformE(VarEi)=doletty=reify(undefined::a)return$Var([]:=>transformTyty)$prefixVar$fromIntegralitransformE(TableE(TableCSVfilepath))=doletty=reify(undefined::a)e1<-lift(csvImportfilepathty)transformEe1-- When a table node is encountered check that the given description-- matches the actual table information in the database.transformE(TableE(TableDBnks))=doletty=reify(undefined::a)fv<-freshVarlettTy@(FList(FRects))=flatFTytyletvarB=Var([]:=>FRects)$prefixVarfvtableDescr<-tableInfonlettyDescr=iflengthtableDescr==lengthtsthenziptableDescrtselseerror$"Inferred typed: "++showtTy++" \n doesn't match type of table: \""++n++"\" in the database. The table has the shape: "++show(mapfsttableDescr)++". "++showtyletcols=[Columncnt|((cn,f),(RLabeli,t))<-tyDescr,legalTypencnitf]letkeyCols=nub(concatks)L.\\mapfsttableDescrletkeys=ifkeyCols==[]thenifks/=[]thenmapKeykselse[Key$map(\(Columnn'_)->n')cols]elseerror$"The following columns were used as key but not a column of table "++n++" : "++showkeyColslettable'=Table([]:=>tTy)ncolskeysletpattern=[prefixVarfv]letnameType=map(\(Columnnamet)->(name,t))colsletbody=foldr(\(nr,t)b->let(_:=>bt)=typeOfbinRec([]:=>FRec[(RLabel"1",t),(RLabel"2",bt)])[RecElem([]:=>t)"1"(F.Elem([]:=>t)varBnr),RecElem([]:=>bt)"2"b])((\(nr,t)->F.Elem([]:=>t)varBnr)$lastnameType)(initnameType)let([]:=>rt)=typeOfbodyletlambda=ParAbstr([]:=>FRects.->rt)patternbodyletexpr=App([]:=>FListrt)(App([]:=>(FList$FRects).->FListrt)(Var([]:=>(FRects.->rt).->(FList$FRects).->FListrt)"map")lambda)(ParExpr(typeOftable')table')returnexprwherelegalType::String->String->String->FType->(FType->Bool)->BoollegalTypetncnnrtf=ft||error("The type: "++showt++"\nis not compatible with the type of column nr: "++nr++" namely: "++cn++"\n in table "++tn++".")transformE(LamE_)=$impossibletransformLamArg::forallabconn.(IConnectionconn)=>Exp(a->b)->NconnParamtransformLamArg(LamEf)=doletty=reify(undefined::a->b)n<-freshVarletfty=transformTytylete1=f$VarE$fromIntegralnParAbstr([]:=>fty)[prefixVarn]<$>transformEe1transformLamArg(AppE__)=$impossibletransformLamArg(VarE_)=$impossibletransformArg::(IConnectionconn,Reifya)=>Expa->NconnParamtransformArge=(\e'->ParExpr(typeOfe')e')<$>transformEe-- | Construct a flat-FerryCore type out of a DSH type-- A flat type consists out of two tuples, a record is translated as:-- {r1 :: t1, r2 :: t2, r3 :: t3, r4 :: t4} (t1, (t2, (t3, t4)))flatFTy::Typea->FTypeflatFTy(ListTt)=FList$FRec$flatFTy'1twhereflatFTy'::Int->Typea->[(RLabel,FType)]flatFTy'i(PairTt1t2)=(RLabel$showi,transformTyt1):flatFTy'(i+1)t2flatFTy'ity=[(RLabel$showi,transformTyty)]flatFTy_=$impossible-- Determine the size of a flat typesizeOfTy::Typea->IntsizeOfTy(PairT_t2)=1+sizeOfTyt2sizeOfTy_=1-- | Transform an arbitrary DSH-type into a ferry core type transformTy::Typea->FTypetransformTyUnitT=inttransformTyBoolT=booltransformTyCharT=stringtransformTyTextT=stringtransformTyIntegerT=inttransformTyDoubleT=floattransformTy(PairTt1t2)=FRec[(RLabel"1",transformTyt1),(RLabel"2",transformTyt2)]transformTy(ListTt1)=FList$transformTyt1transformTy(ArrowTt1t2)=transformTyt1.->transformTyt2isOp::Funab->BoolisOpAdd=TrueisOpSub=TrueisOpMul=TrueisOpDiv=TrueisOpEqu=TrueisOpLt=TrueisOpLte=TrueisOpGte=TrueisOpGt=TrueisOpConj=TrueisOpDisj=TrueisOp_=False-- | Translate the DSH operator to Ferry Core operatorstransformOp::Funab->OptransformOpAdd=Op"+"transformOpSub=Op"-"transformOpMul=Op"*"transformOpDiv=Op"/"transformOpEqu=Op"=="transformOpLt=Op"<"transformOpLte=Op"<="transformOpGte=Op">="transformOpGt=Op">"transformOpConj=Op"&&"transformOpDisj=Op"||"transformOp_=$impossible-- | Transform a DSH-primitive-function (f) with an instantiated typed into a FerryCore-- expressiontransformF::(Showf)=>f->FType->CoreExprtransformFft=Var([]:=>t)$(\txt->casetxtof(x:xs)->toLowerx:xs_->$impossible)$showf-- | Retrieve through the given database connection information on the table (columns with their types)-- which name is given as the second argument. getTableInfo::IConnectionconn=>conn->String->IO[(String,FType->Bool)]getTableInfocn=doinfo<-describeTablecnreturn$toTableDescrinfowheretoTableDescr::[(String,SqlColDesc)]->[(String,FType->Bool)]toTableDescr=L.sortBy(\(n1,_)(n2,_)->comparen1n2).map(\(name,props)->(name,compatibleType(colTypeprops)))compatibleType::SqlTypeId->FType->BoolcompatibleTypedbThsT=casehsTofFUnit->TrueFBool->dbT`L.elem`[SqlSmallIntT,SqlIntegerT,SqlBitT]FString->dbT`L.elem`[SqlCharT,SqlWCharT,SqlVarCharT]FInt->dbT`L.elem`[SqlSmallIntT,SqlIntegerT,SqlTinyIntT,SqlBigIntT,SqlNumericT]FFloat->dbT`L.elem`[SqlDecimalT,SqlRealT,SqlFloatT,SqlDoubleT]t->error$"You can't store this kind of data in a table... "++showt++" "++shown