postgresql-query 3.0.1 → 3.10.0
raw patch · 20 files changed
Files
- CHANGELOG.md +52/−0
- doctests/Main.hs +34/−0
- example/Main.hs +2/−2
- postgresql-query.cabal +51/−11
- src/Database/PostgreSQL/Query/Entity/Class.hs +5/−2
- src/Database/PostgreSQL/Query/Entity/Functions.hs +7/−11
- src/Database/PostgreSQL/Query/Entity/Internal.hs +27/−19
- src/Database/PostgreSQL/Query/Functions.hs +35/−32
- src/Database/PostgreSQL/Query/Import.hs +32/−0
- src/Database/PostgreSQL/Query/Internal.hs +4/−8
- src/Database/PostgreSQL/Query/SqlBuilder/Builder.hs +1/−6
- src/Database/PostgreSQL/Query/SqlBuilder/Types.hs +1/−4
- src/Database/PostgreSQL/Query/TH.hs +2/−2
- src/Database/PostgreSQL/Query/TH/Common.hs +0/−2
- src/Database/PostgreSQL/Query/TH/Entity.hs +35/−19
- src/Database/PostgreSQL/Query/TH/Enum.hs +0/−5
- src/Database/PostgreSQL/Query/TH/Row.hs +4/−6
- src/Database/PostgreSQL/Query/TH/SqlExp.hs +13/−8
- src/Database/PostgreSQL/Query/Types.hs +29/−29
- test/ParserTest.hs +6/−9
CHANGELOG.md view
@@ -1,5 +1,57 @@ # CHANGELOG +## 3.10.0+### Changed+* Project moved to Gtihub+* CI at last+* Add support for GHC-9.2.4+* Add support for resource-pool >= 0.3.0++## 3.9.0+### Changed+* Add instance for `MonadFail` (odrdo)++## 3.8.2+### Changed+* Remove unused dependency `type-fun`++## 3.8.1+### Changed+* Compatibility with ghc-8.8.3++## 3.7.0+### Changed+* Use 'HasCallStack' and logging with stack (ilyakooo0)++## 3.6.0+### Changed+* Compatibility with ghc-8.6.5++## 3.5.0+### Changed+* Copatibility with ghc-8.4+* Drop dependency from `derive`+### Fixed+* Implemented method `hlocal`++## 3.4.0+### Removed+* Drop `EitherT` support++## 3.3.0+### Changed+* Support for ghc-8.2 (Catherine Galkina)+* Relax dependency constraints for inflections (Dmitry Bushev)++## 3.2.0+### Changed+* Change interface of `deriveEntity`: now you can state the schema of+ table of entity. (by @4e6)++## 3.1.0+### Changed+* Support for inflections-0.3 (fixed buildability). Tested with LTS 8.5+ ## 3.0.1 ### Changed * Buildability with ghc-8.0.1
+ doctests/Main.hs view
@@ -0,0 +1,34 @@+module Main where++import Test.DocTest++-- This test suite exists only to add dependencies+main :: IO ()+main = doctest+ [ "-XAutoDeriveTypeable"+ , "-XCPP"+ , "-XConstraintKinds"+ , "-XDataKinds"+ , "-XDeriveDataTypeable"+ , "-XDeriveGeneric"+ , "-XEmptyDataDecls"+ , "-XFlexibleContexts"+ , "-XFlexibleInstances"+ , "-XFunctionalDependencies"+ , "-XGADTs"+ , "-XGeneralizedNewtypeDeriving"+ , "-XLambdaCase"+ , "-XMultiParamTypeClasses"+ , "-XOverloadedStrings"+ , "-XQuasiQuotes"+ , "-XRankNTypes"+ , "-XRecordWildCards"+ , "-XScopedTypeVariables"+ , "-XStandaloneDeriving"+ , "-XTemplateHaskell"+ , "-XTupleSections"+ , "-XTypeFamilies"+ , "-XTypeOperators"+ , "-XUndecidableInstances"+ , "-XViewPatterns"+ , "src" ]
example/Main.hs view
@@ -1,9 +1,9 @@ module Main where +import Data.Char import Data.Text (Text) import Data.Time import Database.PostgreSQL.Query-import Text.Inflections -- | Example enum type to check out how 'derivePgEnum' works data Species@@ -11,7 +11,7 @@ | Cat | Snake -derivePgEnum toUnderscore ''Species+derivePgEnum (map toLower) ''Species -- | Example structure to check out how 'deriveFromRow' works data AnimalInfo = AnimalInfo
postgresql-query.cabal view
@@ -1,5 +1,5 @@ name: postgresql-query-version: 3.0.1+version: 3.10.0 synopsis: Sql interpolating quasiquote plus some kind of primitive ORM using it@@ -15,10 +15,14 @@ extra-source-files: CHANGELOG.md , README.md -homepage: https://bitbucket.org/s9gf4ult/postgresql-query+tested-with: GHC == 9.2.4+ , GHC == 9.0.2+ , GHC == 8.6.5++homepage: https://github.com/s9gf4ult/postgresql-query source-repository head type: git- location: git@bitbucket.org:s9gf4ult/postgresql-query.git+ location: git@github.com:s9gf4ult/postgresql-query.git library hs-source-dirs: src@@ -41,6 +45,7 @@ , Database.PostgreSQL.Query.TH.Row , Database.PostgreSQL.Query.TH.SqlExp , Database.PostgreSQL.Query.Types+ other-modules: Database.PostgreSQL.Query.Import default-extensions: AutoDeriveTypeable , CPP@@ -58,6 +63,7 @@ , MultiParamTypeClasses , OverloadedStrings , QuasiQuotes+ , RankNTypes , RecordWildCards , ScopedTypeVariables , StandaloneDeriving@@ -75,13 +81,12 @@ , bytestring , containers , data-default- , either , exceptions , file-embed , haskell-src-meta , hreader >= 1.0.0 && < 2.0.0 , hset >= 2.0.0 && < 3.0.0- , inflections >= 0.2 && < 0.3+ , inflections >= 0.2 && < 1 , monad-control == 0.3.3.1 || > 1.0.0.3 , monad-logger , mtl@@ -96,7 +101,6 @@ , transformers , transformers-base , transformers-compat >= 0.3- , type-fun >= 0.1.0 ghc-options: -Wall @@ -106,7 +110,7 @@ test-suite test type: exitcode-stdio-1.0 default-language: Haskell2010- ghc-options: -Wall+ ghc-options: -Wall -threaded hs-source-dirs: test main-is: Main.hs other-modules: BuilderTest@@ -118,10 +122,10 @@ , QuasiQuotes , TemplateHaskell - build-depends: QuickCheck+ build-depends: base >=4.6 && < 5+ , QuickCheck , attoparsec- , base >=4.6 && < 5- , derive+ , generic-arbitrary , postgresql-query , postgresql-simple , quickcheck-assertions@@ -132,6 +136,43 @@ , tasty-th , text +test-suite doctests+ type: exitcode-stdio-1.0+ hs-source-dirs: doctests+ main-is: Main.hs+ ghc-options: -Wall -threaded+ build-depends: base+ , doctest+ , postgresql-query++ default-language: Haskell2010+ default-extensions: AutoDeriveTypeable+ , CPP+ , ConstraintKinds+ , DataKinds+ , DeriveDataTypeable+ , DeriveGeneric+ , EmptyDataDecls+ , FlexibleContexts+ , FlexibleInstances+ , FunctionalDependencies+ , GADTs+ , GeneralizedNewtypeDeriving+ , LambdaCase+ , MultiParamTypeClasses+ , OverloadedStrings+ , QuasiQuotes+ , RankNTypes+ , RecordWildCards+ , ScopedTypeVariables+ , StandaloneDeriving+ , TemplateHaskell+ , TupleSections+ , TypeFamilies+ , TypeOperators+ , UndecidableInstances+ , ViewPatterns+ test-suite example type: exitcode-stdio-1.0 default-language: Haskell2010@@ -145,7 +186,6 @@ , TemplateHaskell build-depends: base- , inflections , postgresql-query , text , time
src/Database/PostgreSQL/Query/Entity/Class.hs view
@@ -3,8 +3,7 @@ , Ent ) where -import Data.Proxy-import Data.Typeable ( Typeable )+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.Types -- | Auxiliary typeclass for data types which can map to rows of some@@ -12,7 +11,11 @@ -- generate queries. class Entity a where -- | Id type for this entity+#if MIN_VERSION_base(4, 9, 0)+ data EntityId a :: Type+#else data EntityId a :: *+#endif -- | Table name of this entity tableName :: Proxy a -> FN -- | Field names without 'id' and 'created'. The order of field names must match
src/Database/PostgreSQL/Query/Entity/Functions.hs view
@@ -14,14 +14,11 @@ , pgSelectCount ) where -import Control.Monad.Logger import Data.Int ( Int64 )-import Data.Maybe ( listToMaybe )-import Data.Proxy ( Proxy(..) )-import Data.Typeable ( Typeable ) import Database.PostgreSQL.Query.Entity.Class import Database.PostgreSQL.Query.Entity.Internal import Database.PostgreSQL.Query.Functions+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.SqlBuilder import Database.PostgreSQL.Query.TH ( sqlExp )@@ -30,10 +27,7 @@ import Database.PostgreSQL.Simple.FromField import Database.PostgreSQL.Simple.ToField -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif-+import qualified Control.Monad.Fail as F import qualified Data.List as L import qualified Data.List.NonEmpty as NL @@ -42,7 +36,7 @@ pgInsertEntity :: forall a m . ( MonadPostgres m, MonadLogger m, Entity a- , ToRow a, FromField (EntityId a) )+ , ToRow a, FromField (EntityId a), F.MonadFail m ) => a -> m (EntityId a) pgInsertEntity a = do@@ -283,5 +277,7 @@ -> q -> m Integer pgSelectCount p q = do- [[c]] <- pgQuery [sqlExp|SELECT count(id) FROM ^{tableName p} ^{q}|]- return c+ r <- pgQuery [sqlExp|SELECT count(id) FROM ^{tableName p} ^{q}|]+ case r of+ [[c]] -> return c+ _ -> error "this should not happen"
src/Database/PostgreSQL/Query/Entity/Internal.hs view
@@ -9,10 +9,8 @@ , entityToMR ) where -import Data.List.NonEmpty ( NonEmpty )-import Data.Monoid-import Data.Proxy ( Proxy(..) ) import Database.PostgreSQL.Query.Entity.Class+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.Internal import Database.PostgreSQL.Query.SqlBuilder ( SqlBuilder, ToSqlBuilder(..), mkValue )@@ -27,24 +25,32 @@ import qualified Data.List.NonEmpty as NL import qualified Data.List as L +{- $setup+>>> import Database.PostgreSQL.Simple+>>> import Database.PostgreSQL.Simple.ToField+>>> import Database.PostgreSQL.Query.SqlBuilder+>>> con <- connect defaultConnectInfo+>>> run b = fmap fst $ runSqlBuilder con defaultLogMasker b+-} + {- | Build entity fields >>> data Foo = Foo { fName :: Text, fSize :: Int } >>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}->>> runSqlBuilder con $ entityFields id id (Proxy :: Proxy Foo)+>>> run $ entityFields id id (Proxy :: Proxy Foo) "\"name\", \"size\"" ->>> runSqlBuilder con $ entityFields ("id":) id (Proxy :: Proxy Foo)+>>> run $ entityFields ("id":) id (Proxy :: Proxy Foo) "\"id\", \"name\", \"size\"" ->>> runSqlBuilder con $ entityFields (\l -> ("id":l) ++ ["created"]) id (Proxy :: Proxy Foo)+>>> run $ entityFields (\l -> ("id":l) ++ ["created"]) id (Proxy :: Proxy Foo) "\"id\", \"name\", \"size\", \"created\"" ->>> runSqlBuilder con $ entityFields id ("f"<>) (Proxy :: Proxy Foo)+>>> run $ entityFields id ("f"<>) (Proxy :: Proxy Foo) "\"f\".\"name\", \"f\".\"size\"" ->>> runSqlBuilder con $ entityFields ("f.id":) ("f"<>) (Proxy :: Proxy Foo)+>>> run $ entityFields ("f.id":) ("f"<>) (Proxy :: Proxy Foo) "\"f\".\"id\", \"f\".\"name\", \"f\".\"size\"" -}@@ -67,10 +73,10 @@ >>> data Foo = Foo { fName :: Text, fSize :: Int } >>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}->>> runSqlBuilder con $ entityFieldsId id (Proxy :: Proxy Foo)+>>> run $ entityFieldsId id (Proxy :: Proxy Foo) "\"id\", \"name\", \"size\"" ->>> runSqlBuilder con $ entityFieldsId ("f"<>) (Proxy :: Proxy Foo)+>>> run $ entityFieldsId ("f"<>) (Proxy :: Proxy Foo) "\"f\".\"id\", \"f\".\"name\", \"f\".\"size\"" -}@@ -87,13 +93,13 @@ >>> data Foo = Foo { fName :: Text, fSize :: Int } >>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}->>> runSqlBuilder con $ selectEntity (entityFieldsId id) (Proxy :: Proxy Foo)+>>> run $ selectEntity (entityFieldsId id) (Proxy :: Proxy Foo) "SELECT \"id\", \"name\", \"size\" FROM \"foo\"" ->>> runSqlBuilder con $ selectEntity (entityFieldsId ("f"<>)) (Proxy :: Proxy Foo)+>>> run $ selectEntity (entityFieldsId ("f"<>)) (Proxy :: Proxy Foo) "SELECT \"f\".\"id\", \"f\".\"name\", \"f\".\"size\" FROM \"foo\"" ->>> runSqlBuilder con $ selectEntity (entityFields id id) (Proxy :: Proxy Foo)+>>> run $ selectEntity (entityFields id id) (Proxy :: Proxy Foo) "SELECT \"name\", \"size\" FROM \"foo\"" -}@@ -110,13 +116,13 @@ >>> data Foo = Foo { fName :: Text, fSize :: Int } >>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}->>> runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR []+>>> run $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [] "SELECT \"name\", \"size\" FROM \"foo\"" ->>> runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname")]+>>> run $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname")] "SELECT \"name\", \"size\" FROM \"foo\" WHERE \"name\" = 'fooname' " ->>> runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname"), ("size", mkValue 10)]+>>> run $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname"), ("size", mkValue 10)] "SELECT \"name\", \"size\" FROM \"foo\" WHERE \"name\" = 'fooname' AND \"size\" = 10 " -}@@ -142,7 +148,7 @@ >>> data Foo = Foo { fName :: Text, fSize :: Int } >>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"} >>> instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }->>> runSqlBuilder con $ mrToBuilder ", " $ entityToMR $ Foo "Enterprise" 610+>>> run $ mrToBuilder ", " $ entityToMR $ Foo "Enterprise" 610 " \"name\" = 'Enterprise' , \"size\" = 610 " -}@@ -160,7 +166,7 @@ >>> data Foo = Foo { fName :: Text, fSize :: Int } >>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"} >>> instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }->>> runSqlBuilder con $ insertEntity $ Foo "Enterprise" 910+>>> run $ insertEntity $ Foo "Enterprise" 910 "INSERT INTO \"foo\" (\"name\", \"size\") VALUES ('Enterprise', 910)" -}@@ -173,10 +179,12 @@ {- | Same as 'insertEntity' but generates query to insert many queries at same time +>>> import Database.PostgreSQL.Simple.ToField+>>> import Database.PostgreSQL.Query.SqlBuilder.Builder >>> data Foo = Foo { fName :: Text, fSize :: Int } >>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"} >>> instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }->>> runSqlBuilder con $ insertManyEntities $ NL.fromList [Foo "meter" 1, Foo "table" 2, Foo "earth" 151930000000]+>>> run $ insertManyEntities $ NL.fromList [Foo "meter" 1, Foo "table" 2, Foo "earth" 151930000000] "INSERT INTO \"foo\" (\"name\",\"size\") VALUES ('meter',1),('table',2),('earth',151930000000)" -}
src/Database/PostgreSQL/Query/Functions.hs view
@@ -14,12 +14,8 @@ , pgRepsertRow ) where -import Control.Monad-import Control.Monad.Base-import Control.Monad.Logger-import Control.Monad.Trans.Control import Data.Int ( Int64 )-import Data.Monoid+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.Internal import Database.PostgreSQL.Query.SqlBuilder import Database.PostgreSQL.Query.TH@@ -49,58 +45,63 @@ -} pgQuery- :: (HasPostgres m, MonadLogger m, ToSqlBuilder q, FromRow r)+ :: (MonadPostgres m, ToSqlBuilder q, FromRow r, HasCallStack) => q -> m [r]-pgQuery = pgQueryWithMasker defaultLogMasker+pgQuery = withFrozenCallStack $ pgQueryWithMasker defaultLogMasker -- | Execute arbitrary query and return count of affected rows pgExecute- :: (HasPostgres m, MonadLogger m, ToSqlBuilder q)+ :: (MonadPostgres m, ToSqlBuilder q, HasCallStack) => q -> m Int64-pgExecute = pgExecuteWithMasker defaultLogMasker+pgExecute = withFrozenCallStack $ pgExecuteWithMasker defaultLogMasker pgQueryWithMasker- :: (HasPostgres m, MonadLogger m, ToSqlBuilder q, FromRow r)+ :: (MonadPostgres m, ToSqlBuilder q, FromRow r, HasCallStack) => LogMasker -> q -> m [r]-pgQueryWithMasker masker q = withPGConnection $ \c -> do+pgQueryWithMasker masker q = withFrozenCallStack $ withPGConnection $ \c -> do (queryBs, logBs) <- liftBase $ runSqlBuilder c masker $ toSqlBuilder q- logDebugN $ T.decodeUtf8 logBs+ logDebug $ T.decodeUtf8 logBs liftBase $ query_ c queryBs pgExecuteWithMasker- :: (HasPostgres m, MonadLogger m, ToSqlBuilder q)+ :: (MonadPostgres m, ToSqlBuilder q, HasCallStack) => LogMasker -> q -> m Int64-pgExecuteWithMasker masker q = withPGConnection $ \c -> do+pgExecuteWithMasker masker q = withFrozenCallStack $ withPGConnection $ \c -> do (queryBs, logBs) <- liftBase $ runSqlBuilder c masker $ toSqlBuilder q- logDebugN $ T.decodeUtf8 logBs+ logDebug $ T.decodeUtf8 logBs liftBase $ execute_ c queryBs -- | Execute all queries inside one transaction. Rollback transaction on exceptions-pgWithTransaction :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)- => m a- -> m a+pgWithTransaction+ :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)+ => (HasCallStack => m a)+ -> m a pgWithTransaction action = withPGConnection $ \con -> do control $ \runInIO -> do withTransaction con $ runInIO action -- | Same as `pgWithTransaction` but executes queries inside savepoint-pgWithSavepoint :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m) => m a -> m a+pgWithSavepoint+ :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)+ => (HasCallStack => m a)+ -> m a pgWithSavepoint action = withPGConnection $ \con -> do control $ \runInIO -> do withSavepoint con $ runInIO action -- | Wrapper for 'withTransactionMode': Execute an action inside a SQL -- transaction with a given transaction mode.-pgWithTransactionMode :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)- => TransactionMode- -> m a- -> m a+pgWithTransactionMode+ :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)+ => TransactionMode+ -> (HasCallStack => m a)+ -> m a pgWithTransactionMode tmode ma = withPGConnection $ \con -> do control $ \runInIO -> do withTransactionMode tmode con $ runInIO ma@@ -111,11 +112,12 @@ -- True, then the transaction will be retried. If the callback returns -- False, or an exception other than an SqlError occurs then the -- transaction will be rolled back and the exception rethrown.-pgWithTransactionModeRetry :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)- => TransactionMode- -> (SqlError -> Bool)- -> m a- -> m a+pgWithTransactionModeRetry+ :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m, HasCallStack)+ => TransactionMode+ -> (SqlError -> Bool)+ -> (HasCallStack => m a)+ -> m a pgWithTransactionModeRetry tmode epred ma = withPGConnection $ \con -> do control $ \runInIO -> do withTransactionModeRetry tmode epred con $ runInIO ma@@ -130,9 +132,10 @@ -- concurrent setting, you can perform queries in sequence without -- having to worry about what might happen between one statement and -- the next.-pgWithTransactionSerializable :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)- => m a- -> m a+pgWithTransactionSerializable+ :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)+ => (HasCallStack => m a)+ -> m a pgWithTransactionSerializable ma = withPGConnection $ \con -> do control $ \runInIO -> do withTransactionSerializable con $ runInIO ma@@ -164,7 +167,7 @@ pgRepsertRow :: ( MonadPostgres m, MonadLogger m- , ToMarkedRow wrow, ToMarkedRow urow)+ , ToMarkedRow wrow, ToMarkedRow urow, HasCallStack) => FN -- ^ Table name -> wrow -- ^ where condition -> urow -- ^ update row
+ src/Database/PostgreSQL/Query/Import.hs view
@@ -0,0 +1,32 @@+-- | Module for internal usage. Just reexports and some compatibility+-- stuff++module Database.PostgreSQL.Query.Import+ ( module X+ ) where++import Control.Applicative as X+import Control.Monad as X+import Control.Monad.Base as X+import Control.Monad.Catch as X+import Control.Monad.Logger.CallStack as X+import Control.Monad.Trans.Control as X+import Data.List.NonEmpty as X (NonEmpty)+import Data.Maybe as X+import Data.Proxy as X+import Data.String as X+import Data.Text as X (Text)+import Data.Typeable as X+import GHC.Generics as X (Generic)+import GHC.Stack as X++#if MIN_VERSION_base(4,8,0)+import Data.Semigroup as X+#else+import Data.Monoid as X+import Data.Semigroup as X+#endif++#if MIN_VERSION_base(4, 9, 0)+import Data.Kind as X+#endif
src/Database/PostgreSQL/Query/Internal.hs view
@@ -9,11 +9,6 @@ import Database.PostgreSQL.Query.TH import Database.PostgreSQL.Query.Types -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif-- import qualified Data.List as L {- $setup@@ -22,12 +17,13 @@ >>> import Database.PostgreSQL.Query.SqlBuilder >>> import Data.Text ( Text ) >>> con <- connect defaultConnectInfo+>>> run b = fmap fst $ runSqlBuilder con defaultLogMasker b -} {-| Generates comma separated list of field names ->>> runSqlBuilder con $ buildFields ["u" <> "name", "u" <> "phone", "e" <> "email"]+>>> run $ buildFields ["u" <> "name", "u" <> "phone", "e" <> "email"] "\"u\".\"name\", \"u\".\"phone\", \"e\".\"email\"" -} buildFields :: [FN] -> SqlBuilder@@ -38,7 +34,7 @@ {- | generates __UPDATE__ query >>> let name = "%vip%"->>> runSqlBuilder con $ updateTable "ships" (MR [("size", mkValue 15)]) [sqlExp|WHERE size > 15 AND name NOT LIKE #{name}|]+>>> run $ updateTable "ships" (MR [("size", mkValue 15)]) [sqlExp|WHERE size > 15 AND name NOT LIKE #{name}|] "UPDATE \"ships\" SET \"size\" = 15 WHERE size > 15 AND name NOT LIKE '%vip%'" -}@@ -57,7 +53,7 @@ {- | Generate INSERT INTO query for entity ->>> runSqlBuilder con $ insertInto "foo" $ MR [("name", mkValue "vovka"), ("hobby", mkValue "president")]+>>> run $ insertInto "foo" $ MR [("name", mkValue "vovka"), ("hobby", mkValue "president")] "INSERT INTO \"foo\" (\"name\", \"hobby\") VALUES ('vovka', 'president')" -}
src/Database/PostgreSQL/Query/SqlBuilder/Builder.hs view
@@ -14,19 +14,14 @@ import Blaze.ByteString.Builder (Builder) import Data.ByteString (ByteString)-import Data.Semigroup import Data.String import Data.Typeable+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.SqlBuilder.Types import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.Internal import Database.PostgreSQL.Simple.ToField import Database.PostgreSQL.Simple.Types-import GHC.Generics (Generic)--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif import qualified Blaze.ByteString.Builder as BB import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
src/Database/PostgreSQL/Query/SqlBuilder/Types.hs view
@@ -11,10 +11,7 @@ import Blaze.ByteString.Builder (Builder)-import Data.Semigroup-import Data.String-import Data.Typeable-import GHC.Generics (Generic)+import Database.PostgreSQL.Query.Import import Language.Haskell.TH.Lift import qualified Blaze.ByteString.Builder as BB
src/Database/PostgreSQL/Query/TH.hs view
@@ -25,8 +25,8 @@ $(deriveEverything def { eoIdType = ''Id- , eoTableName = toUnderscore- , eoColumnNames = toUnderscore . drop 1+ , eoTableName = textFN . toUnderscore'+ , eoColumnNames = textFN . toUnderscore' . drop 1 , eoDeriveClasses = [''Show, ''Read, ''Ord, ''Eq , ''FromField, ''ToField, ''PathPiece]
src/Database/PostgreSQL/Query/TH/Common.hs view
@@ -6,8 +6,6 @@ , dataConstructors ) where -import Prelude- import Language.Haskell.TH -- | Return constructor name
src/Database/PostgreSQL/Query/TH/Entity.hs view
@@ -3,36 +3,41 @@ , deriveEntity ) where -import Prelude- import Data.Default-import Data.String import Database.PostgreSQL.Query.Entity.Class+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.TH.Common-import Database.PostgreSQL.Query.Types ( FN(..) )+import Database.PostgreSQL.Query.Types ( FN(..), textFN ) import Database.PostgreSQL.Simple.FromField import Database.PostgreSQL.Simple.ToField-import GHC.Generics (Generic) import Language.Haskell.TH import Language.Haskell.TH.Syntax import Text.Inflections -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif+import qualified Data.Text as T -- | Options for deriving `Entity` data EntityOptions = EntityOptions- { eoTableName :: String -> String -- ^ Type name to table name converter- , eoColumnNames :: String -> String -- ^ Record field to column name converter- , eoDeriveClasses :: [Name] -- ^ Typeclasses to derive for Id- , eoIdType :: Name -- ^ Base type for Id+ { eoTableName :: Text -> FN -- ^ Type name to table name converter+ , eoColumnNames :: Text -> FN -- ^ Record field to column name converter+ , eoDeriveClasses :: [Name] -- ^ Typeclasses to derive for Id+ , eoIdType :: Name -- ^ Base type for Id } deriving (Generic) +#if !MIN_VERSION_inflections(0,3,0)+toUnderscore' :: Text -> Text+toUnderscore' = T.pack . toUnderscore . T.unpack+#else+toUnderscore' :: Text -> Text+toUnderscore' = either error' id . toUnderscore+ where+ error' er = error $ "toUnderscore: " ++ show er+#endif+ instance Default EntityOptions where def = EntityOptions- { eoTableName = toUnderscore- , eoColumnNames = toUnderscore+ { eoTableName = textFN . toUnderscore'+ , eoColumnNames = textFN . toUnderscore' , eoDeriveClasses = [ ''Ord, ''Eq, ''Show , ''FromField, ''ToField ] , eoIdType = ''Integer@@ -50,8 +55,8 @@ $(deriveEntity def { eoIdType = ''Id- , eoTableName = toUnderscore- , eoColumnNames = toUnderscore . drop 1+ , eoTableName = textFN . toUnderscore'+ , eoColumnNames = textFN . toUnderscore' . drop 1 , eoDeriveClasses = [''Show, ''Read, ''Ord, ''Eq , ''FromField, ''ToField, ''PathPiece]@@ -82,15 +87,26 @@ [a] -> return a x -> fail $ "expected exactly 1 data constructor, but " ++ show (length x) ++ " got" econt <- [t|Entity $(conT tname)|]+ eidcont <- [t|EntityId $(conT tname)|] ConT entityIdName <- [t|EntityId|] let tnames = nameBase tname idname = tnames ++ "Id" unidname = "get" ++ idname idtype = ConT (eoIdType opts)-#if MIN_VERSION_template_haskell(2,11,0)+#if MIN_VERSION_template_haskell(2,15,0) idcon = RecC (mkName idname) [(mkName unidname, Bang NoSourceUnpackedness NoSourceStrictness, idtype)]+ iddec = NewtypeInstD [] Nothing eidcont Nothing+ idcon [DerivClause Nothing (map ConT $ eoDeriveClasses opts)]+#elif MIN_VERSION_template_haskell(2,12,0)+ idcon = RecC (mkName idname)+ [(mkName unidname, Bang NoSourceUnpackedness NoSourceStrictness, idtype)] iddec = NewtypeInstD [] entityIdName [ConT tname] Nothing+ idcon [DerivClause Nothing (map ConT $ eoDeriveClasses opts)]+#elif MIN_VERSION_template_haskell(2,11,0)+ idcon = RecC (mkName idname)+ [(mkName unidname, Bang NoSourceUnpackedness NoSourceStrictness, idtype)]+ iddec = NewtypeInstD [] entityIdName [ConT tname] Nothing idcon (map ConT $ eoDeriveClasses opts) #else idcon = RecC (mkName idname)@@ -98,8 +114,8 @@ iddec = NewtypeInstD [] entityIdName [ConT tname] idcon (eoDeriveClasses opts) #endif- tblName = fromString $ eoTableName opts tnames- fldNames = map (fromString . eoColumnNames opts . nameBase)+ tblName = eoTableName opts $ T.pack tnames+ fldNames = map (eoColumnNames opts . T.pack . nameBase) $ cFieldNames tcon VarE ntableName <- [e|tableName|] VarE nfieldNames <- [e|fieldNames|]
src/Database/PostgreSQL/Query/TH/Enum.hs view
@@ -11,11 +11,6 @@ import Database.PostgreSQL.Simple.ToField import Language.Haskell.TH -#if !MIN_VERSION_base(4,8,0)-import Data.Traversable-import Control.Applicative-#endif- import qualified Data.Text.Encoding as T import qualified Data.Text as T
src/Database/PostgreSQL/Query/TH/Row.hs view
@@ -3,17 +3,11 @@ , deriveToRow ) where -import Prelude- import Database.PostgreSQL.Query.TH.Common import Database.PostgreSQL.Simple.FromRow ( FromRow(..), field ) import Database.PostgreSQL.Simple.ToRow ( ToRow(..) ) import Language.Haskell.TH -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- {-| Derive 'FromRow' instance. i.e. you have type like that @@@ -88,7 +82,11 @@ $ replicate cargs $ newName "a" [d|instance ToRow $(return $ ConT t) where+#if MIN_VERSION_template_haskell(2,18,0)+ toRow $(return $ ConP cname [] $ map VarP cvars) = $(toFields cvars)|]+#else toRow $(return $ ConP cname $ map VarP cvars) = $(toFields cvars)|]+#endif where toFields v = do tof <- lookupVNameErr "toField"
src/Database/PostgreSQL/Query/TH/SqlExp.hs view
@@ -12,33 +12,38 @@ , sqlExpEmbed , sqlExpFile ) where+ import Prelude hiding (takeWhile) -import Control.Applicative-import Control.Monad ( when ) import Data.Attoparsec.Combinator import Data.Attoparsec.Text import Data.Char ( isSpace ) import Data.FileEmbed ( bsToExp )-import Data.Maybe-import Data.Monoid-import Data.Text ( Text )+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.SqlBuilder-import Language.Haskell.Meta.Parse.Careful import Language.Haskell.TH import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax +#if MIN_VERSION_haskell_src_meta(0,8,0)+import Language.Haskell.Meta.Parse+#else+import Language.Haskell.Meta.Parse.Careful+#endif+ import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Text.Encoding as T {- $setup >>> import Database.PostgreSQL.Simple+>>> import Database.PostgreSQL.Simple.Types >>> import Database.PostgreSQL.Query.SqlBuilder >>> import Data.Text ( Text ) >>> import qualified Data.List as L+>>> import Database.PostgreSQL.Query.TH.SqlExp >>> c <- connect defaultConnectInfo+>>> run b = fmap fst $ runSqlBuilder c defaultLogMasker b -} {- | Maybe the main feature of all library. Quasiquoter which builds@@ -48,7 +53,7 @@ >>> let name = "name" >>> let val = "some 'value'"->>> runSqlBuilder c [sqlExp|SELECT * FROM tbl WHERE ^{mkIdent name} = #{val}|]+>>> run [sqlExp|SELECT * FROM tbl WHERE ^{Identifier name} = #{val}|] "SELECT * FROM tbl WHERE \"name\" = 'some ''value'''" And more comples example:@@ -58,7 +63,7 @@ >>> let active = Nothing :: Maybe Bool >>> let condlist = catMaybes [ fmap (\a -> [sqlExp|name = #{a}|]) name, fmap (\a -> [sqlExp|size = #{a}|]) size, fmap (\a -> [sqlExp|active = #{a}|]) active] >>> let cond = if L.null condlist then mempty else [sqlExp| WHERE ^{mconcat $ L.intersperse " AND " $ condlist} |]->>> runSqlBuilder c [sqlExp|SELECT * FROM tbl ^{cond} -- line comment|]+>>> run [sqlExp|SELECT * FROM tbl ^{cond} -- line comment|] "SELECT * FROM tbl WHERE name = 'name' AND size = 10 " -}
src/Database/PostgreSQL/Query/Types.hs view
@@ -16,12 +16,8 @@ , ToMarkedRow(..) ) where -import Control.Applicative-import Control.Monad-import Control.Monad.Base ( MonadBase(..) )-import Control.Monad.Catch- ( MonadThrow, MonadMask, MonadCatch ) import Control.Monad.Cont.Class ( MonadCont )+import Control.Monad.Catch import Control.Monad.Error.Class ( MonadError ) import Control.Monad.Fix ( MonadFix(..) ) import Control.Monad.HReader@@ -32,7 +28,6 @@ import Control.Monad.Trans import Control.Monad.Trans.Cont import Control.Monad.Trans.Control-import Control.Monad.Trans.Either import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe@@ -40,20 +35,19 @@ import Data.HSet import Data.Pool import Data.String-import Data.Text ( Text ) import Data.Typeable+import Database.PostgreSQL.Query.Import import Database.PostgreSQL.Query.SqlBuilder import Database.PostgreSQL.Query.TH.SqlExp import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.FromField import Database.PostgreSQL.Simple.ToField import Database.PostgreSQL.Simple.Types-import GHC.Generics import Instances.TH.Lift () import Language.Haskell.TH.Lift ( deriveLift ) -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail #endif import qualified Blaze.ByteString.Builder.ByteString as BB@@ -69,6 +63,7 @@ >>> import Database.PostgreSQL.Query.SqlBuilder >>> import Data.Text ( Text ) >>> c <- connect defaultConnectInfo+>>> run b = fmap fst $ runSqlBuilder c defaultLogMasker b -} @@ -84,7 +79,7 @@ newtype InetText = InetText { unInetText :: T.Text } deriving ( IsString, Eq, Ord, Read, Show- , Typeable, Monoid, ToField )+ , Typeable, Semigroup, Monoid, ToField ) instance FromField InetText where@@ -117,7 +112,7 @@ FN ["user","name"] >>> let n = "u.name" :: FN->>> runSqlBuilder c $ toSqlBuilder n+>>> run $ toSqlBuilder n "\"u\".\"name\"" >>> ("user" <> "name") :: FN@@ -125,13 +120,13 @@ >>> let a = "name" :: FN >>> let b = "email" :: FN->>> runSqlBuilder c [sqlExp|^{"u" <> a} = 'name', ^{"e" <> b} = 'email'|]+>>> run [sqlExp|^{"u" <> a} = 'name', ^{"e" <> b} = 'email'|] "\"u\".\"name\" = 'name', \"e\".\"email\" = 'email'" -} newtype FN = FN [Text]- deriving (Ord, Eq, Show, Monoid, Typeable, Generic)+ deriving (Ord, Eq, Show, Semigroup, Monoid, Typeable, Generic) $(deriveLift ''FN) @@ -183,7 +178,7 @@ newtype MarkedRow = MR { unMR :: [(FN, SqlBuilder)]- } deriving (Monoid, Typeable, Generic)+ } deriving (Semigroup, Monoid, Typeable, Generic) class ToMarkedRow a where -- | generate list of pairs (field name, field value)@@ -194,7 +189,7 @@ {- | Turns marked row to query intercalating it with other builder ->>> runSqlBuilder c $ mrToBuilder "AND" $ MR [("name", mkValue "petr"), ("email", mkValue "foo@bar.com")]+>>> run $ mrToBuilder "AND" $ MR [("name", mkValue "petr"), ("email", mkValue "foo@bar.com")] " \"name\" = 'petr' AND \"email\" = 'foo@bar.com' " -}@@ -217,12 +212,6 @@ class (MonadBase IO m) => HasPostgres m where withPGConnection :: (Connection -> m a) -> m a -instance (HasPostgres m) => HasPostgres (EitherT e m) where- withPGConnection action = do- EitherT $ withPGConnection $ \con -> do- runEitherT $ action con- {-# INLINABLE withPGConnection #-}- instance (HasPostgres m) => HasPostgres (ExceptT e m) where withPGConnection action = do ExceptT $ withPGConnection $ \con -> do@@ -281,14 +270,19 @@ => HasPostgres (HReaderT els m) where withPGConnection action = do pool <- hask- withResource pool action+ liftBaseOp (withResource pool) action -- | Empty typeclass signing monad in which transaction is -- safe. i.e. `PgMonadT` have this instance, but some other monad giving -- connection from e.g. connection pool is not.++#if MIN_VERSION_base(4, 9, 0)+class TransactionSafe (m :: Type -> Type)+#else class TransactionSafe (m :: * -> *)+#endif -instance (TransactionSafe m) => TransactionSafe (EitherT e m)+ instance (TransactionSafe m) => TransactionSafe (ExceptT e m) instance (TransactionSafe m) => TransactionSafe (IdentityT m) instance (TransactionSafe m) => TransactionSafe (MaybeT m)@@ -310,7 +304,7 @@ , MonadState s, MonadError e, MonadTrans , Alternative, MonadFix, MonadPlus, MonadIO , MonadCont, MonadThrow, MonadCatch, MonadMask- , MonadBase b, MonadLogger )+ , MonadBase b, MonadLogger, MonadFail ) #if MIN_VERSION_monad_control(1,0,0) instance (MonadBaseControl b m) => MonadBaseControl b (PgMonadT m) where@@ -367,6 +361,7 @@ type MHRElements (PgMonadT m) = MHRElements m askHSet = PgMonadT askHSet {-# INLINEABLE askHSet #-}+ hlocal f (PgMonadT ma) = PgMonadT $ hlocal f ma instance (MonadBase IO m) => HasPostgres (PgMonadT m) where withPGConnection action = do@@ -377,7 +372,11 @@ instance TransactionSafe (PgMonadT m) -runPgMonadT :: Connection -> PgMonadT m a -> m a+runPgMonadT+ :: HasCallStack+ => Connection+ -> (HasCallStack => PgMonadT m a)+ -> m a runPgMonadT con (PgMonadT action) = runReaderT action con {- | If your monad have instance of 'HasPostgres' you maybe dont need this@@ -387,8 +386,9 @@ -} -launchPG :: (HasPostgres m)- => PgMonadT m a- -> m a+launchPG+ :: (HasPostgres m, HasCallStack)+ => (HasCallStack => PgMonadT m a)+ -> m a launchPG act = withPGConnection $ \con -> do runPgMonadT con act
test/ParserTest.hs view
@@ -5,12 +5,10 @@ ) where import Data.Attoparsec.Text ( parseOnly )-import Data.Derive.Arbitrary-import Data.DeriveTH-import Data.Monoid-import Data.Text ( Text )+import Data.Text (Text) import Database.PostgreSQL.Query.SqlBuilder import Database.PostgreSQL.Query.TH.SqlExp+import Test.QuickCheck.Arbitrary.Generic import Test.QuickCheck.Assertions import Test.QuickCheck.Instances () import Test.QuickCheck.Modifiers@@ -19,10 +17,6 @@ import Test.Tasty.QuickCheck import Test.Tasty.TH -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import qualified Data.Text as T noSeqSpace :: [Rope] -> [Rope]@@ -37,6 +31,10 @@ instance Arbitrary RopeList where arbitrary = resize 10 $ (RopeList . noSeqSpace . getNonEmpty) <$> arbitrary +instance Arbitrary FieldOption where+ arbitrary = genericArbitrary+ shrink = genericShrink+ wordAlpha :: [Text] wordAlpha = map T.singleton $ ['A'..'Z'] ++ ['a'..'z']@@ -51,7 +49,6 @@ intAlpha :: [Text] intAlpha = wordAlpha ++ [" "] -derive makeArbitrary ''FieldOption instance Arbitrary Rope where arbitrary =