Skip to content
Browse files

Beginning of conduit 0.3 migration

  • Loading branch information...
1 parent 48db566 commit ca3eefe197e59dd7fd6d366d331ea1e6d28348d3 @snoyberg snoyberg committed Feb 26, 2012
View
6 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 <greg@gregweber.info>
@@ -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
View
4 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 <felipe.lessa@gmail.com>, 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
View
4 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 <michael@snoyman.com>
@@ -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
View
4 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 <michael@snoyman.com>
@@ -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
View
4 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 <michael@snoyman.com>
@@ -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
View
4 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 <michael@snoyman.com>
@@ -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.*
View
6 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]
View
5 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')
View
29 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 ()
View
6 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
View
7 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 <michael@snoyman.com>
@@ -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
View
14 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
View
4 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 <michael@snoyman.com>
@@ -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

0 comments on commit ca3eefe

Please sign in to comment.
Something went wrong with that request. Please try again.