From ca3eefe197e59dd7fd6d366d331ea1e6d28348d3 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 26 Feb 2012 21:20:47 +0200 Subject: [PATCH] Beginning of conduit 0.3 migration --- persistent-mongoDB/persistent-mongoDB.cabal | 6 ++-- persistent-mysql/persistent-mysql.cabal | 4 +-- .../persistent-postgresql.cabal | 4 +-- persistent-sqlite/persistent-sqlite.cabal | 4 +-- persistent-template/persistent-template.cabal | 4 +-- persistent-test/persistent-test.cabal | 4 +-- persistent/Database/Persist/GenericSql.hs | 6 ++-- .../Database/Persist/GenericSql/Internal.hs | 5 ++-- persistent/Database/Persist/GenericSql/Raw.hs | 29 ++++++++----------- persistent/Database/Persist/Store.hs | 6 ++-- persistent/persistent.cabal | 7 +++-- pool-conduit/Data/Conduit/Pool.hs | 14 ++++----- pool-conduit/pool-conduit.cabal | 4 +-- 13 files changed, 47 insertions(+), 50 deletions(-) diff --git a/persistent-mongoDB/persistent-mongoDB.cabal b/persistent-mongoDB/persistent-mongoDB.cabal index b7b16bdfd..538713ccb 100644 --- a/persistent-mongoDB/persistent-mongoDB.cabal +++ b/persistent-mongoDB/persistent-mongoDB.cabal @@ -1,5 +1,5 @@ name: persistent-mongoDB -version: 0.8.0 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Greg Weber @@ -14,12 +14,12 @@ description: Backend for the persistent library using mongoDB. library build-depends: base >= 4 && < 5 - , persistent >= 0.8 && < 0.9 + , persistent >= 0.9 && < 0.10 , text >= 0.8 && < 1 , transformers >= 0.2.1 && < 0.3 , containers >= 0.2 && < 0.5 , bytestring >= 0.9 && < 0.10 - , conduit >= 0.2 + , conduit >= 0.3 && < 0.4 , mongoDB >= 1.2 && < 1.3 , bson >= 0.1.6 , network >= 2.2.1.7 && < 3 diff --git a/persistent-mysql/persistent-mysql.cabal b/persistent-mysql/persistent-mysql.cabal index 009c6a385..15d4eec75 100644 --- a/persistent-mysql/persistent-mysql.cabal +++ b/persistent-mysql/persistent-mysql.cabal @@ -1,5 +1,5 @@ name: persistent-mysql -version: 0.8.0 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Felipe Lessa , Michael Snoyman @@ -35,7 +35,7 @@ library , monad-control >= 0.2 && < 0.4 , time >= 1.1 , aeson >= 0.5 - , conduit >= 0.2 + , conduit >= 0.3 && < 0.4 exposed-modules: Database.Persist.MySQL ghc-options: -Wall diff --git a/persistent-postgresql/persistent-postgresql.cabal b/persistent-postgresql/persistent-postgresql.cabal index 7daafacae..9c29c6b5d 100644 --- a/persistent-postgresql/persistent-postgresql.cabal +++ b/persistent-postgresql/persistent-postgresql.cabal @@ -1,5 +1,5 @@ name: persistent-postgresql -version: 0.8.1.2 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Felipe Lessa, Michael Snoyman @@ -24,7 +24,7 @@ library , monad-control >= 0.2 && < 0.4 , time >= 1.1 , aeson >= 0.5 - , conduit >= 0.2 + , conduit >= 0.3 && < 0.4 exposed-modules: Database.Persist.Postgresql ghc-options: -Wall diff --git a/persistent-sqlite/persistent-sqlite.cabal b/persistent-sqlite/persistent-sqlite.cabal index 013fa4e53..3fd9223e3 100644 --- a/persistent-sqlite/persistent-sqlite.cabal +++ b/persistent-sqlite/persistent-sqlite.cabal @@ -1,5 +1,5 @@ name: persistent-sqlite -version: 0.8.0 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -25,7 +25,7 @@ library , containers >= 0.2 && < 0.5 , text >= 0.7 && < 1 , aeson >= 0.5 - , conduit >= 0.2 + , conduit >= 0.3 && < 0.4 exposed-modules: Database.Sqlite Database.Persist.Sqlite ghc-options: -Wall diff --git a/persistent-template/persistent-template.cabal b/persistent-template/persistent-template.cabal index fbf26b31b..6cc5608d1 100644 --- a/persistent-template/persistent-template.cabal +++ b/persistent-template/persistent-template.cabal @@ -1,5 +1,5 @@ name: persistent-template -version: 0.8.1.1 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -15,7 +15,7 @@ homepage: http://www.yesodweb.com/book/persistent library build-depends: base >= 4 && < 5 , template-haskell - , persistent >= 0.8 && < 0.9 + , persistent >= 0.9 && < 0.10 , monad-control >= 0.2 && < 0.4 , text >= 0.5 && < 1.0 , transformers >= 0.2 diff --git a/persistent-test/persistent-test.cabal b/persistent-test/persistent-test.cabal index 7487fdbad..44ec568b5 100644 --- a/persistent-test/persistent-test.cabal +++ b/persistent-test/persistent-test.cabal @@ -1,5 +1,5 @@ name: persistent-test -version: 0.8.0 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -79,7 +79,7 @@ library , containers , bytestring , base64-bytestring - , conduit >= 0.2 + , conduit >= 0.3 && < 0.4 , time >= 1.2 , random == 1.* , QuickCheck == 2.4.* diff --git a/persistent/Database/Persist/GenericSql.hs b/persistent/Database/Persist/GenericSql.hs index 50399e0d5..f0ed4238f 100644 --- a/persistent/Database/Persist/GenericSql.hs +++ b/persistent/Database/Persist/GenericSql.hs @@ -99,7 +99,7 @@ runSqlConn (SqlPersist r) conn = do liftIO $ commitC conn getter return x -instance C.ResourceIO m => PersistStore SqlPersist m where +instance C.MonadResource m => PersistStore SqlPersist m where insert val = do conn <- SqlPersist ask let esql = insertSql conn (entityDB t) (map fieldDB $ entityFields t) @@ -199,7 +199,7 @@ insrepHelper command (Key k) val = do ] vals = k : map toPersistValue (toPersistFields val) -instance C.ResourceIO m => PersistUnique SqlPersist m where +instance C.MonadResource m => PersistUnique SqlPersist m where deleteBy uniq = do conn <- SqlPersist ask execute' (sql conn) $ persistUniqueToValues uniq @@ -463,7 +463,7 @@ newtype Single a = Single {unSingle :: a} -- However, most common problems are mitigated by using the -- entity selection placeholder @??@, and you shouldn't see any -- error at all if you're not using 'Single'. -rawSql :: (RawSql a, C.ResourceIO m) => +rawSql :: (RawSql a, C.MonadResource m) => Text -- ^ SQL statement, possibly with placeholders. -> [PersistValue] -- ^ Values to fill the placeholders. -> SqlPersist m [a] diff --git a/persistent/Database/Persist/GenericSql/Internal.hs b/persistent/Database/Persist/GenericSql/Internal.hs index a86088cac..7dabbc69b 100644 --- a/persistent/Database/Persist/GenericSql/Internal.hs +++ b/persistent/Database/Persist/GenericSql/Internal.hs @@ -22,6 +22,7 @@ import Control.Monad.IO.Class import Data.Conduit.Pool import Database.Persist.Store import Control.Exception.Lifted (bracket) +import Control.Monad.Trans.Control (MonadBaseControl) import Database.Persist.Util (nullable) import Data.Text (Text) import qualified Data.Text as T @@ -50,7 +51,7 @@ data Statement = Statement { finalize :: IO () , reset :: IO () , execute :: [PersistValue] -> IO () - , withStmt :: forall m. C.ResourceIO m + , withStmt :: forall m. C.MonadResource m => [PersistValue] -> C.Source m [PersistValue] } @@ -70,7 +71,7 @@ createSqlPool :: MonadIO m -> m (Pool Connection) createSqlPool mkConn = liftIO . createPool mkConn close' 1 20 -withSqlConn :: C.ResourceIO m +withSqlConn :: (MonadIO m, MonadBaseControl IO m) => IO Connection -> (Connection -> m a) -> m a withSqlConn open = bracket (liftIO open) (liftIO . close') diff --git a/persistent/Database/Persist/GenericSql/Raw.hs b/persistent/Database/Persist/GenericSql/Raw.hs index 83deae764..af48afb0d 100644 --- a/persistent/Database/Persist/GenericSql/Raw.hs +++ b/persistent/Database/Persist/GenericSql/Raw.hs @@ -24,33 +24,23 @@ import qualified Data.Map as Map import Control.Applicative (Applicative) import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Base (MonadBase (liftBase)) -#if MIN_VERSION_monad_control(0, 3, 0) import Control.Monad.Trans.Control (MonadBaseControl (..), ComposeSt, defaultLiftBaseWith, defaultRestoreM, MonadTransControl (..)) import Control.Monad (liftM) #define MBCIO MonadBaseControl IO -#else -import Control.Monad.IO.Control (MonadControlIO) -#define MBCIO MonadControlIO -#endif import Data.Text (Text) import Control.Monad (MonadPlus) -import Control.Monad.Trans.Resource (ResourceThrow (..), ResourceIO) +import Control.Monad.Trans.Resource (MonadThrow (..), MonadResource (..)) import qualified Data.Conduit as C newtype SqlPersist m a = SqlPersist { unSqlPersist :: ReaderT Connection m a } - deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadPlus -#if !MIN_VERSION_monad_control(0, 3, 0) - , MonadControlIO -#endif - ) + deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadPlus) -instance ResourceThrow m => ResourceThrow (SqlPersist m) where - resourceThrow = lift . resourceThrow +instance MonadThrow m => MonadThrow (SqlPersist m) where + monadThrow = lift . monadThrow instance MonadBase b m => MonadBase b (SqlPersist m) where liftBase = lift . liftBase -#if MIN_VERSION_monad_control(0, 3, 0) instance MonadBaseControl b m => MonadBaseControl b (SqlPersist m) where newtype StM (SqlPersist m) a = StMSP {unStMSP :: ComposeSt SqlPersist m a} liftBaseWith = defaultLiftBaseWith StMSP @@ -59,15 +49,20 @@ instance MonadTransControl SqlPersist where newtype StT SqlPersist a = StReader {unStReader :: a} liftWith f = SqlPersist $ ReaderT $ \r -> f $ \t -> liftM StReader $ runReaderT (unSqlPersist t) r restoreT = SqlPersist . ReaderT . const . liftM unStReader -#endif -withStmt :: ResourceIO m +instance MonadResource m => MonadResource (SqlPersist m) where + register = lift . register + release = lift . release + allocate a = lift . allocate a + resourceMask = lift . resourceMask + +withStmt :: MonadResource m => Text -> [PersistValue] -> C.Source (SqlPersist m) [PersistValue] withStmt sql vals = C.Source { C.sourcePull = do - stmt <- lift $ getStmt sql + stmt <- getStmt sql let src = I.withStmt stmt vals pull stmt src , C.sourceClose = return () diff --git a/persistent/Database/Persist/Store.hs b/persistent/Database/Persist/Store.hs index d0bb8d36f..ce92358a3 100644 --- a/persistent/Database/Persist/Store.hs +++ b/persistent/Database/Persist/Store.hs @@ -500,7 +500,7 @@ data Entity entity = , entityVal :: entity } deriving (Eq, Ord, Show, Read) -class (C.ResourceIO m, C.ResourceIO (b m)) => PersistStore b m where +class (C.MonadResource m, C.MonadResource (b m)) => PersistStore b m where -- | Create a new record in the database, returning an automatically created -- key (in SQL an auto-increment id). @@ -540,7 +540,7 @@ class PersistStore b m => PersistUnique b m where insertUnique :: (b ~ PersistEntityBackend val, PersistEntity val) => val -> b m (Maybe (Key b val)) insertUnique datum = do isUnique <- checkUnique datum - if isUnique then Just <$> insert datum else return Nothing + if isUnique then Just `liftM` insert datum else return Nothing @@ -647,7 +647,7 @@ class PersistConfig c where createPoolConfig :: c -> IO (PersistConfigPool c) -- | Run a database action by taking a connection from the pool. - runPool :: C.ResourceIO m => c -> PersistConfigBackend c m a + runPool :: C.MonadResource m => c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index 43c209612..9c5bc0f1a 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -1,5 +1,5 @@ name: persistent -version: 0.8.0 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -26,10 +26,11 @@ library , time >= 1.1.4 , text >= 0.8 && < 1 , containers >= 0.2 && < 0.5 - , conduit >= 0.2 && < 0.3 + , conduit >= 0.3 && < 0.4 + , resourcet >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4 , lifted-base >= 0.1 && < 0.2 - , pool-conduit >= 0.0 && < 0.1 + , pool-conduit >= 0.1 && < 0.2 , blaze-html >= 0.4 && < 0.5 , path-pieces >= 0.1 && < 0.2 , mtl >= 2.0 && < 2.1 diff --git a/pool-conduit/Data/Conduit/Pool.hs b/pool-conduit/Data/Conduit/Pool.hs index 1f0b16bd4..4e82425a2 100644 --- a/pool-conduit/Data/Conduit/Pool.hs +++ b/pool-conduit/Data/Conduit/Pool.hs @@ -17,20 +17,20 @@ import qualified Data.IORef as I -- | The result of taking a resource. data ManagedResource m a = ManagedResource { mrValue :: a -- ^ The actual resource. - , mrReuse :: Bool -> ResourceT m () + , mrReuse :: Bool -> m () -- ^ Let's you specify whether the resource should be returned to the pool -- (via 'P.putResource') or destroyed (via 'P.destroyResource') on release. -- This defaults to destruction, in case of exceptions. - , mrRelease :: ResourceT m () + , mrRelease :: m () -- ^ Release this resource, either destroying it or returning it to the -- pool. } -- | Take a resource from the pool and register a release action. -takeResource :: ResourceIO m => P.Pool a -> ResourceT m (ManagedResource m a) +takeResource :: MonadResource m => P.Pool a -> m (ManagedResource m a) takeResource pool = do onRelRef <- liftIO $ I.newIORef False - (relKey, (a, _)) <- withIO + (relKey, (a, _)) <- allocate (P.takeResource pool) (\(a, local) -> do onRel <- I.readIORef onRelRef @@ -45,10 +45,10 @@ takeResource pool = do -- | Same as 'takeResource', but apply some action to check if a resource is -- still valid. -takeResourceCheck :: ResourceIO m +takeResourceCheck :: MonadResource m => P.Pool a - -> (a -> ResourceT m Bool) - -> ResourceT m (ManagedResource m a) + -> (a -> m Bool) + -> m (ManagedResource m a) takeResourceCheck pool check = do mr <- takeResource pool isValid <- check $ mrValue mr diff --git a/pool-conduit/pool-conduit.cabal b/pool-conduit/pool-conduit.cabal index d61785ac1..9acbe843c 100644 --- a/pool-conduit/pool-conduit.cabal +++ b/pool-conduit/pool-conduit.cabal @@ -1,5 +1,5 @@ name: pool-conduit -version: 0.0.0.1 +version: 0.1.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -17,7 +17,7 @@ library build-depends: base >= 4 && < 5 , resource-pool >= 0.2.1 && < 0.3 , transformers >= 0.2.1 && < 0.3 - , conduit >= 0.0.2 && < 0.3 + , resourcet >= 0.3 && < 0.4 exposed-modules: Data.Conduit.Pool