Hello community,
here is the log from the commit of package ghc-persistent for openSUSE:Factory
checked in at 2017-04-11 09:43:03
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-persistent (Old)
and /work/SRC/openSUSE:Factory/.ghc-persistent.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent"
Tue Apr 11 09:43:03 2017 rev:7 rq:485151 version:2.6.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-persistent/ghc-persistent.changes
2016-10-18 10:41:03.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-persistent.new/ghc-persistent.changes
2017-04-11 09:43:03.230959323 +0200
@@ -1,0 +2,5 @@
+Tue Mar 14 09:26:00 UTC 2017 - psim...@suse.com
+
+- Update to version 2.6.1 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
persistent-2.6.tar.gz
persistent.cabal
New:
----
persistent-2.6.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent.spec ++++++
--- /var/tmp/diff_new_pack.teyV3i/_old 2017-04-11 09:43:03.834874012 +0200
+++ /var/tmp/diff_new_pack.teyV3i/_new 2017-04-11 09:43:03.834874012 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-persistent
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,14 +19,13 @@
%global pkg_name persistent
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.6
+Version: 2.6.1
Release: 0
Summary: Type-safe, multi-backend data serialization
License: MIT
Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-aeson-devel
BuildRequires: ghc-attoparsec-devel
@@ -80,7 +79,6 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
@@ -103,5 +101,6 @@
%files devel -f %{name}-devel.files
%defattr(-,root,root,-)
+%doc ChangeLog.md README.md
%changelog
++++++ persistent-2.6.tar.gz -> persistent-2.6.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/ChangeLog.md
new/persistent-2.6.1/ChangeLog.md
--- old/persistent-2.6/ChangeLog.md 2016-08-10 05:29:36.000000000 +0200
+++ new/persistent-2.6.1/ChangeLog.md 2017-03-06 13:58:44.000000000 +0100
@@ -1,3 +1,10 @@
+## 2.6.1
+
+* Fix edge case for `\<-. [Nothing]`
+* Introduce `connMaxParams`
+* Add 'getJustEntity' and 'insertRecord' convenience function
+* Minor Haddock improvment
+
## 2.6
* Add `connUpsertSql` type for providing backend-specific upsert sql support.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Class/PersistConfig.hs
new/persistent-2.6.1/Database/Persist/Class/PersistConfig.hs
--- old/persistent-2.6/Database/Persist/Class/PersistConfig.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Class/PersistConfig.hs
2017-03-01 07:48:55.000000000 +0100
@@ -9,7 +9,7 @@
import Data.Aeson.Types (Parser)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Control (MonadBaseControl)
-import Control.Applicative ((<$>))
+import Control.Applicative as A ((<$>))
import qualified Data.HashMap.Strict as HashMap
-- | Represents a value containing all the configuration options for a specific
@@ -48,7 +48,7 @@
loadConfig (Object o) =
case HashMap.lookup "left" o of
- Just v -> Left <$> loadConfig v
+ Just v -> Left A.<$> loadConfig v
Nothing ->
case HashMap.lookup "right" o of
Just v -> Right <$> loadConfig v
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Class/PersistEntity.hs
new/persistent-2.6.1/Database/Persist/Class/PersistEntity.hs
--- old/persistent-2.6/Database/Persist/Class/PersistEntity.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Class/PersistEntity.hs
2017-03-01 07:48:55.000000000 +0100
@@ -32,9 +32,13 @@
import Data.Aeson (ToJSON (..), FromJSON (..), fromJSON, object, (.:), (.=),
Value (Object))
import qualified Data.Aeson.Parser as AP
import Data.Aeson.Types (Parser,Result(Error,Success))
+#if MIN_VERSION_aeson(1,0,0)
+import Data.Aeson.Text (encodeToTextBuilder)
+#else
import Data.Aeson.Encode (encodeToTextBuilder)
+#endif
import Data.Attoparsec.ByteString (parseOnly)
-import Control.Applicative ((<$>), (<*>))
+import Control.Applicative as A ((<$>), (<*>))
import Data.Monoid (mappend)
import qualified Data.HashMap.Strict as HM
import Data.Typeable (Typeable)
@@ -218,8 +222,8 @@
keyValueEntityFromJSON :: (PersistEntity record, FromJSON record, FromJSON
(Key record))
=> Value -> Parser (Entity record)
keyValueEntityFromJSON (Object o) = Entity
- <$> o .: "key"
- <*> o .: "value"
+ A.<$> o .: "key"
+ A.<*> o .: "value"
keyValueEntityFromJSON _ = fail "keyValueEntityFromJSON: not an object"
-- | Predefined @toJSON@. The resulting JSON looks like
@@ -256,7 +260,7 @@
_ -> error $ T.unpack $ errMsg "expected PersistMap"
fromPersistValue (PersistMap alist) = case after of
- [] -> Left $ errMsg $ "did not find " `mappend` idField `mappend` "
field"
+ [] -> Left $ errMsg $ "did not find " `Data.Monoid.mappend` idField
`mappend` " field"
("_id", kv):afterRest ->
fromPersistValue (PersistMap (before ++ afterRest)) >>= \record ->
keyFromValues [kv] >>= \k ->
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Class/PersistField.hs
new/persistent-2.6.1/Database/Persist/Class/PersistField.hs
--- old/persistent-2.6/Database/Persist/Class/PersistField.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Class/PersistField.hs 2017-03-01
07:48:55.000000000 +0100
@@ -3,9 +3,11 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
-#ifndef NO_OVERLAP
+
+#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
+
module Database.Persist.Class.PersistField
( PersistField (..)
, SomePersistField (..)
@@ -14,12 +16,17 @@
import Control.Arrow (second)
import Database.Persist.Types.Base
-import Data.Time (Day(..), TimeOfDay, UTCTime, parseTime)
+import Data.Time (Day(..), TimeOfDay, UTCTime,
+#if MIN_VERSION_time(1,5,0)
+ parseTimeM)
+#else
+ parseTime)
+#endif
#ifdef HIGH_PRECISION_DATE
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
#endif
import Data.ByteString.Char8 (ByteString, unpack, readInt)
-import Control.Applicative
+import Control.Applicative as A
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Data.Text (Text)
@@ -56,8 +63,6 @@
#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'.
@@ -66,7 +71,11 @@
fromPersistValue :: PersistValue -> Either T.Text a
#ifndef NO_OVERLAP
-instance PersistField String where
+#if MIN_VERSION_base(4,8,0)
+instance {-# OVERLAPPING #-} PersistField [Char] where
+#else
+instance PersistField [Char] where
+#endif
toPersistValue = PersistText . T.pack
fromPersistValue (PersistText s) = Right $ T.unpack s
fromPersistValue (PersistByteString bs) =
@@ -88,7 +97,7 @@
instance PersistField ByteString where
toPersistValue = PersistByteString
fromPersistValue (PersistByteString bs) = Right bs
- fromPersistValue x = T.encodeUtf8 <$> fromPersistValue x
+ fromPersistValue x = T.encodeUtf8 A.<$> fromPersistValue x
instance PersistField T.Text where
toPersistValue = PersistText
@@ -144,7 +153,7 @@
xs -> error $ "PersistField
Int64 failed parsing PersistByteString xs["++show xs++"] i["++show bs++"]"
fromPersistValue x = Left $ T.pack $ "int64 Expected Integer, received: "
++ show x
-instance PersistField Word where
+instance PersistField Data.Word.Word where
toPersistValue = PersistInt64 . fromIntegral
fromPersistValue (PersistInt64 i) = Right $ fromIntegral i
fromPersistValue x = Left $ T.pack $ "Expected Word, received: " ++ show x
@@ -249,9 +258,13 @@
_ ->
case parse8601 $ T.unpack t of
Nothing -> Left $ T.pack $ "Expected UTCTime, received "
++ show x
- Just x -> Right x
+ Just x' -> Right x'
where
+#if MIN_VERSION_time(1,5,0)
+ parse8601 = parseTimeM True defaultTimeLocale "%FT%T%Q"
+#else
parse8601 = parseTime defaultTimeLocale "%FT%T%Q"
+#endif
fromPersistValue x@(PersistByteString s) =
case reads $ unpack s of
(d, _):_ -> Right d
@@ -271,7 +284,11 @@
fromPersistValue PersistNull = Right Nothing
fromPersistValue x = Just <$> fromPersistValue x
+#if MIN_VERSION_base(4,8,0)
+instance {-# OVERLAPPABLE #-} PersistField a => PersistField [a] where
+#else
instance PersistField a => PersistField [a] where
+#endif
toPersistValue = PersistList . fmap toPersistValue
fromPersistValue (PersistList l) = fromPersistList l
fromPersistValue (PersistText t) = fromPersistValue (PersistByteString $
TE.encodeUtf8 t)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Class/PersistStore.hs
new/persistent-2.6.1/Database/Persist/Class/PersistStore.hs
--- old/persistent-2.6/Database/Persist/Class/PersistStore.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Class/PersistStore.hs 2017-03-06
13:58:44.000000000 +0100
@@ -10,10 +10,13 @@
, PersistCore (..)
, PersistStoreRead (..)
, PersistStoreWrite (..)
+ , getEntity
, getJust
+ , getJustEntity
, belongsTo
, belongsToJust
, insertEntity
+ , insertRecord
, ToBackendKey(..)
) where
@@ -173,7 +176,7 @@
get key >>= maybe (liftIO $ throwIO $ KeyNotFound $ show key) return
--- | Same as get, but for a non-null (not Maybe) foreign key
+-- | Same as 'get', but for a non-null (not Maybe) foreign key
-- Unsafe unless your database is enforcing that the foreign key is valid.
getJust :: ( PersistStoreRead backend
, Show (Key record)
@@ -184,6 +187,22 @@
(liftIO $ throwIO $ PersistForeignConstraintUnmet $ T.pack $ show key)
return
+-- | Same as 'getJust', but returns an 'Entity' instead of just the record.
+-- @since 2.6.1
+getJustEntity
+ :: (PersistEntityBackend record ~ BaseBackend backend
+ ,MonadIO m
+ ,PersistEntity record
+ ,PersistStoreRead backend)
+ => Key record -> ReaderT backend m (Entity record)
+getJustEntity key = do
+ record <- getJust key
+ return $
+ Entity
+ { entityKey = key
+ , entityVal = record
+ }
+
-- | Curry this to make a convenience function that loads an associated model.
--
-- > foreign = belongsTo foreignId
@@ -216,3 +235,26 @@
insertEntity e = do
eid <- insert e
return $ Entity eid e
+
+-- | Like @get@, but returns the complete @Entity@.
+getEntity ::
+ ( PersistStoreWrite backend
+ , PersistRecordBackend e backend
+ , MonadIO m
+ ) => Key e -> ReaderT backend m (Maybe (Entity e))
+getEntity key = do
+ maybeModel <- get key
+ return $ fmap (key `Entity`) maybeModel
+
+-- | Like 'insertEntity' but just returns the record instead of 'Entity'.
+-- @since 2.6.1
+insertRecord
+ :: (PersistEntityBackend record ~ BaseBackend backend
+ ,PersistEntity record
+ ,MonadIO m
+ ,PersistStoreWrite backend)
+ => record -> ReaderT backend m record
+insertRecord record = do
+ insert_ record
+ return $ record
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Class/PersistUnique.hs
new/persistent-2.6.1/Database/Persist/Class/PersistUnique.hs
--- old/persistent-2.6/Database/Persist/Class/PersistUnique.hs 2016-08-01
15:46:55.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Class/PersistUnique.hs
2017-03-01 07:48:55.000000000 +0100
@@ -119,9 +119,9 @@
-- | Insert a value, checking for conflicts with any unique constraints. If a
-- duplicate exists in the database, it is left untouched. The key of the
-- existing or new entry is returned
-insertOrGet :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend
record backend)
+_insertOrGet :: (MonadIO m, PersistUniqueWrite backend, PersistRecordBackend
record backend)
=> record -> ReaderT backend m (Key record)
-insertOrGet val = do
+_insertOrGet val = do
res <- getByValue val
case res of
Nothing -> insert val
@@ -157,7 +157,7 @@
requireUniques :: (MonadIO m, PersistEntity record) => record -> [Unique
record] -> m [Unique record]
requireUniques record [] = liftIO $ throwIO $ userError errorMsg
where
- errorMsg = "getByValue: " `mappend` unpack (recordName record) `mappend` "
does not have any Unique"
+ errorMsg = "getByValue: " `Data.Monoid.mappend` unpack (recordName record)
`mappend` " does not have any Unique"
requireUniques _ xs = return xs
-- TODO: expose this to users
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Class.hs
new/persistent-2.6.1/Database/Persist/Class.hs
--- old/persistent-2.6/Database/Persist/Class.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Class.hs 2017-03-06
13:58:44.000000000 +0100
@@ -8,12 +8,14 @@
, PersistStore
, PersistStoreRead (..)
, PersistStoreWrite (..)
- , BaseBackend(..)
, PersistRecordBackend
, getJust
+ , getJustEntity
+ , getEntity
, belongsTo
, belongsToJust
, insertEntity
+ , insertRecord
-- * PersistUnique
, PersistUnique
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Quasi.hs
new/persistent-2.6.1/Database/Persist/Quasi.hs
--- old/persistent-2.6/Database/Persist/Quasi.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Quasi.hs 2017-03-01
07:48:55.000000000 +0100
@@ -49,7 +49,7 @@
let (a, b) = T.break (== end) t
in case parseApplyFT a of
PSSuccess ft t' -> case (T.dropWhile isSpace t', T.uncons b) of
- ("", Just (c, t'')) | c == end -> PSSuccess (ftMod ft) (t''
`mappend` t')
+ ("", Just (c, t'')) | c == end -> PSSuccess (ftMod ft) (t''
`Data.Monoid.mappend` t')
(x, y) -> PSFail $ show (b, x, y)
x -> PSFail $ show x
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Sql/Class.hs
new/persistent-2.6.1/Database/Persist/Sql/Class.hs
--- old/persistent-2.6/Database/Persist/Sql/Class.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Class.hs 2017-03-01
07:48:55.000000000 +0100
@@ -7,15 +7,18 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
-#ifndef NO_OVERLAP
+{-# LANGUAGE PatternGuards #-}
+
+#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
+
module Database.Persist.Sql.Class
( RawSql (..)
, PersistFieldSql (..)
) where
-import Control.Applicative ((<$>), (<*>))
+import Control.Applicative as A ((<$>), (<*>))
import Database.Persist
import Data.Monoid ((<>))
import Database.Persist.Sql.Types
@@ -33,7 +36,7 @@
import Data.Word
import Data.ByteString (ByteString)
import Text.Blaze.Html (Html)
-import Data.Bits (bitSize)
+import Data.Bits (bitSizeMaybe)
import qualified Data.Vector as V
#if MIN_VERSION_base(4,8,0)
@@ -57,7 +60,7 @@
instance PersistField a => RawSql (Single a) where
rawSqlCols _ _ = (1, [])
rawSqlColCountReason _ = "one column for a 'Single' data type"
- rawSqlProcessRow [pv] = Single <$> fromPersistValue pv
+ rawSqlProcessRow [pv] = Single A.<$> fromPersistValue pv
rawSqlProcessRow _ = Left $ pack "RawSql (Single a): wrong number of
columns."
instance
@@ -72,7 +75,7 @@
instance
(PersistEntity record, PersistEntityBackend record ~ backend,
IsPersistBackend backend) =>
RawSql (Entity record) where
- rawSqlCols escape ent = (length sqlFields, [intercalate ", " sqlFields])
+ rawSqlCols escape _ent = (length sqlFields, [intercalate ", " sqlFields])
where
sqlFields = map (((name <> ".") <>) . escape)
$ map fieldDB
@@ -86,8 +89,8 @@
1 -> "one column for an 'Entity' data type without fields"
n -> show n ++ " columns for an 'Entity' data type"
rawSqlProcessRow row = case splitAt nKeyFields row of
- (rowKey, rowVal) -> Entity <$> keyFromValues rowKey
- <*> fromPersistValues rowVal
+ (rowKey, rowVal) -> Entity A.<$> keyFromValues rowKey
+ A.<*> fromPersistValues rowVal
where
nKeyFields = length $ entityKeyFields entDef
entDef = entityDef (Nothing :: Maybe record)
@@ -212,7 +215,12 @@
sqlType :: Proxy a -> SqlType
#ifndef NO_OVERLAP
-instance PersistFieldSql String where
+
+#if MIN_VERSION_base(4,8,0)
+instance {-# OVERLAPPING #-} PersistFieldSql [Char] where
+#else
+instance PersistFieldSql [Char] where
+#endif
sqlType _ = SqlString
#endif
@@ -226,7 +234,7 @@
sqlType _ = SqlString
instance PersistFieldSql Int where
sqlType _
- | bitSize (0 :: Int) <= 32 = SqlInt32
+ | Just x <- bitSizeMaybe (0 :: Int), x <= 32 = SqlInt32
| otherwise = SqlInt64
instance PersistFieldSql Int8 where
sqlType _ = SqlInt32
@@ -256,7 +264,11 @@
sqlType _ = SqlTime
instance PersistFieldSql UTCTime where
sqlType _ = SqlDayTime
+#if MIN_VERSION_base(4,8,0)
+instance {-# OVERLAPPABLE #-} PersistFieldSql a => PersistFieldSql [a] where
+#else
instance PersistFieldSql a => PersistFieldSql [a] where
+#endif
sqlType _ = SqlString
instance PersistFieldSql a => PersistFieldSql (V.Vector a) where
sqlType _ = SqlString
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Sql/Internal.hs
new/persistent-2.6.1/Database/Persist/Sql/Internal.hs
--- old/persistent-2.6/Database/Persist/Sql/Internal.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Internal.hs 2017-03-01
07:48:55.000000000 +0100
@@ -68,10 +68,10 @@
refName :: DBName -> DBName -> DBName
refName (DBName table) (DBName column) =
- DBName $ mconcat [table, "_", column, "_fkey"]
+ DBName $ Data.Monoid.mconcat [table, "_", column, "_fkey"]
resolveTableName :: [EntityDef] -> HaskellName -> DBName
-resolveTableName [] (HaskellName hn) = error $ "Table not found: " `mappend`
T.unpack hn
+resolveTableName [] (HaskellName hn) = error $ "Table not found: "
`Data.Monoid.mappend` T.unpack hn
resolveTableName (e:es) hn
| entityHaskell e == hn = entityDB e
| otherwise = resolveTableName es hn
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Sql/Migration.hs
new/persistent-2.6.1/Database/Persist/Sql/Migration.hs
--- old/persistent-2.6/Database/Persist/Sql/Migration.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Migration.hs 2017-03-01
07:48:55.000000000 +0100
@@ -33,6 +33,8 @@
safeSql :: CautiousMigration -> [Sql]
safeSql = allSql . filter (not . fst)
+-- | Given a 'Migration', this parses it and returns either a list of
+-- errors associated with the migration or a list of migrations to do.
parseMigration :: MonadIO m => Migration -> ReaderT SqlBackend m (Either
[Text] CautiousMigration)
parseMigration =
liftIOReader . liftM go . runWriterT . execWriterT
@@ -42,7 +44,8 @@
liftIOReader (ReaderT m) = ReaderT $ liftIO . m
--- like parseMigration, but call error or return the CautiousMigration
+-- | Like 'parseMigration', but instead of returning the value in an
+-- 'Either' value, it calls 'error' on the error values.
parseMigration' :: MonadIO m => Migration -> ReaderT SqlBackend m
(CautiousMigration)
parseMigration' m = do
x <- parseMigration m
@@ -50,18 +53,25 @@
Left errs -> error $ unlines $ map unpack errs
Right sql -> return sql
+-- | Prints a migration.
printMigration :: MonadIO m => Migration -> ReaderT SqlBackend m ()
printMigration m = showMigration m
>>= mapM_ (liftIO . Data.Text.IO.putStrLn)
+-- | Convert a 'Migration' to a list of 'Text' values corresponding to their
+-- 'Sql' statements.
showMigration :: MonadIO m => Migration -> ReaderT SqlBackend m [Text]
showMigration m = map (flip snoc ';') `liftM` getMigration m
+-- | Return all of the 'Sql' values associated with the given migration.
+-- Calls 'error' if there's a parse error on any migration.
getMigration :: MonadIO m => Migration -> ReaderT SqlBackend m [Sql]
getMigration m = do
mig <- parseMigration' m
return $ allSql mig
+-- | Runs a migration. If the migration fails to parse or if any of the
+-- migrations are unsafe, then this calls 'error' to halt the program.
runMigration :: MonadIO m
=> Migration
-> ReaderT SqlBackend m ()
@@ -74,6 +84,9 @@
-> ReaderT SqlBackend m [Text]
runMigrationSilent m = liftBaseOp_ (hSilence [stderr]) $ runMigration' m True
+-- | Run the given migration against the database. If the migration fails
+-- to parse, or there are any unsafe migrations, then this will error at
+-- runtime. This returns a list of the migrations that were executed.
runMigration'
:: MonadIO m
=> Migration
@@ -93,6 +106,8 @@
displayMigration (True, s) = "*** " ++ unpack s ++ ";"
displayMigration (False, s) = " " ++ unpack s ++ ";"
+-- | Like 'runMigration', but this will perform the unsafe database
+-- migrations instead of erroring out.
runMigrationUnsafe :: MonadIO m
=> Migration
-> ReaderT SqlBackend m ()
@@ -116,6 +131,9 @@
-- choose to have this special sorting applied.
isCreate t = pack "CREATe " `isPrefixOf` t
+-- | Given a list of old entity definitions and a new 'EntityDef' in
+-- @val@, this creates a 'Migration' to update the old list of definitions
+-- with the new one.
migrate :: [EntityDef]
-> EntityDef
-> Migration
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Sql/Orphan/PersistQuery.hs
new/persistent-2.6.1/Database/Persist/Sql/Orphan/PersistQuery.hs
--- old/persistent-2.6/Database/Persist/Sql/Orphan/PersistQuery.hs
2016-07-17 04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Orphan/PersistQuery.hs
2017-03-01 07:48:55.000000000 +0100
@@ -183,7 +183,7 @@
, T.intercalate "," $ map (go' conn . go) upds
, wher
]
- let dat = map updatePersistValue upds `mappend`
+ let dat = map updatePersistValue upds `Data.Monoid.mappend`
getFiltsValues conn filts
rawExecuteCount sql dat
where
@@ -273,7 +273,7 @@
(True, Just pdef, _) ->
error $ "unhandled error for composite/non id primary
keys filter=" ++ show pfilter ++ " persistList=" ++ show allVals ++ " pdef=" ++
show pdef
- _ -> case (isNull, pfilter, varCount) of
+ _ -> case (isNull, pfilter, length notNullVals) of
(True, Eq, _) -> (name <> " IS NULL", [])
(True, Ne, _) -> (name <> " IS NOT NULL", [])
(False, Ne, _) -> (T.concat
@@ -298,7 +298,8 @@
, qmarks
, ")"
], notNullVals)
- (_, NotIn, 0) -> ("1=1", [])
+ (False, NotIn, 0) -> ("1=1", [])
+ (True, NotIn, 0) -> (name <> " IS NOT NULL", [])
(False, NotIn, _) -> (T.concat
[ "("
, name
@@ -353,9 +354,6 @@
Right x ->
let x' = filter (/= PersistNull) $ map toPersistValue x
in "(" <> T.intercalate "," (map (const "?") x') <>
")"
- varCount = case value of
- Left _ -> 1
- Right x -> length x
showSqlFilter Eq = "="
showSqlFilter Ne = "<>"
showSqlFilter Gt = ">"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Sql/Orphan/PersistStore.hs
new/persistent-2.6.1/Database/Persist/Sql/Orphan/PersistStore.hs
--- old/persistent-2.6/Database/Persist/Sql/Orphan/PersistStore.hs
2016-07-17 04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Orphan/PersistStore.hs
2017-03-03 10:45:56.000000000 +0100
@@ -123,7 +123,7 @@
go'' n Subtract = T.concat [n, "=", n, "-?"]
go'' n Multiply = T.concat [n, "=", n, "*?"]
go'' n Divide = T.concat [n, "=", n, "/?"]
- go'' _ (BackendSpecificUpdate up) = error $ T.unpack $
"BackendSpecificUpdate" `mappend` up `mappend` "not supported"
+ go'' _ (BackendSpecificUpdate up) = error $ T.unpack $
"BackendSpecificUpdate" `Data.Monoid.mappend` up `mappend` "not supported"
let go' (x, pu) = go'' (connEscapeName conn x) pu
let wher = whereStmtForKey conn k
let sql = T.concat
@@ -212,22 +212,32 @@
valss = map (map toPersistValue . toPersistFields) vals
+
insertMany_ [] = return ()
- insertMany_ vals = do
- conn <- ask
- let sql = T.concat
- [ "INSERT INTO "
- , connEscapeName conn (entityDB t)
- , "("
- , T.intercalate "," $ map (connEscapeName conn . fieldDB) $
entityFields t
- , ") VALUES ("
- , T.intercalate "),(" $ replicate (length valss) $
T.intercalate "," $ map (const "?") (entityFields t)
- , ")"
- ]
- rawExecute sql (concat valss)
+ insertMany_ vals0 = do conn <- ask
+ case connMaxParams conn of
+ Nothing -> insertMany_' vals0
+ Just maxParams -> let chunkSize = maxParams `div`
length (entityFields t) in
+ mapM_ insertMany_' (chunksOf
chunkSize vals0)
where
- t = entityDef vals
- valss = map (map toPersistValue . toPersistFields) vals
+ insertMany_' vals = do
+ conn <- ask
+ let valss = map (map toPersistValue . toPersistFields) vals
+ let sql = T.concat
+ [ "INSERT INTO "
+ , connEscapeName conn (entityDB t)
+ , "("
+ , T.intercalate "," $ map (connEscapeName conn . fieldDB) $
entityFields t
+ , ") VALUES ("
+ , T.intercalate "),(" $ replicate (length valss) $
T.intercalate "," $ map (const "?") (entityFields t)
+ , ")"
+ ]
+ rawExecute sql (concat valss)
+
+ t = entityDef vals0
+ -- Implement this here to avoid depending on the split package
+ chunksOf _ [] = []
+ chunksOf size xs = let (chunk, rest) = splitAt size xs in chunk :
chunksOf size rest
replace k val = do
conn <- ask
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Sql/Orphan/PersistUnique.hs
new/persistent-2.6.1/Database/Persist/Sql/Orphan/PersistUnique.hs
--- old/persistent-2.6/Database/Persist/Sql/Orphan/PersistUnique.hs
2016-08-10 05:20:24.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Orphan/PersistUnique.hs
2017-03-01 07:48:55.000000000 +0100
@@ -16,7 +16,6 @@
import Data.Monoid (mappend, (<>))
import qualified Data.Conduit.List as CL
import Control.Monad.Trans.Reader (ask, withReaderT)
-import Control.Monad (when, liftM)
defaultUpsert :: (MonadIO m, PersistEntity record, PersistUniqueWrite backend
, PersistEntityBackend record ~ BaseBackend backend)
@@ -33,7 +32,7 @@
case connUpsertSql conn of
Just upsertSql -> case updates of
[] -> defaultUpsert record updates
- xs -> do
+ _:_ -> do
let upds = T.intercalate "," $ map (go' . go)
updates
sql = upsertSql t upds
vals = (map toPersistValue $
toPersistFields record) ++ (map updatePersistValue updates) ++ (unqs uniqueKey)
@@ -43,7 +42,7 @@
go'' n Subtract = T.concat [n, "=", n,
"-?"]
go'' n Multiply = T.concat [n, "=", n,
"*?"]
go'' n Divide = T.concat [n, "=", n, "/?"]
- go'' _ (BackendSpecificUpdate up) = error
$ T.unpack $ "BackendSpecificUpdate" `mappend` up `mappend` "not supported"
+ go'' _ (BackendSpecificUpdate up) = error
$ T.unpack $ "BackendSpecificUpdate" `Data.Monoid.mappend` up `mappend` "not
supported"
go' (x, pu) = go'' (connEscapeName conn x)
pu
go x = (fieldDB $ updateFieldDef x,
updateUpdate x)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Sql/Raw.hs
new/persistent-2.6.1/Database/Persist/Sql/Raw.hs
--- old/persistent-2.6/Database/Persist/Sql/Raw.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Raw.hs 2017-03-01
07:48:55.000000000 +0100
@@ -11,7 +11,6 @@
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (ReaderT, ask, MonadReader)
import Data.Acquire (allocateAcquire, Acquire, mkAcquire, with)
-import Data.Functor ((<$>))
import Data.IORef (writeIORef, readIORef, newIORef)
import Control.Exception (throwIO)
import Control.Monad (when, liftM)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-2.6/Database/Persist/Sql/Types/Internal.hs
new/persistent-2.6.1/Database/Persist/Sql/Types/Internal.hs
--- old/persistent-2.6/Database/Persist/Sql/Types/Internal.hs 2016-08-10
05:20:24.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Types/Internal.hs 2017-03-03
10:45:56.000000000 +0100
@@ -81,6 +81,11 @@
, connRDBMS :: Text
, connLimitOffset :: (Int,Int) -> Bool -> Text -> Text
, connLogFunc :: LogFunc
+ , connMaxParams :: Maybe Int
+ -- ^ Some databases (probably only Sqlite) have a limit on how
+ -- many question-mark parameters may be used in a statement
+ --
+ -- @since 2.6.1
}
deriving Typeable
instance HasPersistBackend SqlBackend where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Sql/Types.hs
new/persistent-2.6.1/Database/Persist/Sql/Types.hs
--- old/persistent-2.6/Database/Persist/Sql/Types.hs 2016-07-17
04:15:37.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Sql/Types.hs 2017-03-01
07:48:55.000000000 +0100
@@ -19,22 +19,13 @@
import Control.Exception (Exception)
import Control.Monad.Trans.Resource (ResourceT)
-import Data.Acquire (Acquire)
import Control.Monad.Logger (NoLoggingT)
-import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Reader (ReaderT (..))
import Control.Monad.Trans.Writer (WriterT)
import Data.Typeable (Typeable)
import Database.Persist.Types
import Database.Persist.Sql.Types.Internal
-import Data.IORef (IORef)
-import Data.Map (Map)
-import Data.Int (Int64)
-import Data.Conduit (Source)
import Data.Pool (Pool)
-import Language.Haskell.TH.Syntax (Loc)
-import Control.Monad.Logger (LogSource, LogLevel)
-import System.Log.FastLogger (LogStr)
import Data.Text (Text)
-- | Deprecated synonym for @SqlBackend@.
@@ -80,16 +71,8 @@
-- some complex @JOIN@ query, or a database-specific command
-- needs to be issued.
--
--- To issue raw SQL queries you could use 'R.withStmt', which
--- allows you to do anything you need. However, its API is
--- /low-level/ and you need to parse each row yourself. However,
--- most of your complex queries will have simple results -- some
--- of your entities and maybe a couple of derived columns.
---
--- This is where 'rawSql' comes in. Like 'R.withStmt', you may
--- issue /any/ SQL query. However, it does all the hard work for
--- you and automatically parses the rows of the result. It may
--- return:
+-- To issue raw SQL queries, use 'rawSql'. It does all the hard work of
+-- automatically parsing the rows of the result. It may return:
--
-- * An 'Entity', that which 'selectList' returns.
-- All of your entity's fields are
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist/Types/Base.hs
new/persistent-2.6.1/Database/Persist/Types/Base.hs
--- old/persistent-2.6/Database/Persist/Types/Base.hs 2016-08-10
05:20:24.000000000 +0200
+++ new/persistent-2.6.1/Database/Persist/Types/Base.hs 2017-03-01
07:48:55.000000000 +0100
@@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-deprecations #-} -- usage of Error typeclass
module Database.Persist.Types.Base where
import qualified Data.Aeson as A
@@ -16,10 +17,9 @@
import qualified Data.ByteString.Base64 as B64
import qualified Data.Vector as V
import Control.Arrow (second)
-import Control.Applicative ((<$>))
+import Control.Applicative as A ((<$>))
import Data.Time (Day, TimeOfDay, UTCTime)
import Data.Int (Int64)
-import qualified Data.Text.Read
import Data.ByteString (ByteString, foldl')
import Data.Bits (shiftL, shiftR)
import qualified Data.ByteString as BS
@@ -90,7 +90,13 @@
instance FromHttpApiData Checkmark where
parseUrlPiece = parseBoundedTextData
-instance PathPiece Checkmark
+instance PathPiece Checkmark where
+ toPathPiece Active = "active"
+ toPathPiece Inactive = "inactive"
+
+ fromPathPiece "active" = Just Active
+ fromPathPiece "inactive" = Just Inactive
+ fromPathPiece _ = Nothing
data IsNullable = Nullable !WhyNullable
| NotNullable
@@ -324,9 +330,9 @@
instance FromHttpApiData PersistValue where
parseUrlPiece input =
- PersistInt64 <$> parseUrlPiece input
- <!> PersistList <$> readTextData input
- <!> PersistText <$> return input
+ PersistInt64 A.<$> parseUrlPiece input
+ <!> PersistList A.<$> readTextData input
+ <!> PersistText A.<$> return input
where
infixl 3 <!>
Left _ <!> y = y
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/Database/Persist.hs
new/persistent-2.6.1/Database/Persist.hs
--- old/persistent-2.6/Database/Persist.hs 2016-07-17 04:15:37.000000000
+0200
+++ new/persistent-2.6.1/Database/Persist.hs 2017-03-01 07:48:55.000000000
+0100
@@ -53,7 +53,9 @@
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Aeson (toJSON, ToJSON)
-#if MIN_VERSION_aeson(0, 7, 0)
+#if MIN_VERSION_aeson(1, 0, 0)
+import Data.Aeson.Text (encodeToTextBuilder)
+#elif MIN_VERSION_aeson(0, 7, 0)
import Data.Aeson.Encode (encodeToTextBuilder)
#else
import Data.Aeson.Encode (fromValue)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-2.6/persistent.cabal
new/persistent-2.6.1/persistent.cabal
--- old/persistent-2.6/persistent.cabal 2016-08-10 05:28:57.000000000 +0200
+++ new/persistent-2.6.1/persistent.cabal 2017-03-03 10:45:56.000000000
+0100
@@ -1,5 +1,5 @@
name: persistent
-version: 2.6
+version: 2.6.1
license: MIT
license-file: LICENSE
author: Michael Snoyman <mich...@snoyman.com>
@@ -22,7 +22,7 @@
if flag(nooverlap)
cpp-options: -DNO_OVERLAP
- build-depends: base >= 4.6 && < 5
+ build-depends: base >= 4.7 && < 5
, bytestring >= 0.9
, transformers >= 0.2.1
, time >= 1.1.4
@@ -36,7 +36,7 @@
, lifted-base >= 0.1
, resource-pool >= 0.2.2.0
, path-pieces >= 0.1
- , http-api-data >= 0.2 && < 0.3
+ , http-api-data >= 0.2 && < 0.4
, aeson >= 0.5
, monad-logger >= 0.3
, transformers-base
@@ -100,7 +100,7 @@
, attoparsec
, transformers
, path-pieces
- , http-api-data >= 0.2 && < 0.3
+ , http-api-data >= 0.2 && < 0.4
, aeson
, resourcet
, monad-logger
@@ -117,6 +117,12 @@
cpp-options: -DTEST
+ other-modules: Database.Persist.Class.PersistEntity
+ Database.Persist.Class.PersistField
+ Database.Persist.Quasi
+ Database.Persist.Types
+ Database.Persist.Types.Base
+
source-repository head
type: git
location: git://github.com/yesodweb/persistent.git
