{-# LANGUAGE CPP #-}{-# LANGUAGE TypeFamilies #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE PackageImports #-}{-# LANGUAGE ExistentialQuantification #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE CPP #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE PatternGuards #-}-- This is to test our assumption that OverlappingInstances is just for String#ifndef NO_OVERLAP{-# LANGUAGE OverlappingInstances #-}#endif-- | API for database actions. The API deals with fields and entities.-- In SQL, a field corresponds to a column, and should be a single non-composite value.-- An entity corresponds to a SQL table, so an entity is a collection of fields.moduleDatabase.Persist.Store(PersistValue(..),SqlType(..),PersistField(..),PersistEntity(..),PersistStore(..),PersistUnique(..),PersistFilter(..),SomePersistField(..),ZT(..)-- ZonedTime wrapper,insertBy,getByValue,getJust,belongsTo,belongsToJust,checkUnique,DeleteCascade(..),PersistException(..),KeyBackend(..),Key,Entity(..)-- * Helpers,getPersistMap,listToJSON,mapToJSON-- * Config,PersistConfig(..))whereimportqualifiedPreludeimportPreludehiding((++),show)importData.Monoid(mappend)importData.Time(Day,TimeOfDay,UTCTime)importData.Time.LocalTime(ZonedTime,zonedTimeToUTC,zonedTimeToLocalTime,zonedTimeZone)importData.ByteString.Char8(ByteString,unpack)importControl.ApplicativeimportData.Typeable(Typeable)importData.Int(Int8,Int16,Int32,Int64)importData.Word(Word8,Word16,Word32,Word64)importText.Blaze.HtmlimportText.Blaze.Html.Renderer.Text(renderHtml)importqualifiedData.TextasTimportqualifiedData.Text.LazyasTLimportqualifiedData.ByteString.LazyasLimportqualifiedControl.ExceptionasEimportControl.Monad.Trans.Error(Error(..))importDatabase.Persist.EntityDefimportData.Bits(bitSize)importControl.Monad(liftM,(<=<))importControl.Arrow(second)importqualifiedData.Text.EncodingasTimportqualifiedData.Text.Encoding.ErrorasTimportWeb.PathPieces(PathPiece(..))importqualifiedData.Text.ReadimportData.Aeson(Value)importData.Aeson.Types(Parser)importqualifiedData.AesonasAimportqualifiedData.Attoparsec.NumberasANimportqualifiedData.VectorasVimportqualifiedData.SetasSimportqualifiedData.MapasMimportqualifiedData.HashMap.StrictasHMimportqualifiedData.Text.EncodingasTEimportqualifiedData.ByteString.Base64asB64importData.Aeson(toJSON)importData.Aeson.Encode(fromValue)importData.Text.Lazy(toStrict)importData.Text.Lazy.Builder(toLazyText)importControl.Monad.Trans.Control(MonadBaseControl)importControl.Monad.Trans.Class(lift)importControl.Monad.IO.Class(MonadIO,liftIO)importData.Monoid(Monoid)importData.Conduit(Pipe)importControl.Monad.Logger(LoggingT)importControl.Monad.Trans.Identity(IdentityT)importControl.Monad.Trans.List(ListT)importControl.Monad.Trans.Maybe(MaybeT)importControl.Monad.Trans.Error(ErrorT)importControl.Monad.Trans.Reader(ReaderT)importControl.Monad.Trans.Cont(ContT)importControl.Monad.Trans.State(StateT)importControl.Monad.Trans.Writer(WriterT)importControl.Monad.Trans.RWS(RWST)importControl.Monad.Trans.Resource(ResourceT)importqualifiedControl.Monad.Trans.RWS.StrictasStrict(RWST)importqualifiedControl.Monad.Trans.State.StrictasStrict(StateT)importqualifiedControl.Monad.Trans.Writer.StrictasStrict(WriterT)dataPersistException=PersistErrorT.Text-- ^ Generic Exception|PersistMarshalErrorT.Text|PersistInvalidFieldT.Text|PersistForeignConstraintUnmetT.Text|PersistMongoDBErrorT.Text|PersistMongoDBUnsupportedT.Textderiving(Show,Typeable)instanceE.ExceptionPersistExceptioninstanceErrorPersistExceptionwherestrMsg=PersistError.T.pack-- | Avoid orphan instances.newtypeZT=ZTZonedTimederiving(Show,Read,Typeable)instanceEqZTwhereZTa/=ZTb=zonedTimeToLocalTimea/=zonedTimeToLocalTimeb||zonedTimeZonea/=zonedTimeZonebinstanceOrdZTwhereZTa`compare`ZTb=zonedTimeToUTCa`compare`zonedTimeToUTCb-- | A raw value which can be stored in any backend and can be marshalled to-- and from a 'PersistField'.dataPersistValue=PersistTextT.Text|PersistByteStringByteString|PersistInt64Int64|PersistDoubleDouble|PersistBoolBool|PersistDayDay|PersistTimeOfDayTimeOfDay|PersistUTCTimeUTCTime|PersistZonedTimeZT|PersistNull|PersistList[PersistValue]|PersistMap[(T.Text,PersistValue)]|PersistObjectIdByteString-- ^ intended especially for MongoDB backendderiving(Show,Read,Eq,Typeable,Ord)instancePathPiecePersistValuewherefromPathPiecet=caseData.Text.Read.signedData.Text.Read.decimaltofRight(i,t')|T.nullt'->Just$PersistInt64i_->Just$PersistTextttoPathPiecex=casefromPersistValuexofLefte->error$T.unpackeRighty->yinstanceA.ToJSONPersistValuewheretoJSON(PersistTextt)=A.String$T.cons's'ttoJSON(PersistByteStringb)=A.String$T.cons'b'$TE.decodeUtf8$B64.encodebtoJSON(PersistInt64i)=A.Number$fromIntegralitoJSON(PersistDoubled)=A.Number$AN.DdtoJSON(PersistBoolb)=A.BoolbtoJSON(PersistTimeOfDayt)=A.String$T.cons't'$showttoJSON(PersistUTCTimeu)=A.String$T.cons'u'$showutoJSON(PersistZonedTimez)=A.String$T.cons'z'$showztoJSON(PersistDayd)=A.String$T.cons'd'$showdtoJSONPersistNull=A.NulltoJSON(PersistListl)=A.Array$V.fromList$mapA.toJSONltoJSON(PersistMapm)=A.object$map(secondA.toJSON)mtoJSON(PersistObjectIdo)=A.String$T.cons'o'$TE.decodeUtf8$B64.encodeoinstanceA.FromJSONPersistValuewhereparseJSON(A.Stringt0)=caseT.unconst0ofNothing->fail"Null string"Just('s',t)->return$PersistTexttJust('b',t)->either(fail"Invalid base64")(return.PersistByteString)$B64.decode$TE.encodeUtf8tJust('t',t)->fmapPersistTimeOfDay$readMaytJust('u',t)->fmapPersistUTCTime$readMaytJust('z',t)->fmapPersistZonedTime$readMaytJust('d',t)->fmapPersistDay$readMaytJust('o',t)->either(fail"Invalid base64")(return.PersistObjectId)$B64.decode$TE.encodeUtf8tJust(c,_)->fail$"Unknown prefix: "`mappend`[c]wherereadMay::(Reada,Monadm)=>T.Text->mareadMayt=casereads$T.unpacktof(x,_):_->returnx[]->fail"Could not read"parseJSON(A.Number(AN.Ii))=return$PersistInt64$fromIntegeriparseJSON(A.Number(AN.Dd))=return$PersistDoubledparseJSON(A.Boolb)=return$PersistBoolbparseJSONA.Null=return$PersistNullparseJSON(A.Arraya)=fmapPersistList(mapMA.parseJSON$V.toLista)parseJSON(A.Objecto)=fmapPersistMap$mapMgo$HM.toListowherego(k,v)=fmap((,)k)$A.parseJSONv-- | 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|SqlInt64|SqlReal|SqlBool|SqlDay|SqlTime|SqlDayTime|SqlDayTimeZoned|SqlBlob|SqlOtherT.Text-- ^ a backend-specific namederiving(Show,Read,Eq,Typeable,Ord)-- | A value which can be marshalled to and from a 'PersistValue'.classPersistFieldawheretoPersistValue::a->PersistValuefromPersistValue::PersistValue->EitherT.TextasqlType::a->SqlTypeisNullable::a->BoolisNullable_=False#ifndef NO_OVERLAPinstancePersistFieldStringwheretoPersistValue=PersistText.T.packfromPersistValue(PersistTexts)=Right$T.unpacksfromPersistValue(PersistByteStringbs)=Right$T.unpack$T.decodeUtf8WithT.lenientDecodebsfromPersistValue(PersistInt64i)=Right$Prelude.showifromPersistValue(PersistDoubled)=Right$Prelude.showdfromPersistValue(PersistDayd)=Right$Prelude.showdfromPersistValue(PersistTimeOfDayd)=Right$Prelude.showdfromPersistValue(PersistUTCTimed)=Right$Prelude.showdfromPersistValue(PersistZonedTime(ZTz))=Right$Prelude.showzfromPersistValuePersistNull=Left"Unexpected null"fromPersistValue(PersistBoolb)=Right$Prelude.showbfromPersistValue(PersistList_)=Left"Cannot convert PersistList to String"fromPersistValue(PersistMap_)=Left"Cannot convert PersistMap to String"fromPersistValue(PersistObjectId_)=Left"Cannot convert PersistObjectId to String"sqlType_=SqlString#endifinstancePersistFieldByteStringwheretoPersistValue=PersistByteStringfromPersistValue(PersistByteStringbs)=RightbsfromPersistValuex=T.encodeUtf8<$>fromPersistValuexsqlType_=SqlBlobinstancePersistFieldT.TextwheretoPersistValue=PersistTextfromPersistValue(PersistTexts)=RightsfromPersistValue(PersistByteStringbs)=Right$T.decodeUtf8WithT.lenientDecodebsfromPersistValue(PersistInt64i)=Right$showifromPersistValue(PersistDoubled)=Right$showdfromPersistValue(PersistDayd)=Right$showdfromPersistValue(PersistTimeOfDayd)=Right$showdfromPersistValue(PersistUTCTimed)=Right$showdfromPersistValue(PersistZonedTime(ZTz))=Right$showzfromPersistValuePersistNull=Left"Unexpected null"fromPersistValue(PersistBoolb)=Right$showbfromPersistValue(PersistList_)=Left"Cannot convert PersistList to Text"fromPersistValue(PersistMap_)=Left"Cannot convert PersistMap to Text"fromPersistValue(PersistObjectId_)=Left"Cannot convert PersistObjectId to Text"sqlType_=SqlStringinstancePersistFieldTL.TextwheretoPersistValue=toPersistValue.TL.toStrictfromPersistValue=fmapTL.fromStrict.fromPersistValuesqlType_=SqlStringinstancePersistFieldHtmlwheretoPersistValue=PersistText.TL.toStrict.renderHtmlfromPersistValue=fmap(preEscapedToMarkup::T.Text->Html).fromPersistValuesqlType_=SqlStringinstancePersistFieldIntwheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Integer, received: "++showxsqlTypex=casebitSizexof32->SqlInt32_->SqlInt64instancePersistFieldInt8wheretoPersistValue=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_=SqlInt64instancePersistFieldWord8wheretoPersistValue=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_=SqlInt64instancePersistFieldWord64wheretoPersistValue=PersistInt64.fromIntegralfromPersistValue(PersistInt64i)=Right$fromIntegralifromPersistValuex=Left$"Expected Wordeger, received: "++showxsqlType_=SqlInt64instancePersistFieldDoublewheretoPersistValue=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@(PersistTextt)=casereads$T.unpacktof(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@(PersistTextt)=casereads$T.unpacktof(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@(PersistTextt)=casereads$T.unpacktof(d,_):_->Rightd_->Left$"Expected UTCTime, received "++showxfromPersistValuex@(PersistByteStrings)=casereads$unpacksof(d,_):_->Rightd_->Left$"Expected UTCTime, received "++showxfromPersistValuex=Left$"Expected UTCTime, received: "++showxsqlType_=SqlDayTimeinstancePersistFieldZonedTimewheretoPersistValue=PersistZonedTime.ZTfromPersistValue(PersistZonedTime(ZTz))=RightzfromPersistValuex@(PersistTextt)=casereads$T.unpacktof(z,_):_->Rightz_->Left$"Expected ZonedTime, received "++showxfromPersistValuex@(PersistByteStrings)=casereads$unpacksof(z,_):_->Rightz_->Left$"Expected ZonedTime, received "++showxfromPersistValuex=Left$"Expected ZonedTime, received: "++showxsqlType_=SqlDayTimeZonedinstancePersistFielda=>PersistField(Maybea)wheretoPersistValueNothing=PersistNulltoPersistValue(Justa)=toPersistValueafromPersistValuePersistNull=RightNothingfromPersistValuex=fmapJust$fromPersistValuexsqlType_=sqlType(error"this is the problem"::a)isNullable_=True-- | Helper wrapper, equivalent to @Key (PersistEntityBackend val) val@.---- Since 1.1.0typeKeyval=KeyBackend(PersistEntityBackendval)val-- | 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-- | Parameters: val and datatype of the fielddataEntityFieldval::*->*persistFieldDef::EntityFieldvaltyp->FieldDeftypePersistEntityBackendval-- | Unique keys in existence on this entity.dataUniquevalentityDef::val->EntityDeftoPersistFields::val->[SomePersistField]fromPersistValues::[PersistValue]->EitherT.TextvalhalfDefined::valpersistUniqueToFieldNames::Uniqueval->[(HaskellName,DBName)]persistUniqueToValues::Uniqueval->[PersistValue]persistUniqueKeys::val->[Uniqueval]persistIdField::EntityFieldval(Keyval)instancePersistFielda=>PersistField[a]wheretoPersistValue=PersistList.maptoPersistValuefromPersistValue(PersistListl)=fromPersistListlfromPersistValue(PersistTextt)=fromPersistValue(PersistByteString$TE.encodeUtf8t)fromPersistValue(PersistByteStringbs)|Justvalues<-A.decode'(L.fromChunks[bs])=fromPersistListvaluesfromPersistValuex=Left$"Expected PersistList, received: "++showxsqlType_=SqlStringinstance(Orda,PersistFielda)=>PersistField(S.Seta)wheretoPersistValue=PersistList.maptoPersistValue.S.toListfromPersistValue(PersistListlist)=eitherLeft(Right.S.fromList)$fromPersistListlistfromPersistValue(PersistTextt)=fromPersistValue(PersistByteString$TE.encodeUtf8t)fromPersistValue(PersistByteStringbs)|Justvalues<-A.decode'(L.fromChunks[bs])=eitherLeft(Right.S.fromList)$fromPersistListvaluesfromPersistValuex=Left$"Expected PersistSet, received: "++showxsqlType_=SqlStringfromPersistList::PersistFielda=>[PersistValue]->EitherT.Text[a]fromPersistList=mapMfromPersistValueinstance(PersistFielda,PersistFieldb)=>PersistField(a,b)wheretoPersistValue(x,y)=PersistList[toPersistValuex,toPersistValuey]fromPersistValue(PersistList(vx:vy:[]))=case(fromPersistValuevx,fromPersistValuevy)of(Rightx,Righty)->Right(x,y)(Lefte,_)->Lefte(_,Lefte)->LeftefromPersistValuex=Left$"Expected 2 item PersistList, received: "++showxsqlType_=SqlStringinstancePersistFieldv=>PersistField(M.MapT.Textv)wheretoPersistValue=PersistMap.map(\(k,v)->(k,toPersistValuev)).M.toListfromPersistValue=fromPersistMap<=<getPersistMapsqlType_=SqlStringgetPersistMap::PersistValue->EitherT.Text[(T.Text,PersistValue)]getPersistMap(PersistMapkvs)=RightkvsgetPersistMap(PersistTextt)=getPersistMap(PersistByteString$TE.encodeUtf8t)getPersistMap(PersistByteStringbs)|Justpairs<-A.decode'(L.fromChunks[bs])=RightpairsgetPersistMapx=Left$"Expected PersistMap, received: "++showxfromPersistMap::PersistFieldv=>[(T.Text,PersistValue)]->EitherT.Text(M.MapT.Textv)fromPersistMapkvs=case(foldl(\eithAssocs(k,v)->case(eithAssocs,fromPersistValuev)of(Lefte,_)->Lefte(_,Lefte)->Lefte(Rightassocs,Rightv')->Right((k,v'):assocs))(Right[])kvs)ofRightvs->Right$M.fromListvsLefte->LeftedataSomePersistField=foralla.PersistFielda=>SomePersistFieldainstancePersistFieldSomePersistFieldwheretoPersistValue(SomePersistFielda)=toPersistValueafromPersistValuex=fmapSomePersistField(fromPersistValuex::EitherT.TextT.Text)sqlType(SomePersistFielda)=sqlTypeanewtypeKeyBackendbackendentity=Key{unKey::PersistValue}deriving(Show,Read,Eq,Ord,PersistField)instanceA.ToJSON(KeyBackendbackendentity)wheretoJSON(Keyval)=A.toJSONvalinstanceA.FromJSON(KeyBackendbackendentity)whereparseJSON=fmapKey.A.parseJSON-- | Datatype that represents an entity, with both its key and-- its Haskell representation.---- When using the an SQL-based backend (such as SQLite or-- PostgreSQL), an 'Entity' may take any number of columns-- depending on how many fields it has. In order to reconstruct-- your entity on the Haskell side, @persistent@ needs all of-- your entity columns and in the right order. Note that you-- don't need to worry about this when using @persistent@\'s API-- since everything is handled correctly behind the scenes.---- However, if you want to issue a raw SQL command that returns-- an 'Entity', then you have to be careful with the column-- order. While you could use @SELECT Entity.* WHERE ...@ and-- that would work most of the time, there are times when the-- order of the columns on your database is different from the-- order that @persistent@ expects (for example, if you add a new-- field in the middle of you entity definition and then use the-- migration code -- @persistent@ will expect the column to be in-- the middle, but your DBMS will put it as the last column).-- So, instead of using a query like the one above, you may use-- 'Database.Persist.GenericSql.rawSql' (from the-- "Database.Persist.GenericSql" module) with its /entity-- selection placeholder/ (a double question mark @??@). Using-- @rawSql@ the query above must be written as @SELECT ?? WHERE-- ..@. Then @rawSql@ will replace @??@ with the list of all-- columns that we need from your entity in the right order. If-- your query returns two entities (i.e. @(Entity backend a,-- Entity backend b)@), then you must you use @SELECT ??, ??-- WHERE ...@, and so on.dataEntityentity=Entity{entityKey::Keyentity,entityVal::entity}deriving(Eq,Ord,Show,Read)classMonadIOm=>PersistStoremwheretypePersistMonadBackendm-- | Create a new record in the database, returning an automatically created-- key (in SQL an auto-increment id).insert::(PersistMonadBackendm~PersistEntityBackendval,PersistEntityval)=>val->m(Keyval)-- | Same as 'insert', but doesn't return a @Key@.insert_::(PersistMonadBackendm~PersistEntityBackendval,PersistEntityval)=>val->m()insert_val=insertval>>return()-- | Create a new record in the database using the given key.insertKey::(PersistMonadBackendm~PersistEntityBackendval,PersistEntityval)=>Keyval->val->m()-- | Put the record in the database with the given key.-- Unlike 'replace', if a record with the given key does not-- exist then a new record will be inserted.repsert::(PersistMonadBackendm~PersistEntityBackendval,PersistEntityval)=>Keyval->val->m()-- | Replace the record in the database with the given-- key. Note that the result is undefined if such record does-- not exist, so you must use 'insertKey or 'repsert' in-- these cases.replace::(PersistMonadBackendm~PersistEntityBackendval,PersistEntityval)=>Keyval->val->m()-- | Delete a specific record by identifier. Does nothing if record does-- not exist.delete::(PersistMonadBackendm~PersistEntityBackendval,PersistEntityval)=>Keyval->m()-- | Get a record by identifier, if available.get::(PersistMonadBackendm~PersistEntityBackendval,PersistEntityval)=>Keyval->m(Maybeval)#define DEF(T) { type PersistMonadBackend (T m) = PersistMonadBackend m; insert = lift . insert; insertKey k = lift . insertKey k; repsert k = lift . repsert k; replace k = lift . replace k; delete = lift . delete; get = lift . get }#define GO(T) instance (PersistStore m) => PersistStore (T m) where DEF(T)#define GOX(X, T) instance (X, PersistStore m) => PersistStore (T m) where DEF(T)GO(LoggingT)GO(IdentityT)GO(ListT)GO(MaybeT)GOX(Errore,ErrorTe)GO(ReaderTr)GO(ContTr)GO(StateTs)GO(ResourceT)GO(Pipeliou)GOX(Monoidw,WriterTw)GOX(Monoidw,RWSTrws)GOX(Monoidw,Strict.RWSTrws)GO(Strict.StateTs)GOX(Monoidw,Strict.WriterTw)#undef DEF#undef GO#undef GOX-- | Queries against unique keys (other than the id).---- Please read the general Persistent documentation to learn how to create-- Unique keys.-- SQL backends automatically create uniqueness constraints, but for MongoDB you must place a unique index on the field.classPersistStorem=>PersistUniquemwhere-- | Get a record by unique key, if available. Returns also the identifier.getBy::(PersistEntityBackendval~PersistMonadBackendm,PersistEntityval)=>Uniqueval->m(Maybe(Entityval))-- | Delete a specific record by unique key. Does nothing if no record-- matches.deleteBy::(PersistEntityBackendval~PersistMonadBackendm,PersistEntityval)=>Uniqueval->m()-- | Like 'insert', but returns 'Nothing' when the record-- couldn't be inserted because of a uniqueness constraint.insertUnique::(PersistEntityBackendval~PersistMonadBackendm,PersistEntityval)=>val->m(Maybe(Keyval))insertUniquedatum=doisUnique<-checkUniquedatumifisUniquethenJust`liftM`insertdatumelsereturnNothing#define DEF(T) { getBy = lift . getBy; deleteBy = lift . deleteBy; insertUnique = lift . insertUnique }#define GO(T) instance (PersistUnique m) => PersistUnique (T m) where DEF(T)#define GOX(X, T) instance (X, PersistUnique m) => PersistUnique (T m) where DEF(T)GO(LoggingT)GO(IdentityT)GO(ListT)GO(MaybeT)GOX(Errore,ErrorTe)GO(ReaderTr)GO(ContTr)GO(StateTs)GO(ResourceT)GO(Pipeliou)GOX(Monoidw,WriterTw)GOX(Monoidw,RWSTrws)GOX(Monoidw,Strict.RWSTrws)GO(Strict.StateTs)GOX(Monoidw,Strict.WriterTw)#undef DEF#undef GO#undef GOX-- | 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,PersistStorem,PersistUniquem,PersistMonadBackendm~PersistEntityBackendv)=>v->m(Either(Entityv)(Keyv))insertByval=go$persistUniqueKeysvalwherego[]=Right`liftM`insertvalgo(x:xs)=doy<-getByxcaseyofNothing->goxsJustz->return$Leftz-- | A modification of 'getBy', which takes the 'PersistEntity' itself instead-- of a 'Unique' value. Returns a value matching /one/ of the unique keys. This-- function makes the most sense on entities with a single 'Unique'-- constructor.getByValue::(PersistEntityv,PersistUniquem,PersistEntityBackendv~PersistMonadBackendm)=>v->m(Maybe(Entityv))getByValueval=go$persistUniqueKeysvalwherego[]=returnNothinggo(x:xs)=doy<-getByxcaseyofNothing->goxsJustz->return$Justz-- | curry this to make a convenience function that loads an associated model-- > foreign = belongsTo foeignIdbelongsTo::(PersistStorem,PersistEntityent1,PersistEntityent2,PersistMonadBackendm~PersistEntityBackendent2)=>(ent1->Maybe(Keyent2))->ent1->m(Maybeent2)belongsToforeignKeyFieldmodel=caseforeignKeyFieldmodelofNothing->returnNothingJustf->getf-- | same as belongsTo, but uses @getJust@ and therefore is similarly unsafebelongsToJust::(PersistStorem,PersistEntityent1,PersistEntityent2,PersistMonadBackendm~PersistEntityBackendent2)=>(ent1->Keyent2)->ent1->ment2belongsToJustgetForeignKeymodel=getJust$getForeignKeymodel-- | Same as get, but for a non-null (not Maybe) foreign key-- Unsafe unless your database is enforcing that the foreign key is validgetJust::(PersistStorem,PersistEntityval,Show(Keyval),PersistMonadBackendm~PersistEntityBackendval)=>Keyval->mvalgetJustkey=getkey>>=maybe(liftIO$E.throwIO$PersistForeignConstraintUnmet$showkey)return-- | 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::(PersistEntityBackendval~PersistMonadBackendm,PersistEntityval,PersistUniquem)=>val->mBoolcheckUniqueval=go$persistUniqueKeysvalwherego[]=returnTruego(x:xs)=doy<-getByxcaseyofNothing->goxsJust_->returnFalsedataPersistFilter=Eq|Ne|Gt|Lt|Ge|Le|In|NotIn|BackendSpecificFilterT.Textderiving(Read,Show)class(PersistStorem,PersistEntitya,PersistEntityBackenda~PersistMonadBackendm)=>DeleteCascadeamwheredeleteCascade::Keya->m()instancePersistFieldPersistValuewheretoPersistValue=idfromPersistValue=RightsqlType_=SqlInt64-- since PersistValue should only be used like this for keys, which in SQL are Int64-- | Represents a value containing all the configuration options for a specific-- backend. This abstraction makes it easier to write code that can easily swap-- backends.classPersistConfigcwheretypePersistConfigBackendc::(*->*)->*->*typePersistConfigPoolc-- | Load the config settings from a 'Value', most likely taken from a YAML-- config file.loadConfig::Value->Parserc-- | Modify the config settings based on environment variables.applyEnv::c->IOcapplyEnv=return-- | Create a new connection pool based on the given config settings.createPoolConfig::c->IO(PersistConfigPoolc)-- | Run a database action by taking a connection from the pool.runPool::(MonadBaseControlIOm,MonadIOm)=>c->PersistConfigBackendcma->PersistConfigPoolc->mainfixr5++(++)::T.Text->T.Text->T.Text(++)=mappendshow::Showa=>a->T.Textshow=T.pack.Prelude.showlistToJSON::[PersistValue]->T.TextlistToJSON=toStrict.toLazyText.fromValue.toJSONmapToJSON::[(T.Text,PersistValue)]->T.TextmapToJSON=toStrict.toLazyText.fromValue.toJSON