{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE TemplateHaskell #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE PackageImports #-}{-# LANGUAGE ExistentialQuantification #-}-- | This defines the API for performing database actions. There are two levels-- to this API: dealing with fields, and dealing with entities. In SQL, a field-- corresponds to a column, and should be a single, non-composite value. An-- entity corresponds to a SQL table. In other words: An entity is a-- collection of fields.moduleDatabase.Persist.Base(PersistValue(..),SqlType(..),PersistField(..),PersistEntity(..),EntityDef(..),PersistBackend(..),PersistFilter(..),PersistUpdate(..),PersistOrder(..),SomePersistField(..),selectList,insertBy,checkUnique,DeleteCascade(..),deleteCascadeWhere,PersistException(..))whereimportLanguage.Haskell.TH.SyntaximportData.Time(Day,TimeOfDay,UTCTime)importData.ByteString.Char8(ByteString,unpack)importControl.ApplicativeimportData.Typeable(Typeable)importData.Int(Int8,Int16,Int32,Int64)importData.Word(Word8,Word16,Word32,Word64)importText.HamletimportqualifiedData.TextasTimportqualifiedData.ByteStringasSimportqualifiedData.ByteString.LazyasLimportData.EnumeratorimportqualifiedControl.ExceptionasEimportData.Bits(bitSize)importControl.Monad(liftM)importqualifiedData.Text.EncodingasTimportqualifiedData.Text.Encoding.ErrorasT-- | A raw value which can be stored in any backend and can be marshalled to-- and from a 'PersistField'.dataPersistValue=PersistStringString|PersistByteStringByteString|PersistInt64Int64|PersistDoubleDouble|PersistBoolBool|PersistDayDay|PersistTimeOfDayTimeOfDay|PersistUTCTimeUTCTime|PersistNullderiving(Show,Read,Eq,Typeable)-- | A SQL data type. Naming attempts to reflect the underlying Haskell-- datatypes, eg SqlString instead of SqlVarchar. Different SQL databases may-- have different translations for these types.dataSqlType=SqlString|SqlInt32|SqlInteger-- ^ 8-byte integer; should be renamed SqlInt64|SqlReal|SqlBool|SqlDay|SqlTime|SqlDayTime|SqlBlobderiving(Show,Read,Eq,Typeable)-- | A value which can be marshalled to and from a 'PersistValue'.classPersistFieldawheretoPersistValue::a->PersistValuefromPersistValue::PersistValue->EitherStringasqlType::a->SqlTypeisNullable::a->BoolisNullable_=FalseinstancePersistFieldStringwheretoPersistValue=PersistStringfromPersistValue(PersistStrings)=RightsfromPersistValue(PersistByteStringbs)=Right$T.unpack$T.decodeUtf8WithT.lenientDecodebsfromPersistValue(PersistInt64i)=Right$showifromPersistValue(PersistDoubled)=Right$showdfromPersistValue(PersistDayd)=Right$showdfromPersistValue(PersistTimeOfDayd)=Right$showdfromPersistValue(PersistUTCTimed)=Right$showdfromPersistValuePersistNull=Left"Unexpected null"fromPersistValue(PersistBoolb)=Right$showbsqlType_=SqlStringinstancePersistFieldByteStringwheretoPersistValue=PersistByteStringfromPersistValue(PersistByteStringbs)=RightbsfromPersistValuex=T.encodeUtf8.T.pack<$>fromPersistValuexsqlType_=SqlBlobinstancePersistFieldT.TextwheretoPersistValue=PersistString.T.unpackfromPersistValue(PersistByteStringbs)=Right$T.decodeUtf8WithT.lenientDecodebsfromPersistValuev=fmapT.pack$fromPersistValuevsqlType_=SqlStringinstancePersistFieldHtmlwheretoPersistValue=PersistByteString.S.concat.L.toChunks.renderHtmlfromPersistValue=fmapunsafeByteString.fromPersistValuesqlType_=SqlStringinstancePersistFieldIntwheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Integer, received: "++showxsqlTypex=casebitSizexof32->SqlInt32_->SqlIntegerinstancePersistFieldInt8wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Integer, received: "++showxsqlType_=SqlInt32instancePersistFieldInt16wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Integer, received: "++showxsqlType_=SqlInt32instancePersistFieldInt32wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Integer, received: "++showxsqlType_=SqlInt32instancePersistFieldInt64wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Integer, received: "++showxsqlType_=SqlIntegerinstancePersistFieldWord8wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Wordeger, received: "++showxsqlType_=SqlInt32instancePersistFieldWord16wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Wordeger, received: "++showxsqlType_=SqlInt32instancePersistFieldWord32wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Wordeger, received: "++showxsqlType_=SqlIntegerinstancePersistFieldWord64wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Wordeger, received: "++showxsqlType_=SqlIntegerinstancePersistFieldDoublewheretoPersistValue=PersistDoublefromPersistValue(PersistDoubled)=RightdfromPersistValuex=Left$"Expected Double, received: "++showxsqlType_=SqlRealinstancePersistFieldBoolwheretoPersistValue=PersistBoolfromPersistValue(PersistBoolb)=RightbfromPersistValue(PersistInt64i)=Right$i/=0fromPersistValuex=Left$"Expected Bool, received: "++showxsqlType_=SqlBoolinstancePersistFieldDaywheretoPersistValue=PersistDayfromPersistValue(PersistDayd)=RightdfromPersistValuex@(PersistStrings)=casereadssof(d,_):_->Rightd_->Left$"Expected Day, received "++showxfromPersistValuex@(PersistByteStrings)=casereads$unpacksof(d,_):_->Rightd_->Left$"Expected Day, received "++showxfromPersistValuex=Left$"Expected Day, received: "++showxsqlType_=SqlDayinstancePersistFieldTimeOfDaywheretoPersistValue=PersistTimeOfDayfromPersistValue(PersistTimeOfDayd)=RightdfromPersistValuex@(PersistStrings)=casereadssof(d,_):_->Rightd_->Left$"Expected TimeOfDay, received "++showxfromPersistValuex@(PersistByteStrings)=casereads$unpacksof(d,_):_->Rightd_->Left$"Expected TimeOfDay, received "++showxfromPersistValuex=Left$"Expected TimeOfDay, received: "++showxsqlType_=SqlTimeinstancePersistFieldUTCTimewheretoPersistValue=PersistUTCTimefromPersistValue(PersistUTCTimed)=RightdfromPersistValuex@(PersistStrings)=casereadssof(d,_):_->Rightd_->Left$"Expected UTCTime, received "++showxfromPersistValuex@(PersistByteStrings)=casereads$unpacksof(d,_):_->Rightd_->Left$"Expected UTCTime, received "++showxfromPersistValuex=Left$"Expected UTCTime, received: "++showxsqlType_=SqlDayTimeinstancePersistFielda=>PersistField(Maybea)wheretoPersistValueNothing=PersistNulltoPersistValue(Justa)=toPersistValueafromPersistValuePersistNull=RightNothingfromPersistValuex=fmapJust$fromPersistValuexsqlType_=sqlType(error"this is the problem"::a)isNullable_=True-- | A single database entity. For example, if writing a blog application, a-- blog entry would be an entry, containing fields such as title and content.classPersistEntityvalwhere-- | The unique identifier associated with this entity. In general, backends also define a type synonym for this, such that \"type MyEntityId = Key MyEntity\".dataKeyval-- | Fields which can be updated using the 'update' and 'updateWhere'-- functions.dataUpdateval-- | Filters which are available for 'select', 'updateWhere' and-- 'deleteWhere'. Each filter constructor specifies the field being-- filtered on, the type of comparison applied (equals, not equals, etc)-- and the argument for the comparison.dataFilterval-- | How you can sort the results of a 'select'.dataOrderval-- | Unique keys in existence on this entity.dataUniquevalentityDef::val->EntityDeftoPersistFields::val->[SomePersistField]fromPersistValues::[PersistValue]->EitherStringvalhalfDefined::valtoPersistKey::Int64->KeyvalfromPersistKey::Keyval->Int64showPersistKey::Keyval->StringpersistFilterToFieldName::Filterval->StringpersistFilterToFilter::Filterval->PersistFilterpersistFilterToValue::Filterval->EitherPersistValue[PersistValue]persistOrderToFieldName::Orderval->StringpersistOrderToOrder::Orderval->PersistOrderpersistUpdateToFieldName::Updateval->StringpersistUpdateToUpdate::Updateval->PersistUpdatepersistUpdateToValue::Updateval->PersistValuepersistUniqueToFieldNames::Uniqueval->[String]persistUniqueToValues::Uniqueval->[PersistValue]persistUniqueKeys::val->[Uniqueval]dataSomePersistField=foralla.PersistFielda=>SomePersistFieldainstancePersistFieldSomePersistFieldwheretoPersistValue(SomePersistFielda)=toPersistValueafromPersistValuex=fmapSomePersistField(fromPersistValuex::EitherStringString)sqlType(SomePersistFielda)=sqlTypeaclassMonadm=>PersistBackendmwhere-- | Create a new record in the database, returning the newly created-- identifier.insert::PersistEntityval=>val->m(Keyval)-- | Replace the record in the database with the given key. Result is-- undefined if such a record does not exist.replace::PersistEntityval=>Keyval->val->m()-- | Update individual fields on a specific record.update::PersistEntityval=>Keyval->[Updateval]->m()-- | Update individual fields on any record matching the given criterion.updateWhere::PersistEntityval=>[Filterval]->[Updateval]->m()-- | Delete a specific record by identifier. Does nothing if record does-- not exist.delete::PersistEntityval=>Keyval->m()-- | Delete a specific record by unique key. Does nothing if no record-- matches.deleteBy::PersistEntityval=>Uniqueval->m()-- | Delete all records matching the given criterion.deleteWhere::PersistEntityval=>[Filterval]->m()-- | Get a record by identifier, if available.get::PersistEntityval=>Keyval->m(Maybeval)-- | Get a record by unique key, if available. Returns also the identifier.getBy::PersistEntityval=>Uniqueval->m(Maybe(Keyval,val))-- | Get all records matching the given criterion in the specified order.-- Returns also the identifiers.select::PersistEntityval=>[Filterval]->[Orderval]->Int-- ^ limit->Int-- ^ offset->Enumerator(Keyval,val)ma-- | Get the 'Key's of all records matching the given criterion.selectKeys::PersistEntityval=>[Filterval]->Enumerator(Keyval)ma-- | The total number of records fulfilling the given criterion.count::PersistEntityval=>[Filterval]->mInt-- | Insert a value, checking for conflicts with any unique constraints. If a-- duplicate exists in the database, it is returned as 'Left'. Otherwise, the-- new 'Key' is returned as 'Right'.insertBy::(PersistEntityv,PersistBackendm)=>v->m(Either(Keyv,v)(Keyv))insertByval=go$persistUniqueKeysvalwherego[]=Right`liftM`insertvalgo(x:xs)=doy<-getByxcaseyofNothing->goxsJustz->return$Leftz-- | Check whether there are any conflicts for unique keys with this entity and-- existing entities in the database.---- Returns 'True' if the entity would be unique, and could thus safely be-- 'insert'ed; returns 'False' on a conflict.checkUnique::(PersistEntityval,PersistBackendm)=>val->mBoolcheckUniqueval=go$persistUniqueKeysvalwherego[]=returnTruego(x:xs)=doy<-getByxcaseyofNothing->goxsJust_->returnFalse-- | Call 'select' but return the result as a list.selectList::(PersistEntityval,PersistBackendm,Monadm)=>[Filterval]->[Orderval]->Int-- ^ limit->Int-- ^ offset->m[(Keyval,val)]selectListabcd=dores<-run$selectabcd==<<consumecaseresofLefte->error$showeRightx->returnxdataEntityDef=EntityDef{entityName::String,entityAttribs::[String],entityColumns::[(String,String,[String])]-- ^ name, type, attribs,entityUniques::[(String,[String])]-- ^ name, columns,entityDerives::[String]}derivingShowinstanceLiftEntityDefwherelift(EntityDefabcde)=dox<-[|EntityDef|]a'<-liftab'<-liftbc'<-liftcd'<-liftde'<-liftereturn$x`AppE`a'`AppE`b'`AppE`c'`AppE`d'`AppE`e'dataPersistFilter=Eq|Ne|Gt|Lt|Ge|Le|In|NotInderiving(Read,Show)instanceLiftPersistFilterwhereliftEq=[|Eq|]liftNe=[|Ne|]liftGt=[|Gt|]liftLt=[|Lt|]liftGe=[|Ge|]liftLe=[|Le|]liftIn=[|In|]liftNotIn=[|NotIn|]dataPersistOrder=Asc|Descderiving(Read,Show)instanceLiftPersistOrderwhereliftAsc=[|Asc|]liftDesc=[|Desc|]classPersistEntitya=>DeleteCascadeawheredeleteCascade::PersistBackendm=>Keya->m()deleteCascadeWhere::(DeleteCascadea,PersistBackendm)=>[Filtera]->m()deleteCascadeWherefilts=dores<-run$selectKeysfilts$ContinueitercaseresofLefte->error$showeRight()->return()whereiterEOF=Iteratee$return$Yield()EOFiter(Chunkskeys)=Iteratee$domapM_deleteCascadekeysreturn$ContinueiterdataPersistException=PersistMarshalExceptionStringderiving(Show,Typeable)instanceE.ExceptionPersistExceptiondataPersistUpdate=Update|Add|Subtract|Multiply|Dividederiving(Read,Show)instanceLiftPersistUpdatewhereliftUpdate=[|Update|]liftAdd=[|Add|]liftSubtract=[|Subtract|]liftMultiply=[|Multiply|]liftDivide=[|Divide|]