postgresql-query 3.9.0 → 3.10.0
raw patch · 11 files changed
+145/−37 lines, 11 filesdep +doctestdep ~base
Dependencies added: doctest
Dependency ranges changed: base
Files
- CHANGELOG.md +7/−0
- doctests/Main.hs +34/−0
- postgresql-query.cabal +45/−4
- src/Database/PostgreSQL/Query/Entity/Class.hs +4/−0
- src/Database/PostgreSQL/Query/Entity/Internal.hs +26/−16
- src/Database/PostgreSQL/Query/Import.hs +4/−0
- src/Database/PostgreSQL/Query/Internal.hs +4/−3
- src/Database/PostgreSQL/Query/TH/Row.hs +4/−0
- src/Database/PostgreSQL/Query/TH/SqlExp.hs +5/−2
- src/Database/PostgreSQL/Query/Types.hs +12/−11
- test/ParserTest.hs +0/−1
CHANGELOG.md view
@@ -1,5 +1,12 @@ # 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)
+ 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" ]
postgresql-query.cabal view
@@ -1,5 +1,5 @@ name: postgresql-query-version: 3.9.0+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@@ -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@@ -131,6 +135,43 @@ , tasty-quickcheck , 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
src/Database/PostgreSQL/Query/Entity/Class.hs view
@@ -11,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/Internal.hs view
@@ -25,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\"" -}@@ -65,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\"" -}@@ -85,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\"" -}@@ -108,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 " -}@@ -140,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 " -}@@ -158,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)" -}@@ -171,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/Import.hs view
@@ -26,3 +26,7 @@ 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
@@ -17,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@@ -33,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%'" -}@@ -52,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/TH/Row.hs view
@@ -82,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
@@ -37,10 +37,13 @@ {- $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@@ -50,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:@@ -60,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
@@ -17,6 +17,7 @@ ) where 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@@ -45,13 +46,6 @@ import Instances.TH.Lift () import Language.Haskell.TH.Lift ( deriveLift ) -#if MIN_VERSION_base(4,8,0)-import Data.Semigroup-#else-import Data.Monoid-import Data.Semigroup-#endif- #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail #endif@@ -69,6 +63,7 @@ >>> import Database.PostgreSQL.Query.SqlBuilder >>> import Data.Text ( Text ) >>> c <- connect defaultConnectInfo+>>> run b = fmap fst $ runSqlBuilder c defaultLogMasker b -} @@ -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,7 +120,7 @@ >>> 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'" -}@@ -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' " -}@@ -275,12 +270,18 @@ => 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 (ExceptT e m) instance (TransactionSafe m) => TransactionSafe (IdentityT m)
test/ParserTest.hs view
@@ -5,7 +5,6 @@ ) where import Data.Attoparsec.Text ( parseOnly )-import Data.Monoid import Data.Text (Text) import Database.PostgreSQL.Query.SqlBuilder import Database.PostgreSQL.Query.TH.SqlExp