Skip to content

Commit be231c2

Browse files
s9gf4ults9gf4ult
committed
Merge branch 'release/2.0.0' into production
2 parents 632f75d + 43d808a commit be231c2

File tree

8 files changed

+66
-41
lines changed

8 files changed

+66
-41
lines changed

‎CHANGELOG.md

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,15 @@
11
# CHANGELOG
22

3-
## 1.4.1
3+
## 2.0.0
4+
### Changed
5+
* `Entity` typeclass now use `FN` instead of `Text`. This provides an
6+
ability to define dot-separated table names like
7+
`schemaname.tablename`. This changes breaks backward compatibility,
8+
so major version is bumped to 2.
9+
10+
* TH code changed according to changes in `Entity` typeclass.
11+
12+
## 1.4.0
413
### Changed
514
* `eoDeriveClasse` renamed to `eoDeriveClasses`
615
### Added

‎postgresql-query.cabal

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: postgresql-query
2-
version: 1.4.0
2+
version: 2.0.0
33

44
synopsis: Sql interpolating quasiquote plus some kind of primitive ORM
55
using it
@@ -8,7 +8,6 @@ license: BSD3
88
license-file: LICENSE
99
author: Aleksey Uimanov
1010
maintainer: [email protected]
11-
-- copyright:
1211
category: Database
1312
build-type: Simple
1413
cabal-version: >=1.10
@@ -78,6 +77,8 @@ library
7877
, semigroups
7978
, template-haskell
8079
, text
80+
, th-lift
81+
, th-lift-instances
8182
, time
8283
, transformers
8384
, transformers-base
@@ -99,9 +100,9 @@ test-suite test
99100
, OverloadedStrings
100101
, TemplateHaskell
101102

102-
build-depends: base >=4.6 && < 5
103-
, QuickCheck
103+
build-depends: QuickCheck
104104
, attoparsec
105+
, base >=4.6 && < 5
105106
, postgresql-query
106107
, quickcheck-assertions
107108
, quickcheck-instances

‎src/Database/PostgreSQL/Query/Entity.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,8 @@ module Database.PostgreSQL.Query.Entity
55

66
import Data.Proxy
77
import Data.Text ( Text )
8-
import Data.Typeable
9-
( Typeable )
8+
import Data.Typeable ( Typeable )
9+
import Database.PostgreSQL.Query.Types
1010

1111
-- | Auxiliary typeclass for data types which can map to rows of some
1212
-- table. This typeclass is used inside functions like 'pgSelectEntities' to
@@ -15,10 +15,10 @@ class Entity a where
1515
-- | Id type for this entity
1616
data EntityId a :: *
1717
-- | Table name of this entity
18-
tableName :: Proxy a -> Text
18+
tableName :: Proxy a -> FN
1919
-- | Field names without 'id' and 'created'. The order of field names must match
2020
-- with order of fields in 'ToRow' and 'FromRow' instances of this type.
21-
fieldNames :: Proxy a -> [Text]
21+
fieldNames :: Proxy a -> [FN]
2222

2323
deriving instance Typeable EntityId
2424

‎src/Database/PostgreSQL/Query/Functions.hs

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,6 @@ import Data.Int ( Int64 )
3636
import Data.Maybe ( listToMaybe )
3737
import Data.Monoid
3838
import Data.Proxy ( Proxy(..) )
39-
import Data.Text ( Text )
4039
import Data.Typeable ( Typeable )
4140
import Database.PostgreSQL.Query.Entity
4241
( Entity(..), Ent )
@@ -45,7 +44,7 @@ import Database.PostgreSQL.Query.Internal
4544
entityFields, selectEntitiesBy, insertManyEntities,
4645
updateTable, insertInto )
4746
import Database.PostgreSQL.Query.SqlBuilder
48-
( ToSqlBuilder(..), runSqlBuilder, mkIdent )
47+
( ToSqlBuilder(..), runSqlBuilder )
4948
import Database.PostgreSQL.Query.TH
5049
( sqlExp )
5150
import Database.PostgreSQL.Query.Types
@@ -323,7 +322,7 @@ pgDeleteEntity :: forall a m. (Entity a, HasPostgres m, MonadLogger m, ToField (
323322
pgDeleteEntity eid =
324323
let p = Proxy :: Proxy a
325324
in fmap (1 ==)
326-
$ pgExecute [sqlExp|DELETE FROM ^{mkIdent $ tableName p}
325+
$ pgExecute [sqlExp|DELETE FROM ^{tableName p}
327326
WHERE id = #{eid}|]
328327

329328

@@ -357,7 +356,7 @@ pgUpdateEntity eid b =
357356
in if L.null $ unMR mr
358357
then return False
359358
else fmap (1 ==)
360-
$ pgExecute [sqlExp|UPDATE ^{mkIdent $ tableName p}
359+
$ pgExecute [sqlExp|UPDATE ^{tableName p}
361360
SET ^{mrToBuilder ", " mr}
362361
WHERE id = #{eid}|]
363362

@@ -377,7 +376,7 @@ pgSelectCount :: forall m a q. ( Entity a, HasPostgres m, MonadLogger m, ToSqlBu
377376
-> q
378377
-> m Integer
379378
pgSelectCount p q = do
380-
[[c]] <- pgQuery [sqlExp|SELECT count(id) FROM ^{mkIdent $ tableName p} ^{q}|]
379+
[[c]] <- pgQuery [sqlExp|SELECT count(id) FROM ^{tableName p} ^{q}|]
381380
return c
382381

383382

@@ -406,9 +405,9 @@ will be performed
406405
-}
407406

408407
pgRepsertRow :: (HasPostgres m, MonadLogger m, ToMarkedRow wrow, ToMarkedRow urow)
409-
=> Text -- ^ Table name
410-
-> wrow -- ^ where condition
411-
-> urow -- ^ update row
408+
=> FN -- ^ Table name
409+
-> wrow -- ^ where condition
410+
-> urow -- ^ update row
412411
-> m ()
413412
pgRepsertRow tname wrow urow = do
414413
let wmr = toMarkedRow wrow

‎src/Database/PostgreSQL/Query/Internal.hs

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -19,16 +19,14 @@ import Prelude
1919
import Data.List.NonEmpty ( NonEmpty )
2020
import Data.Monoid
2121
import Data.Proxy ( Proxy(..) )
22-
import Data.Text ( Text )
2322
import Database.PostgreSQL.Query.Entity
2423
( Entity(..) )
2524
import Database.PostgreSQL.Query.SqlBuilder
26-
( SqlBuilder, ToSqlBuilder(..),
27-
mkIdent, mkValue )
25+
( SqlBuilder, ToSqlBuilder(..), mkValue )
2826
import Database.PostgreSQL.Query.TH
2927
( sqlExp )
3028
import Database.PostgreSQL.Query.Types
31-
( FN(..), textFN, MarkedRow(..),
29+
( FN(..), MarkedRow(..),
3230
ToMarkedRow(..), mrToBuilder )
3331
import Database.PostgreSQL.Simple.ToRow
3432
( ToRow(..) )
@@ -39,7 +37,8 @@ import qualified Data.List as L
3937
{- $setup
4038
>>> import Database.PostgreSQL.Simple
4139
>>> import Database.PostgreSQL.Simple.ToField
42-
>>> import PGSimple.SqlBuilder
40+
>>> import Database.PostgreSQL.Query.SqlBuilder
41+
>>> import Data.Text ( Text )
4342
>>> con <- connect defaultConnectInfo
4443
-}
4544

@@ -63,14 +62,14 @@ buildFields flds = mconcat
6362
-}
6463

6564
updateTable :: (ToSqlBuilder q, ToMarkedRow flds)
66-
=> Text -- ^ table name
67-
-> flds -- ^ fields to update
68-
-> q -- ^ condition
65+
=> FN -- ^ table name
66+
-> flds -- ^ fields to update
67+
-> q -- ^ condition
6968
-> SqlBuilder
7069
updateTable tname flds q =
7170
let mr = toMarkedRow flds
7271
setFields = mrToBuilder ", " mr
73-
in [sqlExp|UPDATE ^{mkIdent tname}
72+
in [sqlExp|UPDATE ^{tname}
7473
SET ^{setFields} ^{q}|]
7574

7675

@@ -82,8 +81,8 @@ updateTable tname flds q =
8281
-}
8382

8483
insertInto :: (ToMarkedRow b)
85-
=> Text -- ^ table name
86-
-> b -- ^ list of pairs (name, value) to insert into
84+
=> FN -- ^ table name
85+
-> b -- ^ list of pairs (name, value) to insert into
8786
-> SqlBuilder
8887
insertInto tname b =
8988
let mr = toMarkedRow b
@@ -95,7 +94,7 @@ insertInto tname b =
9594
$ L.intersperse ", "
9695
$ map snd
9796
$ unMR mr
98-
in [sqlExp|INSERT INTO ^{mkIdent tname}
97+
in [sqlExp|INSERT INTO ^{tname}
9998
(^{names}) VALUES (^{values})|]
10099

101100

@@ -130,7 +129,7 @@ entityFields :: (Entity a)
130129
entityFields xpref fpref p =
131130
buildFields
132131
$ xpref
133-
$ map (fpref . FN . (:[]))
132+
$ map fpref
134133
$ fieldNames p
135134

136135
{- | Same as 'entityFields' but prefixes list of names with __id__
@@ -174,7 +173,7 @@ selectEntity :: (Entity a)
174173
-> Proxy a
175174
-> SqlBuilder
176175
selectEntity bld p =
177-
[sqlExp|SELECT ^{bld p} FROM ^{mkIdent $ tableName p}|]
176+
[sqlExp|SELECT ^{bld p} FROM ^{tableName p}|]
178177

179178

180179
{- | Generates SELECT FROM WHERE query with most used conditions
@@ -221,7 +220,7 @@ and same stuff
221220
entityToMR :: forall a. (Entity a, ToRow a) => a -> MarkedRow
222221
entityToMR a =
223222
let p = Proxy :: Proxy a
224-
names = map textFN $ fieldNames p
223+
names = fieldNames p
225224
values = map mkValue $ toRow a
226225
in MR $ zip names values
227226

@@ -252,21 +251,24 @@ insertEntity a =
252251
253252
-}
254253

255-
insertManyEntities :: forall a. (Entity a, ToRow a) => NonEmpty a -> SqlBuilder
254+
insertManyEntities :: forall a. (Entity a, ToRow a)
255+
=> NonEmpty a
256+
-> SqlBuilder
256257
insertManyEntities rows =
257258
let p = Proxy :: Proxy a
258259
names = mconcat
259260
$ L.intersperse ","
260-
$ map mkIdent
261+
$ map toSqlBuilder
261262
$ fieldNames p
262263
values = mconcat
263264
$ L.intersperse ","
264265
$ map rValue
265266
$ NL.toList rows
266267

267-
in [sqlExp|INSERT INTO ^{mkIdent $ tableName p}
268+
in [sqlExp|INSERT INTO ^{tableName p}
268269
(^{names}) VALUES ^{values}|]
269270
where
271+
rValue :: a -> SqlBuilder
270272
rValue row =
271273
let values = mconcat
272274
$ L.intersperse ","

‎src/Database/PostgreSQL/Query/TH.hs

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -17,14 +17,18 @@ module Database.PostgreSQL.Query.TH
1717
import Prelude
1818

1919
import Control.Applicative
20+
import Control.Monad
2021
import Data.Default
2122
import Data.FileEmbed ( embedFile )
23+
import Data.String
2224
import Database.PostgreSQL.Query.Entity ( Entity(..) )
2325
import Database.PostgreSQL.Query.TH.SqlExp
26+
import Database.PostgreSQL.Query.Types ( FN(..) )
2427
import Database.PostgreSQL.Simple.FromRow ( FromRow(..), field )
2528
import Database.PostgreSQL.Simple.ToRow ( ToRow(..) )
2629
import Database.PostgreSQL.Simple.Types ( Query(..) )
2730
import Language.Haskell.TH
31+
import Language.Haskell.TH.Syntax
2832

2933
-- | Return constructor name
3034
cName :: (Monad m) => Con -> m Name
@@ -196,12 +200,15 @@ deriveEntity opts tname = do
196200
[(mkName unidname, NotStrict, idtype)]
197201
iddec = NewtypeInstD [] entityIdName [ConT tname]
198202
idcon (eoDeriveClasses opts)
199-
tblName = eoTableName opts tnames
200-
fldNames = map (eoColumnNames opts . nameBase) $ cFieldNames tcon
203+
tblName = fromString $ eoTableName opts tnames
204+
fldNames = map (fromString . eoColumnNames opts . nameBase)
205+
$ cFieldNames tcon
201206
VarE ntableName <- [e|tableName|]
202207
VarE nfieldNames <- [e|fieldNames|]
203-
let tbldec = FunD ntableName [Clause [WildP] (NormalB $ LitE $ stringL tblName) []]
204-
flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE $ map (LitE . stringL) fldNames) []]
208+
tblExp <- lift (tblName :: FN)
209+
fldExp <- mapM lift (fldNames :: [FN])
210+
let tbldec = FunD ntableName [Clause [WildP] (NormalB tblExp) []]
211+
flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE fldExp) []]
205212
ret = InstanceD [] econt
206213
[ iddec, tbldec, flddec ]
207214
syndec = TySynD (mkName idname) [] (AppT (ConT entityIdName) (ConT tname))

‎src/Database/PostgreSQL/Query/TH/SqlExp.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,8 @@ import qualified Data.Text.Encoding as T
3939

4040
{- $setup
4141
>>> import Database.PostgreSQL.Simple
42-
>>> import PGSimple.SqlBuilder
42+
>>> import Database.PostgreSQL.Query.SqlBuilder
43+
>>> import Data.Text ( Text )
4344
>>> import qualified Data.List as L
4445
>>> c <- connect defaultConnectInfo
4546
-}

‎src/Database/PostgreSQL/Query/Types.hs

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,8 @@ import Database.PostgreSQL.Simple.FromField
5353
import Database.PostgreSQL.Simple.ToField
5454
( ToField )
5555
import GHC.Generics
56+
import Instances.TH.Lift ()
57+
import Language.Haskell.TH.Lift ( deriveLift )
5658

5759
import qualified Data.List as L
5860
import qualified Control.Monad.Trans.State.Lazy as STL
@@ -63,7 +65,8 @@ import qualified Data.Text as T
6365
import qualified Data.Text.Encoding as T
6466

6567
{- $setup
66-
>>> import PGSimple.SqlBuilder
68+
>>> import Database.PostgreSQL.Query.SqlBuilder
69+
>>> import Data.Text ( Text )
6770
>>> c <- connect defaultConnectInfo
6871
-}
6972

@@ -75,6 +78,7 @@ newtype InetText = InetText
7578
} deriving ( IsString, Eq, Ord, Read, Show
7679
, Typeable, Monoid, ToField )
7780

81+
7882
instance FromField InetText where
7983
fromField fld Nothing = returnError ConversionFailed
8084
fld "can not convert Null to InetText"
@@ -121,6 +125,8 @@ FN ["user","name"]
121125
newtype FN = FN [Text]
122126
deriving (Ord, Eq, Show, Monoid, Typeable, Generic)
123127

128+
$(deriveLift ''FN)
129+
124130
instance ToSqlBuilder FN where
125131
toSqlBuilder (FN tt) =
126132
mconcat

0 commit comments

Comments
 (0)