persistent 2.2.4 → 2.2.4.1
raw patch · 9 files changed
+472/−132 lines, 9 files
Files
- ChangeLog.md +4/−0
- Database/Persist.hs +331/−20
- Database/Persist/Class/DeleteCascade.hs +7/−0
- Database/Persist/Class/PersistEntity.hs +49/−48
- Database/Persist/Class/PersistField.hs +34/−32
- Database/Persist/Class/PersistQuery.hs +4/−3
- Database/Persist/Class/PersistStore.hs +10/−9
- Database/Persist/Class/PersistUnique.hs +32/−19
- persistent.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 2.2.4.1++* Documentation updates [#515](https://github.com/yesodweb/persistent/pull/515)+ ## 2.2.4 * Workaround for side-exiting transformers in `runSqlConn` [#516](https://github.com/yesodweb/persistent/issues/516)
Database/Persist.hs view
@@ -6,19 +6,43 @@ ( module Database.Persist.Class , module Database.Persist.Types - -- * query combinators+ -- * Reference Schema & Dataset+ -- |+ --+ -- All the combinators present here will be explained based on this schema:+ --+ -- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|+ -- > User+ -- > name String+ -- > age Int+ -- > deriving Show+ -- > |]+ --+ -- and this dataset. The examples below will refer to this as dataset-1.+ --+ -- #dataset#+ --+ -- > +-----+-----+-----++ -- > |id |name |age |+ -- > +-----+-----+-----++ -- > |1 |SPJ |40 |+ -- > +-----+-----+-----++ -- > |2 |Simon|41 |+ -- > +-----+-----+-----+++ -- * Query update combinators , (=.), (+=.), (-=.), (*=.), (/=.)- , (==.), (!=.), (<.), (>.), (<=.), (>=.)- , (<-.), (/<-.)- , (||.) + -- * Query filter combinators+ , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.)+ -- * JSON Utilities , listToJSON , mapToJSON , toJsonText , getPersistMap - -- * Other utililities+ -- * Other utilities , limitOffsetOrder ) where @@ -36,51 +60,335 @@ #endif infixr 3 =., +=., -=., *=., /=.-(=.), (+=.), (-=.), (*=.), (/=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update v--- | assign a field a value+(=.), (+=.), (-=.), (*=.), (/=.) ::+ forall v typ. PersistField typ => EntityField v typ -> typ -> Update v++-- | Assign a field a value.+--+-- === __Example usage__+--+-- @+-- updateAge :: MonadIO m => ReaderT SqlBackend m ()+-- updateAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge =. 45]+-- @+--+-- Similar to `updateWhere` which is shown in the above example you can use other functions present in the module "Database.Persist.Class". Note that the first parameter of `updateWhere` is [`Filter` val] and second parameter is [`Update` val]. By comparing this with the type of `==.` and `=.`, you can see that they match up in the above usage.+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+-- +-- > +-----+-----+--------++-- > |id |name |age |+-- > +-----+-----+--------++-- > |1 |SPJ |40 -> 45|+-- > +-----+-----+--------++-- > |2 |Simon|41 |+-- > +-----+-----+--------++ f =. a = Update f a Assign--- | assign a field by addition (+=)++-- | Assign a field by addition (@+=@).+--+-- === __Example usage__+--+-- @+-- addAge :: MonadIO m => ReaderT SqlBackend m ()+-- addAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge +=. 1]+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+---------++-- > |id |name |age |+-- > +-----+-----+---------++-- > |1 |SPJ |40 -> 41 |+-- > +-----+-----+---------++-- > |2 |Simon|41 |+-- > +-----+-----+---------+++ f +=. a = Update f a Add--- | assign a field by subtraction (-=)++-- | Assign a field by subtraction (@-=@).+--+-- === __Example usage__+--+-- @+-- subtractAge :: MonadIO m => ReaderT SqlBackend m ()+-- subtractAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge -=. 1]+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+---------++-- > |id |name |age |+-- > +-----+-----+---------++-- > |1 |SPJ |40 -> 39 |+-- > +-----+-----+---------++-- > |2 |Simon|41 |+-- > +-----+-----+---------++ f -=. a = Update f a Subtract--- | assign a field by multiplication (*=)++-- | Assign a field by multiplication (@*=@).+--+-- === __Example usage__+--+-- @+-- multiplyAge :: MonadIO m => ReaderT SqlBackend m ()+-- multiplyAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge *=. 2]+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+--------++-- > |id |name |age |+-- > +-----+-----+--------++-- > |1 |SPJ |40 -> 80|+-- > +-----+-----+--------++-- > |2 |Simon|41 |+-- > +-----+-----+--------+++ f *=. a = Update f a Multiply--- | assign a field by division (/=)++-- | Assign a field by division (@/=@).+--+-- === __Example usage__+--+-- @+-- divideAge :: MonadIO m => ReaderT SqlBackend m ()+-- divideAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge /=. 2]+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+---------++-- > |id |name |age |+-- > +-----+-----+---------++-- > |1 |SPJ |40 -> 20 |+-- > +-----+-----+---------++-- > |2 |Simon|41 |+-- > +-----+-----+---------++ f /=. a = Update f a Divide infix 4 ==., <., <=., >., >=., !=. (==.), (!=.), (<.), (<=.), (>.), (>=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v++-- | Check for equality.+--+-- === __Example usage__+--+-- @+-- selectSPJ :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectSPJ = selectList [UserName ==. \"SPJ\" ] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |1 |SPJ |40 |+-- > +-----+-----+-----++ f ==. a = Filter f (Left a) Eq++-- | Non-equality check.+--+-- === __Example usage__+--+-- @+-- selectSimon :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectSimon = selectList [UserName !=. \"SPJ\" ] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |2 |Simon|41 |+-- > +-----+-----+-----++ f !=. a = Filter f (Left a) Ne++-- | Less-than check.+--+-- === __Example usage__+--+-- @+-- selectLessAge :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectLessAge = selectList [UserAge <. 41 ] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |1 |SPJ |40 |+-- > +-----+-----+-----++ f <. a = Filter f (Left a) Lt++-- | Less-than or equal check.+--+-- === __Example usage__+--+-- @+-- selectLessEqualAge :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectLessEqualAge = selectList [UserAge <=. 40 ] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |1 |SPJ |40 |+-- > +-----+-----+-----++ f <=. a = Filter f (Left a) Le++-- | Greater-than check.+--+-- === __Example usage__+--+-- @+-- selectGreaterAge :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectGreaterAge = selectList [UserAge >. 40 ] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |2 |Simon|41 |+-- > +-----+-----+-----++ f >. a = Filter f (Left a) Gt++-- | Greater-than or equal check.+--+-- === __Example usage__+--+-- @+-- selectGreaterEqualAge :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectGreaterEqualAge = selectList [UserAge >=. 41 ] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |2 |Simon|41 |+-- > +-----+-----+-----++ f >=. a = Filter f (Left a) Ge infix 4 <-., /<-. (<-.), (/<-.) :: forall v typ. PersistField typ => EntityField v typ -> [typ] -> Filter v--- | In++-- | Check if value is in given list.+--+-- === __Example usage__+--+-- @+-- selectUsers :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectUsers = selectList [UserAge <-. [40, 41]] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |1 |SPJ |40 |+-- > +-----+-----+-----++-- > |2 |Simon|41 |+-- > +-----+-----+-----++--+--+-- @+-- selectSPJ :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectSPJ = selectList [UserAge <-. [40]] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |1 |SPJ |40 |+-- > +-----+-----+-----++ f <-. a = Filter f (Right a) In--- | NotIn++-- | Check if value is not in given list.+--+-- === __Example usage__+--+-- @+-- selectSimon :: MonadIO m => ReaderT SqlBackend m [Entity User]+-- selectSimon = selectList [UserAge /<-. [40]] []+-- @+--+-- The above query when applied on <#dataset dataset-1>, will produce this:+--+-- > +-----+-----+-----++-- > |id |name |age |+-- > +-----+-----+-----++-- > |2 |Simon|41 |+-- > +-----+-----+-----++ f /<-. a = Filter f (Right a) NotIn infixl 3 ||. (||.) :: forall v. [Filter v] -> [Filter v] -> [Filter v]--- | the OR of two lists of filters. For example: --- selectList([PersonAge >. 25, PersonAge <. 30] ||. [PersonIncome >. 15000, PersonIncome <. 25000]) []--- will filter records where a person's age is between (25 and 30) OR a person's income is between (15,000 and 25000). --- If you are looking for an &&. operator to do (A AND B AND (C OR D)) you can use the ++ operator instead as there is no &&. For example: --- selectList([PersonAge >. 25, PersonAge <. 30] ++ ([PersonCategory ==. 1] ||. [PersonCategory ==. 5])) []--- will filter records where a person's age is between (25 and 30) AND (person's category is either 1 or 5) ++-- | The OR of two lists of filters. For example:+--+-- > selectList+-- > ([ PersonAge >. 25+-- > , PersonAge <. 30 ] ||.+-- > [ PersonIncome >. 15000+-- > , PersonIncome <. 25000 ])+-- > []+--+-- will filter records where a person's age is between 25 and 30 /or/ a+-- person's income is between (15000 and 25000).+--+-- If you are looking for an @(&&.)@ operator to do @(A AND B AND (C OR D))@+-- you can use the @(++)@ operator instead as there is no @(&&.)@. For+-- example:+--+-- > selectList+-- > ([ PersonAge >. 25+-- > , PersonAge <. 30 ] +++-- > ([PersonCategory ==. 1] ||.+-- > [PersonCategory ==. 5]))+-- > []+--+-- will filter records where a person's age is between 25 and 30 /and/+-- (person's category is either 1 or 5). a ||. b = [FilterOr [FilterAnd a, FilterAnd b]] +-- | Convert list of 'PersistValue's into textual representation of JSON+-- object. This is a type-constrained synonym for 'toJsonText'. listToJSON :: [PersistValue] -> T.Text listToJSON = toJsonText +-- | Convert map (list of tuples) into textual representation of JSON+-- object. This is a type-constrained synonym for 'toJsonText'. mapToJSON :: [(T.Text, PersistValue)] -> T.Text mapToJSON = toJsonText +-- | A more general way to convert instances of `ToJSON` type class to+-- strict text 'T.Text'. toJsonText :: ToJSON j => j -> T.Text #if MIN_VERSION_aeson(0, 7, 0) toJsonText = toStrict . toLazyText . encodeToTextBuilder . toJSON@@ -88,7 +396,10 @@ toJsonText = toStrict . toLazyText . fromValue . toJSON #endif -limitOffsetOrder :: PersistEntity val => [SelectOpt val] -> (Int, Int, [SelectOpt val])+-- | FIXME What's this exactly?+limitOffsetOrder :: PersistEntity val+ => [SelectOpt val]+ -> (Int, Int, [SelectOpt val]) limitOffsetOrder opts = foldr go (0, 0, []) opts where
Database/Persist/Class/DeleteCascade.hs view
@@ -15,10 +15,17 @@ import Control.Monad.Reader (ReaderT, ask, runReaderT) import Data.Acquire (with) +-- | For combinations of backends and entities that support+-- cascade-deletion. “Cascade-deletion” means that entries that depend on+-- other entries to be deleted will be deleted as well. class (PersistStore backend, PersistEntity record, backend ~ PersistEntityBackend record) => DeleteCascade record backend where++ -- | Perform cascade-deletion of single database+ -- entry. deleteCascade :: MonadIO m => Key record -> ReaderT backend m () +-- | Cascade-deletion of entries satisfying given filters. deleteCascadeWhere :: (MonadIO m, DeleteCascade record backend, PersistQuery backend) => [Filter record] -> ReaderT backend m () deleteCascadeWhere filts = do
Database/Persist/Class/PersistEntity.hs view
@@ -44,60 +44,63 @@ -- A Database 'Entity' (A row in SQL, a document in MongoDB, etc) -- corresponds to a 'Key' plus a Haskell record. ----- For every Haskell record type stored in the database there is a corresponding 'PersistEntity' instance.--- An instance of PersistEntity contains meta-data for the record.--- PersistEntity also helps abstract over different record types.--- That way the same query interface can return a 'PersistEntity', with each query returning different types of Haskell records.+-- For every Haskell record type stored in the database there is a+-- corresponding 'PersistEntity' instance. An instance of PersistEntity+-- contains meta-data for the record. PersistEntity also helps abstract+-- over different record types. That way the same query interface can return+-- a 'PersistEntity', with each query returning different types of Haskell+-- records. ----- Some advanced type system capabilities are used to make this process type-safe.--- Persistent users usually don't need to understand the class associated data and functions.+-- Some advanced type system capabilities are used to make this process+-- type-safe. Persistent users usually don't need to understand the class+-- associated data and functions. class ( PersistField (Key record), ToJSON (Key record), FromJSON (Key record) , Show (Key record), Read (Key record), Eq (Key record), Ord (Key record)) => PersistEntity record where- -- | Persistent allows multiple different backends (databases)+ -- | Persistent allows multiple different backends (databases). type PersistEntityBackend record -- | By default, a backend will automatically generate the key -- Instead you can specify a Primary key made up of unique values. data Key record- -- | a lower-level key operation+ -- | A lower-level key operation. keyToValues :: Key record -> [PersistValue]- -- | a lower-level key operation+ -- | A lower-level key operation. keyFromValues :: [PersistValue] -> Either Text (Key record)- -- | a meta-operation to retrieve the Key EntityField+ -- | A meta-operation to retrieve the 'Key' 'EntityField'. persistIdField :: EntityField record (Key record) - -- | retrieve the EntityDef meta-data for the record+ -- | Retrieve the 'EntityDef' meta-data for the record. entityDef :: Monad m => m record -> EntityDef -- | An 'EntityField' is parameterised by the Haskell record it belongs to- -- and the additional type of that field+ -- and the additional type of that field. data EntityField record :: * -> *- -- | return meta-data for a given 'EntityField'+ -- | Return meta-data for a given 'EntityField'. persistFieldDef :: EntityField record typ -> FieldDef- -- | A meta-operation to get the database fields of a record+ -- | A meta-operation to get the database fields of a record. toPersistFields :: record -> [SomePersistField]- -- | A lower-level operation to convert from database values to a Haskell record+ -- | A lower-level operation to convert from database values to a Haskell record. fromPersistValues :: [PersistValue] -> Either Text record - -- | Unique keys besides the Key+ -- | Unique keys besides the 'Key'. data Unique record- -- | A meta operation to retrieve all the Unique keys+ -- | A meta operation to retrieve all the 'Unique' keys. persistUniqueKeys :: record -> [Unique record]- -- | A lower level operation+ -- | A lower level operation. persistUniqueToFieldNames :: Unique record -> [(HaskellName, DBName)]- -- | A lower level operation+ -- | A lower level operation. persistUniqueToValues :: Unique record -> [PersistValue] - -- | Use a PersistField as a lens+ -- | Use a 'PersistField' as a lens. fieldLens :: EntityField record field -> (forall f. Functor f => (field -> f field) -> Entity record -> f (Entity record)) type family BackendSpecificUpdate backend record --- | Updating a database entity+-- | Updating a database entity. ----- Persistent users use combinators to create these+-- Persistent users use combinators to create these. data Update record = forall typ. PersistField typ => Update { updateField :: EntityField record typ , updateValue :: typ@@ -107,9 +110,9 @@ | BackendUpdate (BackendSpecificUpdate (PersistEntityBackend record) record) --- | query options+-- | Query options. ----- Persistent users use these directly+-- Persistent users use these directly. data SelectOpt record = forall typ. Asc (EntityField record typ) | forall typ. Desc (EntityField record typ) | OffsetBy Int@@ -122,7 +125,7 @@ -- filtered on, the type of comparison applied (equals, not equals, etc) -- and the argument for the comparison. ----- Persistent users use combinators to create these+-- Persistent users use combinators to create these. data Filter record = forall typ. PersistField typ => Filter { filterField :: EntityField record typ , filterValue :: Either typ [typ] -- FIXME@@ -175,6 +178,7 @@ deriving instance Typeable Entity #endif +-- | Get list of values corresponding to given entity. entityValues :: PersistEntity record => Entity record -> [PersistValue] entityValues (Entity k record) = if isJust (entityPrimary ent)@@ -187,13 +191,13 @@ ent = entityDef $ Just record -- | Predefined @toJSON@. The resulting JSON looks like--- @{\"key\": 1, \"value\": {\"name\": ...}}@.+-- @{"key": 1, "value": {"name": ...}}@. -- -- The typical usage is: -- -- @--- instance ToJSON (Entity User) where--- toJSON = keyValueEntityToJSON+-- instance ToJSON (Entity User) where+-- toJSON = keyValueEntityToJSON -- @ keyValueEntityToJSON :: (PersistEntity record, ToJSON record, ToJSON (Key record)) => Entity record -> Value@@ -203,13 +207,13 @@ ] -- | Predefined @parseJSON@. The input JSON looks like--- @{\"key\": 1, \"value\": {\"name\": ...}}@.+-- @{"key": 1, "value": {"name": ...}}@. -- -- The typical usage is: -- -- @--- instance FromJSON (Entity User) where--- parseJSON = keyValueEntityFromJSON+-- instance FromJSON (Entity User) where+-- parseJSON = keyValueEntityFromJSON -- @ keyValueEntityFromJSON :: (PersistEntity record, FromJSON record, FromJSON (Key record)) => Value -> Parser (Entity record)@@ -219,13 +223,13 @@ keyValueEntityFromJSON _ = fail "keyValueEntityFromJSON: not an object" -- | Predefined @toJSON@. The resulting JSON looks like--- @{\"id\": 1, \"name\": ...}@.+-- @{"id": 1, "name": ...}@. -- -- The typical usage is: -- -- @--- instance ToJSON (Entity User) where--- toJSON = entityIdToJSON+-- instance ToJSON (Entity User) where+-- toJSON = entityIdToJSON -- @ entityIdToJSON :: (PersistEntity record, ToJSON record, ToJSON (Key record)) => Entity record -> Value entityIdToJSON (Entity key value) = case toJSON value of@@ -233,13 +237,13 @@ x -> x -- | Predefined @parseJSON@. The input JSON looks like--- @{\"id\": 1, \"name\": ...}@.+-- @{"id": 1, "name": ...}@. -- -- The typical usage is: -- -- @--- instance FromJSON (Entity User) where--- parseJSON = entityIdFromJSON+-- instance FromJSON (Entity User) where+-- parseJSON = entityIdFromJSON -- @ entityIdFromJSON :: (PersistEntity record, FromJSON record, FromJSON (Key record)) => Value -> Parser (Entity record) entityIdFromJSON value@(Object o) = Entity <$> o .: "id" <*> parseJSON value@@ -273,34 +277,32 @@ idField = "_id" -- | Convenience function for getting a free 'PersistField' instance--- from a type with JSON instances.+-- from a type with JSON instances. -- ----- Example usage in combination with`fromPersistValueJSON`:+-- Example usage in combination with 'fromPersistValueJSON': -- -- @ -- instance PersistField MyData where -- fromPersistValue = fromPersistValueJSON -- toPersistValue = toPersistValueJSON -- @--- toPersistValueJSON :: ToJSON a => a -> PersistValue toPersistValueJSON = PersistText . LT.toStrict . TB.toLazyText . encodeToTextBuilder . toJSON -- | Convenience function for getting a free 'PersistField' instance--- from a type with JSON instances. The JSON parser used will accept--- JSON values other that object and arrays. So, if your instance--- serializes the data to a JSON string, this will still work.+-- from a type with JSON instances. The JSON parser used will accept JSON+-- values other that object and arrays. So, if your instance serializes the+-- data to a JSON string, this will still work. -- ----- Example usage in combination with`toPersistValueJSON`:+-- Example usage in combination with 'toPersistValueJSON': -- -- @ -- instance PersistField MyData where -- fromPersistValue = fromPersistValueJSON -- toPersistValue = toPersistValueJSON -- @--- fromPersistValueJSON :: FromJSON a => PersistValue -> Either Text a fromPersistValueJSON z = case z of PersistByteString bs -> mapLeft (T.append "Could not parse the JSON (was a PersistByteString): ")@@ -323,7 +325,7 @@ -- your field will order rows by the data constructor order, this is -- a better choice. ----- Example usage in combination with `fromPersistValueEnum`:+-- Example usage in combination with 'fromPersistValueEnum': -- -- @ -- data SeverityLevel = Low | Medium | Critical | High@@ -339,7 +341,7 @@ -- from a type with an 'Enum' instance. This function also requires -- a `Bounded` instance to improve the reporting of errors. ----- Example usage in combination with `toPersistValueEnum`:+-- Example usage in combination with 'toPersistValueEnum': -- -- @ -- data SeverityLevel = Low | Medium | Critical | High@@ -355,4 +357,3 @@ then Right res else Left ("The number " `mappend` T.pack (show i) `mappend` " was out of the " `mappend` "allowed bounds for an enum type")-
Database/Persist/Class/PersistField.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} #ifndef NO_OVERLAP@@ -14,6 +12,7 @@ , getPersistMap ) where +import Control.Arrow (second) import Database.Persist.Types.Base import Data.Time (Day(..), TimeOfDay, UTCTime, parseTime) #ifdef HIGH_PRECISION_DATE@@ -57,6 +56,8 @@ #if MIN_VERSION_base(4,8,0) import Numeric.Natural (Natural)+#else+import Control.Applicative ((<$>)) #endif -- | A value which can be marshalled to and from a 'PersistValue'.@@ -176,28 +177,28 @@ fromPersistValue x = Left $ T.pack $ "Expected Double, received: " ++ show x instance (HasResolution a) => PersistField (Fixed a) where- toPersistValue = PersistRational . toRational- fromPersistValue (PersistRational r) = Right $ fromRational r- fromPersistValue (PersistText t) = case reads $ T.unpack t of -- NOTE: Sqlite can store rationals just as string- [(a, "")] -> Right a- _ -> Left $ "Can not read " <> t <> " as Fixed"- fromPersistValue (PersistDouble d) = Right $ realToFrac d- fromPersistValue (PersistInt64 i) = Right $ fromIntegral i- fromPersistValue x = Left $ "PersistField Fixed:Expected Rational, received: " <> T.pack (show x)+ toPersistValue = PersistRational . toRational+ fromPersistValue (PersistRational r) = Right $ fromRational r+ fromPersistValue (PersistText t) = case reads $ T.unpack t of -- NOTE: Sqlite can store rationals just as string+ [(a, "")] -> Right a+ _ -> Left $ "Can not read " <> t <> " as Fixed"+ fromPersistValue (PersistDouble d) = Right $ realToFrac d+ fromPersistValue (PersistInt64 i) = Right $ fromIntegral i+ fromPersistValue x = Left $ "PersistField Fixed:Expected Rational, received: " <> T.pack (show x) instance PersistField Rational where- toPersistValue = PersistRational- fromPersistValue (PersistRational r) = Right r- fromPersistValue (PersistDouble d) = Right $ toRational d- fromPersistValue (PersistText t) = case reads $ T.unpack t of -- NOTE: Sqlite can store rationals just as string- [(a, "")] -> Right $ toRational (a :: Pico)- _ -> Left $ "Can not read " <> t <> " as Rational (Pico in fact)"- fromPersistValue (PersistInt64 i) = Right $ fromIntegral i- fromPersistValue (PersistByteString bs) = case double $ T.cons '0' $ T.decodeUtf8With T.lenientDecode bs of- Right (ret,"") -> Right $ toRational ret- Right (a,b) -> Left $ "Invalid bytestring[" <> T.pack (show bs) <> "]: expected a double but returned " <> T.pack (show (a,b))- Left xs -> Left $ "Invalid bytestring[" <> T.pack (show bs) <> "]: expected a double but returned " <> T.pack (show xs)- fromPersistValue x = Left $ "PersistField Rational:Expected Rational, received: " <> T.pack (show x)+ toPersistValue = PersistRational+ fromPersistValue (PersistRational r) = Right r+ fromPersistValue (PersistDouble d) = Right $ toRational d+ fromPersistValue (PersistText t) = case reads $ T.unpack t of -- NOTE: Sqlite can store rationals just as string+ [(a, "")] -> Right $ toRational (a :: Pico)+ _ -> Left $ "Can not read " <> t <> " as Rational (Pico in fact)"+ fromPersistValue (PersistInt64 i) = Right $ fromIntegral i+ fromPersistValue (PersistByteString bs) = case double $ T.cons '0' $ T.decodeUtf8With T.lenientDecode bs of+ Right (ret,"") -> Right $ toRational ret+ Right (a,b) -> Left $ "Invalid bytestring[" <> T.pack (show bs) <> "]: expected a double but returned " <> T.pack (show (a,b))+ Left xs -> Left $ "Invalid bytestring[" <> T.pack (show bs) <> "]: expected a double but returned " <> T.pack (show xs)+ fromPersistValue x = Left $ "PersistField Rational:Expected Rational, received: " <> T.pack (show x) instance PersistField Bool where toPersistValue = PersistBool@@ -268,10 +269,10 @@ toPersistValue Nothing = PersistNull toPersistValue (Just a) = toPersistValue a fromPersistValue PersistNull = Right Nothing- fromPersistValue x = fmap Just $ fromPersistValue x+ fromPersistValue x = Just <$> fromPersistValue x instance PersistField a => PersistField [a] where- toPersistValue = PersistList . map toPersistValue+ toPersistValue = PersistList . fmap toPersistValue fromPersistValue (PersistList l) = fromPersistList l fromPersistValue (PersistText t) = fromPersistValue (PersistByteString $ TE.encodeUtf8 t) fromPersistValue (PersistByteString bs)@@ -287,13 +288,13 @@ (Right . V.fromList) . fromPersistValue instance (Ord a, PersistField a) => PersistField (S.Set a) where- toPersistValue = PersistList . map toPersistValue . S.toList+ toPersistValue = PersistList . fmap toPersistValue . S.toList fromPersistValue (PersistList list) =- either Left (Right . S.fromList) $ fromPersistList list+ S.fromList <$> fromPersistList list fromPersistValue (PersistText t) = fromPersistValue (PersistByteString $ TE.encodeUtf8 t) fromPersistValue (PersistByteString bs) | Just values <- A.decode' (L.fromChunks [bs]) =- either Left (Right . S.fromList) $ fromPersistList values+ S.fromList <$> fromPersistList values fromPersistValue PersistNull = Right S.empty fromPersistValue x = Left $ T.pack $ "Expected PersistSet, received: " ++ show x @@ -301,16 +302,16 @@ toPersistValue (x,y) = PersistList [toPersistValue x, toPersistValue y] fromPersistValue v = case fromPersistValue v of- Right (x:y:[]) -> (,) <$> fromPersistValue x <*> fromPersistValue y- Left e -> Left e- _ -> Left $ T.pack $ "Expected 2 item PersistList, received: " ++ show v+ Right [x,y] -> (,) <$> fromPersistValue x <*> fromPersistValue y+ Left e -> Left e+ _ -> Left $ T.pack $ "Expected 2 item PersistList, received: " ++ show v instance PersistField v => PersistField (IM.IntMap v) where toPersistValue = toPersistValue . IM.toList- fromPersistValue = (fmap IM.fromList) . fromPersistValue+ fromPersistValue = fmap IM.fromList . fromPersistValue instance PersistField v => PersistField (M.Map T.Text v) where- toPersistValue = PersistMap . map (\(k,v) -> (k, toPersistValue v)) . M.toList+ toPersistValue = PersistMap . fmap (second toPersistValue) . M.toList fromPersistValue = fromPersistMap <=< getPersistMap instance PersistField PersistValue where@@ -333,6 +334,7 @@ Left e -> Left e Right v' -> go ((k,v'):acc) kvs +-- | FIXME Add documentation to that. getPersistMap :: PersistValue -> Either T.Text [(T.Text, PersistValue)] getPersistMap (PersistMap kvs) = Right kvs getPersistMap (PersistText t) = getPersistMap (PersistByteString $ TE.encodeUtf8 t)
Database/Persist/Class/PersistQuery.hs view
@@ -10,7 +10,7 @@ import Database.Persist.Types import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader ( ReaderT, MonadReader )+import Control.Monad.Reader (ReaderT, MonadReader) import qualified Data.Conduit as C import qualified Data.Conduit.List as CL@@ -19,6 +19,7 @@ import Control.Monad.Trans.Resource (MonadResource, release) import Data.Acquire (Acquire, allocateAcquire, with) +-- | Backends supporting conditional operations. class PersistStore backend => PersistQuery backend where -- | Update individual fields on any record matching the given criterion. updateWhere :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val)@@ -36,13 +37,13 @@ -> [SelectOpt val] -> ReaderT backend m1 (Acquire (C.Source m2 (Entity val))) - -- | get just the first record for the criterion+ -- | Get just the first record for the criterion. selectFirst :: (MonadIO m, PersistEntity val, backend ~ PersistEntityBackend val) => [Filter val] -> [SelectOpt val] -> ReaderT backend m (Maybe (Entity val)) selectFirst filts opts = do- srcRes <- selectSourceRes filts ((LimitTo 1):opts)+ srcRes <- selectSourceRes filts (LimitTo 1 : opts) liftIO $ with srcRes (C.$$ CL.head) -- | Get the 'Key's of all records matching the given criterion.
Database/Persist/Class/PersistStore.hs view
@@ -32,14 +32,15 @@ env <- ask liftIO $ runReaderT f (persistBackend env) --- | ToBackendKey converts a 'PersistEntity' 'Key' into a 'BackendKey'--- This can be used by each backend to convert between a 'Key' and a plain Haskell type.--- For Sql, that is done with 'toSqlKey' and 'fromSqlKey'.+-- | 'ToBackendKey' converts a 'PersistEntity' 'Key' into a 'BackendKey'+-- This can be used by each backend to convert between a 'Key' and a plain+-- Haskell type. For Sql, that is done with 'toSqlKey' and 'fromSqlKey'. -- -- By default, a 'PersistEntity' uses the default 'BackendKey' for its Key -- and is an instance of ToBackendKey ----- A 'Key' that instead uses a custom type will not be an instance of 'ToBackendKey'+-- A 'Key' that instead uses a custom type will not be an instance of+-- 'ToBackendKey'. class ( PersistEntity record , PersistEntityBackend record ~ backend , PersistStore backend@@ -141,7 +142,7 @@ -- | Same as get, but for a non-null (not Maybe) foreign key--- Unsafe unless your database is enforcing that the foreign key is valid+-- Unsafe unless your database is enforcing that the foreign key is valid. getJust :: ( PersistStore backend , PersistEntity val , Show (Key val)@@ -152,9 +153,9 @@ (liftIO $ throwIO $ PersistForeignConstraintUnmet $ T.pack $ show key) return --- | curry this to make a convenience function that loads an associated model+-- | Curry this to make a convenience function that loads an associated model. ----- > foreign = belongsTo foerignId+-- > foreign = belongsTo foreignId belongsTo :: ( PersistStore backend , PersistEntity ent1@@ -166,7 +167,7 @@ Nothing -> return Nothing Just f -> get f --- | same as belongsTo, but uses @getJust@ and therefore is similarly unsafe+-- | Same as 'belongsTo', but uses @getJust@ and therefore is similarly unsafe. belongsToJust :: ( PersistStore backend , PersistEntity ent1@@ -177,7 +178,7 @@ => (ent1 -> Key ent2) -> ent1 -> ReaderT backend m ent2 belongsToJust getForeignKey model = getJust $ getForeignKey model --- | like @insert@, but returns the complete @Entity@+-- | Like @insert@, but returns the complete @Entity@. insertEntity :: ( PersistStore backend , PersistEntity e
Database/Persist/Class/PersistUnique.hs view
@@ -25,17 +25,25 @@ -- Please read the general Persistent documentation to learn how to create -- 'Unique' keys. ----- Using this with an Entity without a Unique key leads to undefined behavior.--- A few of these functions require a *single* 'Unique', so using an Entity with multiple 'Unique's is also undefined. In these cases persistent's goal is to throw an exception as soon as possible, but persistent is still transitioning to that.+-- Using this with an Entity without a Unique key leads to undefined+-- behavior. A few of these functions require a /single/ 'Unique', so using+-- an Entity with multiple 'Unique's is also undefined. In these cases+-- persistent's goal is to throw an exception as soon as possible, but+-- persistent is still transitioning to that. ----- SQL backends automatically create uniqueness constraints, but for MongoDB you must manually place a unique index on a field to have a uniqueness constraint.+-- SQL backends automatically create uniqueness constraints, but for MongoDB+-- you must manually place a unique index on a field to have a uniqueness+-- constraint. ----- Some functions in this module (insertUnique, insertBy, and replaceUnique) first query the unique indexes to check for conflicts.--- You could instead optimistically attempt to perform the operation (e.g. replace instead of replaceUnique). However,+-- Some functions in this module ('insertUnique', 'insertBy', and+-- 'replaceUnique') first query the unique indexes to check for+-- conflicts. You could instead optimistically attempt to perform the+-- operation (e.g. 'replace' instead of 'replaceUnique'). However, ----- * there is some fragility to trying to catch the correct exception and determing the column of failure.+-- * there is some fragility to trying to catch the correct exception and+-- determing the column of failure; ----- * an exception will automatically abort the current SQL transaction+-- * an exception will automatically abort the current SQL transaction. class PersistStore backend => PersistUnique backend where -- | Get a record by unique key, if available. Returns also the identifier. getBy :: (MonadIO m, backend ~ PersistEntityBackend val, PersistEntity val) => Unique val -> ReaderT backend m (Maybe (Entity val))@@ -53,19 +61,22 @@ Nothing -> Just `liftM` insert datum Just _ -> return Nothing - -- | update based on a uniquness constraint or insert+ -- | Update based on a uniqueness constraint or insert: --- -- insert the new record if it does not exist- -- update the existing record that matches the uniqueness contraint+ -- * insert the new record if it does not exist;+ -- * update the existing record that matches the uniqueness contraint. --- -- Throws an exception if there is more than 1 uniqueness contraint+ -- Throws an exception if there is more than 1 uniqueness contraint. upsert :: (MonadIO m, PersistEntityBackend val ~ backend, PersistEntity val) => val -- ^ new record to insert- -> [Update val] -- ^ updates to perform if the record already exists.- -- leaving this empty is the equivalent of performing a 'repsert' on a unique key.- -> ReaderT backend m (Entity val) -- ^ the record in the database after the operation+ -> [Update val]+ -- ^ updates to perform if the record already exists (leaving+ -- this empty is the equivalent of performing a 'repsert' on a+ -- unique key)+ -> ReaderT backend m (Entity val)+ -- ^ the record in the database after the operation upsert record updates = do- uniqueKey <- onlyUnique record + uniqueKey <- onlyUnique record mExists <- getBy uniqueKey k <- case mExists of Just (Entity k _) -> do@@ -86,7 +97,7 @@ Nothing -> Right `liftM` insert val Just z -> return $ Left z --- | Return the single unique key for a record+-- | Return the single unique key for a record. onlyUnique :: (MonadIO m, PersistEntity val, PersistUnique backend, PersistEntityBackend val ~ backend) => val -> ReaderT backend m (Unique val) onlyUnique record = case onlyUniqueEither record of@@ -95,8 +106,8 @@ onlyUniqueEither :: (PersistEntity val) => val -> Either [Unique val] (Unique val) onlyUniqueEither record = case persistUniqueKeys record of- (u:[]) -> Right u- us -> Left us+ [u] -> Right u+ us -> Left us -- | A modification of 'getBy', which takes the 'PersistEntity' itself instead -- of a 'Unique' record. Returns a record matching /one/ of the unique keys. This@@ -124,7 +135,9 @@ recordName = unHaskellName . entityHaskell . entityDef . Just -- | Attempt to replace the record of the given key with the given new record.--- First query the unique fields to make sure the replacement maintains uniqueness constraints.+-- First query the unique fields to make sure the replacement maintains+-- uniqueness constraints.+-- -- Return 'Nothing' if the replacement was made. -- If uniqueness is violated, return a 'Just' with the 'Unique' violation --
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.2.4+version: 2.2.4.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>