-- | This module provides the reference implementation of DSH by interpreting-- the embedded representation.moduleDatabase.DSH.Interpreter(fromQ)whereimportDatabase.DSH.InternalsimportDatabase.DSH.ImpossibleimportDatabase.DSH.CSVimportqualifiedData.TextasTimportqualifiedData.Text.EncodingasTimportDatabase.HDBCimportData.ListfromQ::(QAa,IConnectionconn)=>conn->Qa->IOafromQc(Qe)=fmapfrExp(evaluatece)evaluate::forallaconn.(Reifya,IConnectionconn)=>conn->Expa->IO(Expa)evaluatece=caseeofUnitE->returnUnitEBoolEb->return$BoolEbCharEch->return$CharEchIntegerEi->return$IntegerEiDoubleEd->return$DoubleEdTextEt->return$TextEtVarE_->$impossibleLamE_->$impossiblePairEe1e2->doe1'<-evaluatece1e2'<-evaluatece2return(PairEe1'e2')ListEes->does1<-mapM(evaluatec)esreturn$ListEes1AppECond(PairEcond(PairEab))->do(BoolEc1)<-evaluateccondifc1thenevaluatecaelseevaluatecbAppECons(PairEaas)->doa1<-evaluateca(ListEas1)<-evaluatecasreturn$ListE(a1:as1)AppEHeadas->do(ListEas1)<-evaluatecasreturn$headas1AppETailas->do(ListEas1)<-evaluatecasreturn$ListE(tailas1)AppETake(PairEias)->do(IntegerEi1)<-evaluateci(ListEas1)<-evaluatecasreturn$ListE(take(fromIntegrali1)as1)AppEDrop(PairEias)->do(IntegerEi1)<-evaluateci(ListEas1)<-evaluatecasreturn$ListE(drop(fromIntegrali1)as1)AppEMap(PairE(LamEf)as)->do(ListEas1)<-evaluatecasevaluatec$ListE(mapfas1)AppEFilter(PairE(LamEf)as)->do(ListEas1)<-evaluatecas(ListEas2)<-evaluatec(ListE(mapfas1))return$ListE(mapfst(filter(\(_,BoolEb)->b)(zipas1as2)))AppEGroupWithKey(PairE(LamEf)as)->do(ListEas1)<-evaluatecas(ListEks1)<-evaluatec(ListE(mapfas1))return$ListE$map(\kas1->PairE(fst(headkas1))(ListE(mapsndkas1)))$groupBy(\(k1,_)(k2,_)->equExpk1k2)$sortBy(\(k1,_)(k2,_)->compareExpk1k2)$zipks1as1AppESortWith(PairE(LamEf)as)->do(ListEas1)<-evaluatecas(ListEas2)<-evaluatec$ListE(mapfas1)return$ListE$mapfst$sortBy(\(_,a1)(_,a2)->compareExpa1a2)$zipas1as2(AppEMax(PairEe1e2))->casereify(undefined::a)ofIntegerT->do(IntegerEv1)<-evaluatece1(IntegerEv2)<-evaluatece2return$IntegerE(maxv1v2)DoubleT->do(DoubleEv1)<-evaluatece1(DoubleEv2)<-evaluatece2return$DoubleE(maxv1v2)_->$impossible(AppEMin(PairEe1e2))->casereify(undefined::a)ofIntegerT->do(IntegerEv1)<-evaluatece1(IntegerEv2)<-evaluatece2return$IntegerE(minv1v2)DoubleT->do(DoubleEv1)<-evaluatece1(DoubleEv2)<-evaluatece2return$DoubleE(minv1v2)_->$impossibleAppELastas->do(ListEas1)<-evaluatecasreturn$lastas1AppEInitas->do(ListEas1)<-evaluatecasreturn$ListE(initas1)AppENullas->do(ListEas1)<-evaluatecasreturn$BoolE(nullas1)AppELengthas->do(ListEas1)<-evaluatecasreturn$IntegerE(fromIntegral$lengthas1)AppEIndex(PairEasi)->do(IntegerEi1)<-evaluateci(ListEas1)<-evaluatecasreturn$as1!!fromIntegrali1AppEReverseas->do(ListEas1)<-evaluatecasreturn$ListE(reverseas1)AppEAndas->do(ListEas1)<-evaluatecasreturn$BoolE(all(\(BoolEb)->b)as1)AppEOras->do(ListEas1)<-evaluatecasreturn$BoolE(any(\(BoolEb)->b)as1)(AppESumas)->doletty=reify(undefined::a)(ListEas1)<-evaluatecascasetyofIntegerT->return$IntegerE(sum$map(\(IntegerEi)->i)as1)DoubleT->return$DoubleE(sum$map(\(DoubleEd)->d)as1)_->$impossibleAppEConcatas->do(ListEas1)<-evaluatecasreturn$ListE(concatMap(\(ListEas2)->as2)as1)AppEMaximumas->do(ListEas1)<-evaluatecasreturn$maximumBycompareExpas1AppEMinimumas->do(ListEas1)<-evaluatecasreturn$minimumBycompareExpas1AppESplitAt(PairEias)->do(IntegerEi1)<-evaluateci(ListEas1)<-evaluatecasletr=splitAt(fromIntegrali1)as1return$PairE(ListE(fstr))(ListE(sndr))AppETakeWhile(PairE(LamEf)as)->do(ListEas1)<-evaluatecas(ListEas2)<-evaluatec(ListE(mapfas1))return$ListE(mapfst$takeWhile(\(_,BoolEb)->b)$zipas1as2)AppEDropWhile(PairE(LamEf)as)->do(ListEas1)<-evaluatecas(ListEas2)<-evaluatec(ListE(mapfas1))return$ListE(mapfst$dropWhile(\(_,BoolEb)->b)$zipas1as2)AppEZip(PairEasbs)->do(ListEas1)<-evaluatecas(ListEbs1)<-evaluatecbsreturn$ListE(zipWithPairEas1bs1)AppENubas->do(ListEas1)<-evaluatecasreturn$ListE(nubByequExpas1)AppEFsta->do(PairEa1_)<-evaluatecareturna1AppESnda->do(PairE_a1)<-evaluatecareturna1(AppEAdd(PairEe1e2))->doletty=reify(undefined::a)casetyofIntegerT->do(IntegerEi1)<-evaluatece1(IntegerEi2)<-evaluatece2return$IntegerE(i1+i2)DoubleT->do(DoubleEd1)<-evaluatece1(DoubleEd2)<-evaluatece2return$DoubleE(d1+d2)_->$impossible(AppESub(PairEe1e2))->doletty=reify(undefined::a)casetyofIntegerT->do(IntegerEi1)<-evaluatece1(IntegerEi2)<-evaluatece2return$IntegerE(i1-i2)DoubleT->do(DoubleEd1)<-evaluatece1(DoubleEd2)<-evaluatece2return$DoubleE(d1-d2)_->$impossible(AppEMul(PairEe1e2))->doletty=reify(undefined::a)casetyofIntegerT->do(IntegerEi1)<-evaluatece1(IntegerEi2)<-evaluatece2return$IntegerE(i1*i2)DoubleT->do(DoubleEd1)<-evaluatece1(DoubleEd2)<-evaluatece2return$DoubleE(d1*d2)_->$impossible(AppEDiv(PairEe1e2))->doletty=reify(undefined::a)casetyofDoubleT->do(DoubleEd1)<-evaluatece1(DoubleEd2)<-evaluatece2return$DoubleE(d1/d2)_->$impossibleAppEIntegerToDoublee1->do(IntegerEi1)<-evaluatece1return$DoubleE(fromIntegeri1)AppEEqu(PairEe1e2)->doe3<-evaluatece1e4<-evaluatece2return$BoolE$equExpe3e4AppELt(PairEe1e2)->doe3<-evaluatece1e4<-evaluatece2return$BoolE$ltExpe3e4AppELte(PairEe1e2)->doe3<-evaluatece1e4<-evaluatece2return$BoolE$lteExpe3e4AppEGte(PairEe1e2)->doe3<-evaluatece1e4<-evaluatece2return$BoolE$gteExpe3e4AppEGt(PairEe1e2)->doe3<-evaluatece1e4<-evaluatece2return$BoolE$gtExpe3e4AppENote1->do(BoolEb1)<-evaluatece1return$BoolE(notb1)AppEConj(PairEe1e2)->do(BoolEb1)<-evaluatece1(BoolEb2)<-evaluatece2return$BoolE(b1&&b2)AppEDisj(PairEe1e2)->do(BoolEb1)<-evaluatece1(BoolEb2)<-evaluatece2return$BoolE(b1||b2)(TableE(TableDBtName_))->letty=reify(undefined::a)incasetyofListTtType->dotDesc<-describeTablec(escapetName)letcolumnNames=intercalate" , "$map(\s->"\""++s++"\"")$sort$mapfsttDescletquery="SELECT "++columnNames++" FROM "++"\""++escapetName++"\""-- print queryfmap(sqlToExpWithType(escapetName)tType)(quickQuerycquery[])_->$impossible(TableE(TableCSVfilename))->csvImportfilename(reify(undefined::a))_->$impossiblecompareExp::Expa->Expa->OrderingcompareExpUnitEUnitE=EQcompareExp(BoolEv1)(BoolEv2)=comparev1v2compareExp(CharEv1)(CharEv2)=comparev1v2compareExp(IntegerEv1)(IntegerEv2)=comparev1v2compareExp(DoubleEv1)(DoubleEv2)=comparev1v2compareExp(TextEv1)(TextEv2)=comparev1v2compareExp(PairEa1b1)(PairEa2b2)=casecompareExpa1a2ofEQ->compareExpb1b2LT->LTGT->GTcompareExp(ListE[])(ListE[])=EQcompareExp(ListE(_:_))(ListE[])=GTcompareExp(ListE[])(ListE(_:_))=LTcompareExp(ListE(a:as))(ListE(b:bs))=casecompareExpabofEQ->compareExp(ListEas)(ListEbs)LT->LTGT->GTcompareExp__=$impossibleequExp::Expa->Expa->BoolequExpab=casecompareExpabofEQ->True_->FalseltExp::Expa->Expa->BoolltExpab=casecompareExpabofLT->True_->FalselteExp::Expa->Expa->BoollteExpab=casecompareExpabofGT->False_->TruegteExp::Expa->Expa->BoolgteExpab=casecompareExpabofLT->False_->TruegtExp::Expa->Expa->BoolgtExpab=casecompareExpabofGT->True_->Falseescape::String->Stringescape[]=[]escape(c:cs)|c=='"'='\\':'"':escapecsescape(c:cs)=c:escapecs-- | Read SQL values into 'Norm' valuessqlToExpWithType::(Reifya)=>String-- ^ Table name, used to generate more informative error messages->Typea->[[SqlValue]]->Exp[a]sqlToExpWithTypetNamety=ListE.map(sqlValueToNormty)wheresqlValueToNorm::Typea->[SqlValue]->ExpasqlValueToNorm(PairTt1t2)s=letv1=sqlValueToNormt1$take(sizeOfTypet1)sv2=sqlValueToNormt2$drop(sizeOfTypet1)sinPairEv1v2-- On a single value, just compare the 'Type' and convert the 'SqlValue' to-- a Norm value on matchsqlValueToNormt[s]=ift`typeMatch`sthenconvertstelsetypeErrort[s]-- Everything else will raise an errorsqlValueToNormts=typeErrortstypeError::Typea->[SqlValue]->btypeErrorts=error$"ferry: Type mismatch on table \""++tName++"\":"++"\n\tExpected table type: "++showt++"\n\tTable entry: "++showsconvert::SqlValue->Typea->ExpaconvertSqlNullUnitT=UnitEconvert(SqlIntegeri)IntegerT=IntegerEiconvert(SqlInt32i)IntegerT=IntegerE$fromIntegraliconvert(SqlInt64i)IntegerT=IntegerE$fromIntegraliconvert(SqlWord32i)IntegerT=IntegerE$fromIntegraliconvert(SqlWord64i)IntegerT=IntegerE$fromIntegraliconvert(SqlDoubled)DoubleT=DoubleEdconvert(SqlRationald)DoubleT=DoubleE$fromRationaldconvert(SqlIntegerd)DoubleT=DoubleE$fromIntegraldconvert(SqlInt32d)DoubleT=DoubleE$fromIntegraldconvert(SqlInt64d)DoubleT=DoubleE$fromIntegraldconvert(SqlWord32d)DoubleT=DoubleE$fromIntegraldconvert(SqlWord64d)DoubleT=DoubleE$fromIntegraldconvert(SqlBoolb)BoolT=BoolEbconvert(SqlIntegeri)BoolT=BoolE(i/=0)convert(SqlInt32i)BoolT=BoolE(i/=0)convert(SqlInt64i)BoolT=BoolE(i/=0)convert(SqlWord32i)BoolT=BoolE(i/=0)convert(SqlWord64i)BoolT=BoolE(i/=0)convert(SqlCharc)CharT=CharEcconvert(SqlString(c:_))CharT=CharEcconvert(SqlByteStringc)CharT=CharE(head$T.unpack$T.decodeUtf8c)convert(SqlStringt)TextT=TextE(T.packt)convert(SqlByteStrings)TextT=TextE(T.decodeUtf8s)convertsql_=error$"Unsupported SqlValue: "++showsqlsizeOfType::Typea->IntsizeOfTypeUnitT=1sizeOfTypeIntegerT=1sizeOfTypeDoubleT=1sizeOfTypeBoolT=1sizeOfTypeCharT=1sizeOfTypeTextT=1sizeOfType(PairTt1t2)=sizeOfTypet1+sizeOfTypet2sizeOfType_=error"sizeOfType: Not a record type"-- | Check if a 'SqlValue' matches a 'Type'typeMatch::Typea->SqlValue->BooltypeMatchts=case(t,s)of(UnitT,SqlNull)->True(IntegerT,SqlInteger_)->True(DoubleT,SqlDouble_)->True(BoolT,SqlBool_)->True(CharT,SqlChar_)->True(TextT,SqlString_)->True(TextT,SqlByteString_)->True_->False