{-# LANGUAGE CPP #-}{-# LANGUAGE DefaultSignatures #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE FlexibleInstances #-}#ifndef NO_OVERLAP{-# LANGUAGE OverlappingInstances #-}#endifmoduleDatabase.Persist.Sql.Class(MonadSqlPersist(..),RawSql(..),PersistFieldSql(..))whereimportControl.Applicative((<$>),(<*>))importDatabase.PersistimportData.Monoid((<>))importDatabase.Persist.Sql.TypesimportControl.Arrow((&&&))importData.Text(Text,intercalate,pack)importData.Maybe(fromMaybe)importData.FixedimportData.Monoid(Monoid)importControl.Monad.Trans.Class(lift)importControl.Monad.Logger(LoggingT)importControl.Monad.Trans.Identity(IdentityT)importControl.Monad.Trans.List(ListT)importControl.Monad.Trans.Maybe(MaybeT)importControl.Monad.Trans.Error(ErrorT,Error)importControl.Monad.Trans.Cont(ContT)importControl.Monad.Trans.State(StateT)importControl.Monad.Trans.Writer(WriterT)importControl.Monad.Trans.RWS(RWST)importControl.Monad.Trans.Reader(ReaderT,ask)importControl.Monad.Trans.Resource(ResourceT)importData.Conduit.Internal(Pipe,ConduitM)importqualifiedControl.Monad.Trans.RWS.StrictasStrict(RWST)importqualifiedControl.Monad.Trans.State.StrictasStrict(StateT)importqualifiedControl.Monad.Trans.Writer.StrictasStrict(WriterT)importControl.Monad.IO.Class(MonadIO)importControl.Monad.Trans.Class(MonadTrans)importControl.Monad.Logger(MonadLogger)importqualifiedData.TextasTimportqualifiedData.Text.LazyasTLimportqualifiedData.MapasMimportqualifiedData.SetasSimportData.Time(ZonedTime,UTCTime,TimeOfDay,Day)importData.IntimportData.WordimportData.ByteString(ByteString)importText.Blaze.Html(Html)importData.Bits(bitSize)class(MonadIOm,MonadLoggerm)=>MonadSqlPersistmwhereaskSqlConn::mConnectiondefaultaskSqlConn::(MonadSqlPersistm,MonadTranst,MonadLogger(tm))=>tmConnectionaskSqlConn=liftaskSqlConninstance(MonadIOm,MonadLoggerm)=>MonadSqlPersist(SqlPersistTm)whereaskSqlConn=SqlPersistTask#define GO(T) instance (MonadSqlPersist m) => MonadSqlPersist (T m)#define GOX(X, T) instance (X, MonadSqlPersist m) => MonadSqlPersist (T m)GO(LoggingT)GO(IdentityT)GO(ListT)GO(MaybeT)GOX(Errore,ErrorTe)GO(ReaderTr)GO(ContTr)GO(StateTs)GO(ResourceT)GO(Pipeliou)GO(ConduitMio)GOX(Monoidw,WriterTw)GOX(Monoidw,RWSTrws)GOX(Monoidw,Strict.RWSTrws)GO(Strict.StateTs)GOX(Monoidw,Strict.WriterTw)#undef GO#undef GOX-- | Class for data types that may be retrived from a 'rawSql'-- query.classRawSqlawhere-- | Number of columns that this data type needs and the list-- of substitutions for @SELECT@ placeholders @??@.rawSqlCols::(DBName->Text)->a->(Int,[Text])-- | A string telling the user why the column count is what-- it is.rawSqlColCountReason::a->String-- | Transform a row of the result into the data type.rawSqlProcessRow::[PersistValue]->EitherTextainstancePersistFielda=>RawSql(Singlea)whererawSqlCols__=(1,[])rawSqlColCountReason_="one column for a 'Single' data type"rawSqlProcessRow[pv]=Single<$>fromPersistValuepvrawSqlProcessRow_=Left$pack"RawSql (Single a): wrong number of columns."instancePersistEntitya=>RawSql(Entitya)whererawSqlColsescape=((+1).length.entityFields&&&process).entityDef.Just.entityValwhereprocessed=(:[])$intercalate", "$map((nameed<>).escape)$(entityIDed:)$mapfieldDB$entityFieldsednameed=escape(entityDBed)<>"."rawSqlColCountReasona=casefst(rawSqlCols(error"RawSql")a)of1->"one column for an 'Entity' data type without fields"n->shown++" columns for an 'Entity' data type"rawSqlProcessRow(idCol:ent)=Entity<$>fromPersistValueidCol<*>fromPersistValuesentrawSqlProcessRow_=Left"RawSql (Entity a): wrong number of columns."-- | Since 1.0.1.instanceRawSqla=>RawSql(Maybea)whererawSqlColse=rawSqlColse.extractMayberawSqlColCountReason=rawSqlColCountReason.extractMayberawSqlProcessRowcols|allisNullcols=returnNothing|otherwise=caserawSqlProcessRowcolsofRightv->Right(Justv)Leftmsg->Left$"RawSql (Maybe a): not all columns were Null "<>"but the inner parser has failed. Its message "<>"was \""<>msg<>"\". Did you apply Maybe "<>"to a tuple, perhaps? The main use case for "<>"Maybe is to allow OUTER JOINs to be written, "<>"in which case 'Maybe (Entity v)' is used."whereisNullPersistNull=TrueisNull_=Falseinstance(RawSqla,RawSqlb)=>RawSql(a,b)whererawSqlColsex=rawSqlColse(fstx)#rawSqlColse(sndx)where(cnta,lsta)#(cntb,lstb)=(cnta+cntb,lsta++lstb)rawSqlColCountReasonx=rawSqlColCountReason(fstx)++", "++rawSqlColCountReason(sndx)rawSqlProcessRow=letx=getTypeprocessRowgetType::(z->Eitheryx)->xgetType=error"RawSql.getType"colCountFst=fst$rawSqlCols(error"RawSql.getType2")(fstx)processRowrow=let(rowFst,rowSnd)=splitAtcolCountFstrowin(,)<$>rawSqlProcessRowrowFst<*>rawSqlProcessRowrowSndincolCountFst`seq`processRow-- Avoids recalculating 'colCountFst'.instance(RawSqla,RawSqlb,RawSqlc)=>RawSql(a,b,c)whererawSqlColse=rawSqlColse.from3rawSqlColCountReason=rawSqlColCountReason.from3rawSqlProcessRow=fmapto3.rawSqlProcessRowfrom3::(a,b,c)->((a,b),c)from3(a,b,c)=((a,b),c)to3::((a,b),c)->(a,b,c)to3((a,b),c)=(a,b,c)instance(RawSqla,RawSqlb,RawSqlc,RawSqld)=>RawSql(a,b,c,d)whererawSqlColse=rawSqlColse.from4rawSqlColCountReason=rawSqlColCountReason.from4rawSqlProcessRow=fmapto4.rawSqlProcessRowfrom4::(a,b,c,d)->((a,b),(c,d))from4(a,b,c,d)=((a,b),(c,d))to4::((a,b),(c,d))->(a,b,c,d)to4((a,b),(c,d))=(a,b,c,d)instance(RawSqla,RawSqlb,RawSqlc,RawSqld,RawSqle)=>RawSql(a,b,c,d,e)whererawSqlColse=rawSqlColse.from5rawSqlColCountReason=rawSqlColCountReason.from5rawSqlProcessRow=fmapto5.rawSqlProcessRowfrom5::(a,b,c,d,e)->((a,b),(c,d),e)from5(a,b,c,d,e)=((a,b),(c,d),e)to5::((a,b),(c,d),e)->(a,b,c,d,e)to5((a,b),(c,d),e)=(a,b,c,d,e)instance(RawSqla,RawSqlb,RawSqlc,RawSqld,RawSqle,RawSqlf)=>RawSql(a,b,c,d,e,f)whererawSqlColse=rawSqlColse.from6rawSqlColCountReason=rawSqlColCountReason.from6rawSqlProcessRow=fmapto6.rawSqlProcessRowfrom6::(a,b,c,d,e,f)->((a,b),(c,d),(e,f))from6(a,b,c,d,e,f)=((a,b),(c,d),(e,f))to6::((a,b),(c,d),(e,f))->(a,b,c,d,e,f)to6((a,b),(c,d),(e,f))=(a,b,c,d,e,f)instance(RawSqla,RawSqlb,RawSqlc,RawSqld,RawSqle,RawSqlf,RawSqlg)=>RawSql(a,b,c,d,e,f,g)whererawSqlColse=rawSqlColse.from7rawSqlColCountReason=rawSqlColCountReason.from7rawSqlProcessRow=fmapto7.rawSqlProcessRowfrom7::(a,b,c,d,e,f,g)->((a,b),(c,d),(e,f),g)from7(a,b,c,d,e,f,g)=((a,b),(c,d),(e,f),g)to7::((a,b),(c,d),(e,f),g)->(a,b,c,d,e,f,g)to7((a,b),(c,d),(e,f),g)=(a,b,c,d,e,f,g)instance(RawSqla,RawSqlb,RawSqlc,RawSqld,RawSqle,RawSqlf,RawSqlg,RawSqlh)=>RawSql(a,b,c,d,e,f,g,h)whererawSqlColse=rawSqlColse.from8rawSqlColCountReason=rawSqlColCountReason.from8rawSqlProcessRow=fmapto8.rawSqlProcessRowfrom8::(a,b,c,d,e,f,g,h)->((a,b),(c,d),(e,f),(g,h))from8(a,b,c,d,e,f,g,h)=((a,b),(c,d),(e,f),(g,h))to8::((a,b),(c,d),(e,f),(g,h))->(a,b,c,d,e,f,g,h)to8((a,b),(c,d),(e,f),(g,h))=(a,b,c,d,e,f,g,h)extractMaybe::Maybea->aextractMaybe=fromMaybe(error"Database.Persist.GenericSql.extractMaybe")classPersistFielda=>PersistFieldSqlawheresqlType::Monadm=>ma->SqlType#ifndef NO_OVERLAPinstancePersistFieldSqlStringwheresqlType_=SqlString#endifinstancePersistFieldSqlByteStringwheresqlType_=SqlBlobinstancePersistFieldSqlT.TextwheresqlType_=SqlStringinstancePersistFieldSqlTL.TextwheresqlType_=SqlStringinstancePersistFieldSqlHtmlwheresqlType_=SqlStringinstancePersistFieldSqlIntwheresqlType_|bitSize(0::Int)<=32=SqlInt32|otherwise=SqlInt64instancePersistFieldSqlInt8wheresqlType_=SqlInt32instancePersistFieldSqlInt16wheresqlType_=SqlInt32instancePersistFieldSqlInt32wheresqlType_=SqlInt32instancePersistFieldSqlInt64wheresqlType_=SqlInt64instancePersistFieldSqlWordwheresqlType_=SqlInt64instancePersistFieldSqlWord8wheresqlType_=SqlInt32instancePersistFieldSqlWord16wheresqlType_=SqlInt32instancePersistFieldSqlWord32wheresqlType_=SqlInt64instancePersistFieldSqlWord64wheresqlType_=SqlInt64instancePersistFieldSqlDoublewheresqlType_=SqlRealinstancePersistFieldSqlBoolwheresqlType_=SqlBoolinstancePersistFieldSqlDaywheresqlType_=SqlDayinstancePersistFieldSqlTimeOfDaywheresqlType_=SqlTimeinstancePersistFieldSqlUTCTimewheresqlType_=SqlDayTimeinstancePersistFieldSqlZonedTimewheresqlType_=SqlDayTimeZonedinstancePersistFieldSqla=>PersistFieldSql[a]wheresqlType_=SqlStringinstance(Orda,PersistFieldSqla)=>PersistFieldSql(S.Seta)wheresqlType_=SqlStringinstance(PersistFieldSqla,PersistFieldSqlb)=>PersistFieldSql(a,b)wheresqlType_=SqlStringinstancePersistFieldSqlv=>PersistFieldSql(M.MapT.Textv)wheresqlType_=SqlStringinstancePersistFieldSqlPersistValuewheresqlType_=SqlInt64-- since PersistValue should only be used like this for keys, which in SQL are Int64instancePersistFieldSqlCheckmarkwheresqlType_=SqlBoolinstance(HasResolutiona)=>PersistFieldSql(Fixeda)wheresqlTypea=SqlNumericlongprecwhereprec=round$(log$fromIntegral$resolutionn)/(log10::Double)-- FIXME: May lead to problems with big numberslong=prec+10-- FIXME: Is this enough ?n=0_mn=returnn`asTypeOf`ainstancePersistFieldSqlRationalwheresqlType_=SqlNumeric3220-- need to make this field big enough to handle Rational to Mumber string conversion for ODBC-- perhaps a SQL user can figure this sqlType out?-- It is really intended for MongoDB though.instancePersistFieldentity=>PersistFieldSql(Entityentity)wheresqlType_=SqlOther"embedded entity, hard to type"instancePersistFieldSql(KeyBackendSqlBackenda)wheresqlType_=SqlInt64