Permalink
Browse files

Merge branch 'conduit-0.3'

Conflicts:
	persistent-mysql/persistent-mysql.cabal
	persistent-template/persistent-template.cabal
  • Loading branch information...
2 parents 33009e6 + f20f503 commit 25fba31368093640a94b13be873918e067fe5ad9 @snoyberg snoyberg committed Mar 20, 2012
@@ -7,6 +7,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- FIXME
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Database.Persist.MongoDB
(
@@ -57,14 +58,13 @@ import qualified Data.Text.Encoding as E
import qualified Data.Serialize as Serialize
import qualified System.IO.Pool as Pool
import Web.PathPieces (PathPiece (..))
-import Data.Conduit (ResourceIO)
import qualified Data.Conduit as C
-import Control.Monad.Trans.Resource (ResourceThrow (..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value (Object), (.:), (.:?), (.!=))
import Control.Monad (mzero)
import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Monad.Trans.Resource (MonadThrow (..))
#ifdef DEBUG
import FileLocation (debug)
@@ -189,7 +189,7 @@ saveWithKey dbSave k record =
where
t = entityDef record
-instance (Applicative m, Functor m, ResourceIO m) => PersistStore DB.Action m where
+instance (Applicative m, Functor m, Trans.MonadIO m, MonadBaseControl IO m) => PersistStore DB.Action m where
insert record = do
(DB.ObjId oid) <- DB.insert (u $ T.unpack $ unDBName $ entityDB t) (insertFields t record)
return $ oidToKey oid
@@ -223,10 +223,10 @@ instance (Applicative m, Functor m, ResourceIO m) => PersistStore DB.Action m wh
where
t = entityDef $ dummyFromKey k
-instance ResourceThrow m => ResourceThrow (DB.Action m) where
- resourceThrow = lift . resourceThrow
+instance MonadThrow m => MonadThrow (DB.Action m) where
+ monadThrow = lift . monadThrow
-instance (Applicative m, Functor m, ResourceIO m) => PersistUnique DB.Action m where
+instance (Applicative m, Functor m, Trans.MonadIO m, MonadBaseControl IO m) => PersistUnique DB.Action m where
getBy uniq = do
mdocument <- DB.findOne $
(DB.select (uniqSelector uniq) (u $ T.unpack $ unDBName $ entityDB t))
@@ -249,7 +249,7 @@ instance (Applicative m, Functor m, ResourceIO m) => PersistUnique DB.Action m w
persistKeyToMongoId :: PersistEntity val => Key DB.Action val -> DB.Field
persistKeyToMongoId k = u"_id" DB.:= (DB.ObjId $ keyToOid k)
-instance (Applicative m, Functor m, ResourceIO m) => PersistQuery DB.Action m where
+instance (Applicative m, Functor m, Trans.MonadIO m, MonadBaseControl IO m) => PersistQuery DB.Action m where
update _ [] = return ()
update k upds =
DB.modify
@@ -282,22 +282,21 @@ instance (Applicative m, Functor m, ResourceIO m) => PersistQuery DB.Action m wh
query = DB.select (filtersToSelector filts) (u $ T.unpack $ unDBName $ entityDB t)
t = entityDef $ dummyFromFilts filts
- selectSource filts opts = C.Source
- { C.sourcePull = do
+ selectSource filts opts = C.SourceM
+ (do
cursor <- lift $ DB.find $ makeQuery filts opts
- pull cursor
- , C.sourceClose = return ()
- }
+ return $ mkSrc cursor)
+ (return ())
where
- mkSrc cursor = C.Source (pull cursor) (return ())
+ mkSrc cursor = C.SourceM (pull cursor) (return ())
pull cursor = lift $ do
mdoc <- DB.next cursor
case mdoc of
Nothing -> return C.Closed
Just doc ->
case pairFromDocument t doc of
Left s -> liftIO $ throwIO $ PersistMarshalError $ T.pack s
- Right row -> return $ C.Open (mkSrc cursor) row
+ Right row -> return $ C.Open (mkSrc cursor) (return ()) row
t = entityDef $ dummyFromFilts filts
selectFirst filts opts = do
@@ -310,19 +309,18 @@ instance (Applicative m, Functor m, ResourceIO m) => PersistQuery DB.Action m wh
where
t = entityDef $ dummyFromFilts filts
- selectKeys filts = C.Source
- { C.sourcePull = do
+ selectKeys filts = C.SourceM
+ (do
cursor <- lift $ DB.find query
- pull cursor
- , C.sourceClose = return ()
- }
+ return $ mkSrc cursor)
+ (return ())
where
- mkSrc cursor = C.Source (pull cursor) (return ())
+ mkSrc cursor = C.SourceM (pull cursor) (return ())
pull cursor = lift $ do
mdoc <- DB.next cursor
case mdoc of
Nothing -> return C.Closed
- Just [_ DB.:= DB.ObjId oid] -> return $ C.Open (mkSrc cursor) $ oidToKey oid
+ Just [_ DB.:= DB.ObjId oid] -> return $ C.Open (mkSrc cursor) (return ()) $ oidToKey oid
Just y -> liftIO $ throwIO $ PersistMarshalError $ T.pack $ "Unexpected in selectKeys: " ++ show y
query = (DB.select (filtersToSelector filts) (u $ T.unpack $ unDBName $ entityDB t)) {
DB.project = [u"_id" DB.=: (1 :: Int)]
@@ -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,13 @@ 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
+ , resourcet >= 0.3 && < 0.4
, mongoDB >= 1.2 && < 1.3
, bson >= 0.1.6
, network >= 2.2.1.7 && < 3
@@ -20,6 +20,7 @@ import Control.Monad (mzero)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Error (ErrorT(..))
+import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Either (partitionEithers)
@@ -81,7 +82,7 @@ createMySQLPool ci = createSqlPool $ open' ci
-- | Same as 'withMySQLPool', but instead of opening a pool
-- of connections, only one connection is opened.
-withMySQLConn :: C.ResourceIO m =>
+withMySQLConn :: (MonadBaseControl IO m, MonadIO m) =>
MySQL.ConnectInfo
-- ^ Connection information.
-> (Connection -> m a)
@@ -147,7 +148,7 @@ execute' conn query vals = MySQL.execute conn query (map P vals) >> return ()
-- | Execute an statement that does return results. The results
-- are fetched all at once and stored into memory.
-withStmt' :: C.ResourceIO m
+withStmt' :: C.MonadResource m
=> MySQL.Connection
-> MySQL.Query
-> [PersistValue]
@@ -1,5 +1,5 @@
name: persistent-mysql
-version: 0.8.4
+version: 0.9.0
license: BSD3
license-file: LICENSE
author: Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman
@@ -28,14 +28,14 @@ library
, transformers >= 0.2.1 && < 0.3
, mysql-simple >= 0.2.2.3 && < 0.3
, mysql >= 0.1.1.3 && < 0.2
- , persistent >= 0.8 && < 0.9
+ , persistent >= 0.9 && < 0.10
, containers >= 0.2
, bytestring >= 0.9 && < 0.10
, text >= 0.11.0.6 && < 0.12
, 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
@@ -30,6 +30,7 @@ import qualified Database.PostgreSQL.LibPQ as LibPQ
import Control.Exception (SomeException, throw)
import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Trans.Control (MonadBaseControl)
import Data.List (intercalate)
import Data.IORef
import qualified Data.Map as Map
@@ -94,7 +95,8 @@ createPostgresqlPool ci = createSqlPool $ open' ci
-- | Same as 'withPostgresqlPool', but instead of opening a pool
-- of connections, only one connection is opened.
-withPostgresqlConn :: C.ResourceIO m => ConnectionString -> (Connection -> m a) -> m a
+withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m)
+ => ConnectionString -> (Connection -> m a) -> m a
withPostgresqlConn = withSqlConn . open'
open' :: ConnectionString -> IO Connection
@@ -140,7 +142,7 @@ execute' conn query vals = do
_ <- PG.execute conn query (map P vals)
return ()
-withStmt' :: C.ResourceIO m
+withStmt' :: C.MonadResource m
=> PG.Connection
-> PG.Query
-> [PersistValue]
@@ -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>
@@ -17,14 +17,14 @@ library
, transformers >= 0.2.1 && < 0.3
, postgresql-simple >= 0.0.3 && < 0.1
, postgresql-libpq >= 0.6.1 && < 0.8
- , persistent >= 0.8 && < 0.9
+ , persistent >= 0.9 && < 0.10
, containers >= 0.2
, bytestring >= 0.9 && < 0.10
, text >= 0.7 && < 0.12
, 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
@@ -44,13 +44,14 @@ import Control.Applicative
createSqlitePool :: MonadIO m => Text -> Int -> m ConnectionPool
createSqlitePool s = createSqlPool $ open' s
-withSqlitePool :: C.ResourceIO m
+withSqlitePool :: (MonadBaseControl IO m, MonadIO m)
=> Text
-> Int -- ^ number of connections to open
-> (ConnectionPool -> m a) -> m a
withSqlitePool s = withSqlPool $ open' s
-withSqliteConn :: C.ResourceIO m => Text -> (Connection -> m a) -> m a
+withSqliteConn :: (MonadBaseControl IO m, MonadIO m)
+ => Text -> (Connection -> m a) -> m a
withSqliteConn = withSqlConn . open'
open' :: Text -> IO Connection
@@ -107,7 +108,7 @@ execute' stmt vals = flip finally (liftIO $ Sqlite.reset stmt) $ do
return ()
withStmt'
- :: C.ResourceIO m
+ :: C.MonadResource m
=> Sqlite.Statement
-> [PersistValue]
-> C.Source m [PersistValue]
@@ -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>
@@ -20,12 +20,12 @@ library
build-depends: base >= 4 && < 5
, bytestring >= 0.9.1 && < 0.10
, transformers >= 0.2.1 && < 0.3
- , persistent >= 0.8 && < 0.9
+ , persistent >= 0.9 && < 0.10
, monad-control >= 0.2 && < 0.4
, 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
@@ -166,7 +166,7 @@ uniqueTypeDec t =
`AppT` VarT backend, VarT backend2
]
(map (mkUnique backend t) $ entityUniques t)
- (if null (entityUniques t) then [] else [''Show, ''Read, ''Eq])
+ []
where
backend = mkName "backend"
backend2 = mkName "backend2"
@@ -1,5 +1,5 @@
name: persistent-template
-version: 0.8.2
+version: 0.9.0
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@@ -16,7 +16,7 @@ extra-source-files: test/main.hs
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
@@ -4,6 +4,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
module Init (
(@/=), (@==), (==@)
, assertNotEqual
@@ -58,7 +59,6 @@ import qualified Data.ByteString as BS
#else
import Database.Persist.GenericSql
import Database.Persist.Sqlite
-import Control.Monad.Trans.Resource (ResourceIO)
#if WITH_POSTGRESQL
import Database.Persist.Postgresql
@@ -70,6 +70,7 @@ import Database.Persist.MySQL
#endif
import Control.Monad (unless)
+import Control.Monad.Trans.Control (MonadBaseControl)
-- Data types
import Data.Int (Int32, Int64)
@@ -143,7 +144,7 @@ type BackendMonad = SqlPersist
sqlite_database :: Text
sqlite_database = "test/testdb.sqlite3"
-- sqlite_database = ":memory:"
-runConn :: ResourceIO m => SqlPersist m t -> m ()
+runConn :: (MonadIO m, MonadBaseControl IO m) => SqlPersist m t -> m ()
runConn f = do
_<-withSqlitePool sqlite_database 1 $ runSqlPool f
#if WITH_POSTGRESQL
@@ -20,6 +20,7 @@ import Database.Persist
import Database.Persist.Query.Join (selectOneMany, SelectOneMany(..))
import qualified Database.Persist.Query.Join
import Database.Persist.TH (persistUpperCase)
+import Control.Monad.IO.Class (MonadIO)
#ifndef WITH_MONGODB
import qualified Database.Persist.Query.Join.Sql
@@ -35,9 +36,11 @@ share [mkPersist sqlSettings, mkMigrate "joinMigrate"] [persistUpperCase|
Author
name String
+ deriving Show Eq
Entry
authorId AuthorId
title String
+ deriving Show Eq
|]
#ifdef WITH_MONGODB
cleanDB :: PersistQuery b m => b m ()
@@ -56,7 +59,7 @@ specs = describe "joins" $ do
#endif
-joinGeneric :: PersistQuery b m =>
+joinGeneric :: (MonadIO (b m), PersistQuery b m) =>
(SelectOneMany b (AuthorGeneric b) (EntryGeneric b)
-> b m [(Entity (AuthorGeneric b), [Entity (EntryGeneric b)])])
-> b m ()
@@ -23,6 +23,7 @@ share [mkPersist sqlSettings, mkMigrate "numberMigrate"] [persist|
word32 Word32
int64 Int64
word64 Word64
+ deriving Show Eq
|]
#ifdef WITH_MONGODB
db = db' cleanDB
@@ -33,6 +33,7 @@ share [mkPersist sqlSettings, mkMigrate "maxlenMigrate"] [persist|
bs2 ByteString maxlen=3
str1 String
str2 String maxlen=3
+ deriving Show Eq
|]
specs :: Specs
Oops, something went wrong.

0 comments on commit 25fba31

Please sign in to comment.