persistent 1.3.0.3 → 1.3.0.4

raw patch · 7 files changed

+47/−12 lines, 7 filesdep +resource-pooldep −pool-conduitdep ~base

Dependencies added: resource-pool

Dependencies removed: pool-conduit

Dependency ranges changed: base

Files

• Database/Persist.hs +13/−0
• Database/Persist/Class/PersistField.hs +5/−6
• Database/Persist/Sql.hs +1/−1
• Database/Persist/Sql/Run.hs +23/−1
• Database/Persist/Sql/Types.hs +1/−1
• Database/Persist/Types/Base.hs +2/−1
• persistent.cabal +2/−2

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}@@ -27,7 +28,11 @@ import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (toLazyText) import Data.Aeson (toJSON)+#if MIN_VERSION_aeson(0, 7, 0)+import Data.Aeson.Encode (encodeToTextBuilder)+#else import Data.Aeson.Encode (fromValue)+#endif  infixr 3 =., +=., -=., *=., /=. (=.), (+=.), (-=.), (*=.), (/=.) :: forall v typ.  PersistField typ => EntityField v typ -> typ -> Update v@@ -65,10 +70,18 @@ a ||. b = [FilterOr  [FilterAnd a, FilterAnd b]]  listToJSON :: [PersistValue] -> T.Text+#if MIN_VERSION_aeson(0, 7, 0)+listToJSON = toStrict . toLazyText . encodeToTextBuilder . toJSON+#else listToJSON = toStrict . toLazyText . fromValue . toJSON+#endif  mapToJSON :: [(T.Text, PersistValue)] -> T.Text+#if MIN_VERSION_aeson(0, 7, 0)+mapToJSON = toStrict . toLazyText . encodeToTextBuilder . toJSON+#else mapToJSON = toStrict . toLazyText . fromValue . toJSON+#endif  limitOffsetOrder :: PersistEntity val => [SelectOpt val] -> (Int, Int, [SelectOpt val]) limitOffsetOrder opts =

@@ -272,12 +272,11 @@  instance (PersistField a, PersistField b) => PersistField (a,b) where     toPersistValue (x,y) = PersistList [toPersistValue x, toPersistValue y]-    fromPersistValue (PersistList (vx:vy:[])) =-      case (fromPersistValue vx, fromPersistValue vy) of-        (Right x, Right y) -> Right (x, y)-        (Left e, _) -> Left e-        (_, Left e) -> Left e-    fromPersistValue x = Left $ T.pack $ "Expected 2 item PersistList, received: " ++ show x+    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  instance PersistField v => PersistField (M.Map T.Text v) where     toPersistValue = PersistMap . map (\(k,v) -> (k, toPersistValue v)) . M.toList

@@ -21,7 +21,7 @@ import Database.Persist import Database.Persist.Sql.Types import Database.Persist.Sql.Class-import Database.Persist.Sql.Run+import Database.Persist.Sql.Run hiding (withResourceTimeout) import Database.Persist.Sql.Raw import Database.Persist.Sql.Migration import Database.Persist.Sql.Internal

@@ -3,7 +3,7 @@  import Database.Persist.Sql.Types import Database.Persist.Sql.Raw-import Data.Conduit.Pool+import Data.Pool as P import Control.Monad.Trans.Reader import Control.Monad.Trans.Resource import Control.Monad.Logger@@ -11,9 +11,13 @@ import Control.Exception.Lifted (onException) import Control.Monad.IO.Class import Control.Exception.Lifted (bracket)+import Control.Exception (mask)+import System.Timeout (timeout)+import Control.Monad.Trans.Control (control) import Data.IORef (readIORef) import qualified Data.Map as Map import Control.Exception.Lifted (throwIO)+import Control.Monad (liftM)  -- | Get a connection from the pool, run the given action, and then return the -- connection to the pool.@@ -21,6 +25,24 @@ runSqlPool r pconn = do     mres <- withResourceTimeout 2000000 pconn $ runSqlConn r     maybe (throwIO Couldn'tGetSQLConnection) return mres++withResourceTimeout+  :: (MonadBaseControl IO m)+  => Int -- ^ Timeout period in microseconds+  -> P.Pool a+  -> (a -> m b)+  -> m (Maybe b)+{-# SPECIALIZE withResourceTimeout :: Int -> P.Pool a -> (a -> IO b) -> IO (Maybe b) #-}+withResourceTimeout ms pool act = control $ \runInIO -> mask $ \restore -> do+    mres <- timeout ms $ P.takeResource pool+    case mres of+        Nothing -> runInIO $ return Nothing+        Just (resource, local) -> do+            ret <- restore (runInIO (liftM Just $ act resource)) `onException`+                    P.destroyResource pool local resource+            P.putResource local resource+            return ret+{-# INLINABLE withResourceTimeout #-}  runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a runSqlConn (SqlPersistT r) conn = do

@@ -28,7 +28,7 @@ import Data.Map (Map) import Data.Int (Int64) import Data.Conduit (Source)-import Data.Conduit.Pool (Pool)+import Data.Pool (Pool) import Web.PathPieces import Control.Exception (throw) import qualified Data.Text.Read

@@ -12,7 +12,6 @@ import Data.Typeable (Typeable) import Data.Text (Text, pack) import qualified Data.Text as T-import qualified Data.Attoparsec.Number as AN import qualified Data.Text.Encoding as TE import Data.Text.Encoding.Error (lenientDecode) import qualified Data.ByteString.Base64 as B64@@ -32,6 +31,8 @@ import Numeric (showHex, readHex) #if MIN_VERSION_aeson(0, 7, 0) import qualified Data.Scientific+#else+import qualified Data.Attoparsec.Number as AN #endif  -- | A 'Checkmark' should be used as a field type whenever a

@@ -1,5 +1,5 @@ name:            persistent-version:         1.3.0.3+version:         1.3.0.4 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -31,7 +31,6 @@                    , resourcet                >= 0.4                    , monad-control            >= 0.3                    , lifted-base              >= 0.1-                   , pool-conduit             >= 0.1.2                    , path-pieces              >= 0.1                    , aeson                    >= 0.5                    , monad-logger             >= 0.3@@ -45,6 +44,7 @@                    , blaze-markup             >= 0.5.1                    , silently                    , scientific+                   , resource-pool      exposed-modules: Database.Persist                      Database.Persist.Quasi