summaryrefslogtreecommitdiff
path: root/src/Database/PostgreSQL/Query/Entity/Functions.hs
blob: 108a1c9bb5fa7e61e236285227a293aa4846e599 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
module Database.PostgreSQL.Query.Entity.Functions
  ( -- * Work with entities
    pgInsertEntity
  , pgInsertManyEntities
  , pgInsertManyEntitiesId
  , pgSelectEntities
  , pgSelectJustEntities
  , pgSelectEntitiesBy
  , pgGetEntity
  , pgGetEntityBy
  , pgQueryEntities
  , pgDeleteEntity
  , pgUpdateEntity
  , pgSelectCount
  ) where

import Data.Int ( Int64 )
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 )
import Database.PostgreSQL.Query.Types
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.ToField

import qualified Control.Monad.Fail as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NL


-- | Insert new entity and return it's id
pgInsertEntity
  :: forall a m
   . ( MonadPostgres m, MonadLogger m, Entity a
     , ToRow a, FromField (EntityId a), F.MonadFail m )
  => a
  -> m (EntityId a)
pgInsertEntity a = do
    pgQuery [sqlExp|^{insertEntity a} RETURNING id|] >>= \case
        ((Only ret):_) -> return ret
        _       -> fail "Query did not return any response"


{- | Select entities as pairs of (id, entity).

@
handler :: Handler [Ent a]
handler = do
    now <- liftIO getCurrentTime
    let back = addUTCTime (days  (-7)) now
    pgSelectEntities id
        [sqlExp|WHERE created BETWEEN \#{now} AND \#{back}
               ORDER BY created|]

handler2 :: Text -> Handler [Ent Foo]
handler2 fvalue = do
    pgSelectEntities ("t"<>)
        [sqlExp|AS t INNER JOIN table2 AS t2
                ON t.t2_id = t2.id
                WHERE t.field = \#{fvalue}
                ORDER BY t2.field2|]
   -- Here the query will be: SELECT ... FROM tbl AS t INNER JOIN ...
@

-}

pgSelectEntities
  :: forall m a q
   . ( Functor m, MonadPostgres m, MonadLogger m, Entity a
     , FromRow a, ToSqlBuilder q, FromField (EntityId a) )
  => (FN -> FN)
   -- ^ Entity fields name modifier, e.g. ("tablename"<>). Each field of entity
   -- will be processed by this modifier before pasting to the query
  -> q
   -- ^ part of query just after __SELECT .. FROM table__.
  -> m [Ent a]
pgSelectEntities fpref q = do
    let p = Proxy :: Proxy a
    pgQueryEntities [sqlExp|^{selectEntity (entityFieldsId fpref) p} ^{q}|]


-- | Same as 'pgSelectEntities' but do not select id
pgSelectJustEntities
  :: forall m a q
   . ( Functor m, MonadPostgres m, MonadLogger m, Entity a
     , FromRow a, ToSqlBuilder q )
  => (FN -> FN)
  -> q
  -> m [a]
pgSelectJustEntities fpref q = do
    let p = Proxy :: Proxy a
    pgQuery [sqlExp|^{selectEntity (entityFields id fpref) p} ^{q}|]

{- | Select entities by condition formed from 'MarkedRow'. Usefull function when
you know

-}

pgSelectEntitiesBy
  :: forall a m b
   . ( Functor m, MonadPostgres m, MonadLogger m, Entity a, ToMarkedRow b
     , FromRow a, FromField (EntityId a) )
  => b
  -> m [Ent a]
pgSelectEntitiesBy b =
    let p = Proxy :: Proxy a
    in pgQueryEntities $ selectEntitiesBy ("id":) p b


-- | Select entity by id
--
-- @
-- getUser :: EntityId User ->  Handler User
-- getUser uid = do
--     pgGetEntity uid
--         >>= maybe notFound return
-- @
pgGetEntity
  :: forall m a
   . ( ToField (EntityId a), Entity a, FromRow a
     , MonadPostgres m, MonadLogger m, Functor m)
  => EntityId a
  -> m (Maybe a)
pgGetEntity eid = do
    listToMaybe <$> pgSelectJustEntities id [sqlExp|WHERE id = #{eid} LIMIT 1|]


{- | Get entity by some fields constraint

@
getUser :: UserName -> Handler User
getUser name = do
    pgGetEntityBy
        (MR [("name", mkValue name),
             ("active", mkValue True)])
        >>= maybe notFound return
@

The query here will be like

@
pgQuery [sqlExp|SELECT id, name, phone ... FROM users WHERE name = #{name} AND active = #{True}|]
@

-}

pgGetEntityBy
  :: forall m a b
   . ( Entity a, MonadPostgres m, MonadLogger m, ToMarkedRow b
     , FromField (EntityId a), FromRow a, Functor m )
  => b               -- ^ uniq constrained list of fields and values
  -> m (Maybe (Ent a))
pgGetEntityBy b =
    let p = Proxy :: Proxy a
    in fmap listToMaybe
       $ pgQueryEntities
       [sqlExp|^{selectEntitiesBy ("id":) p b} LIMIT 1|]


-- | Same as 'pgInsertEntity' but insert many entities at one
-- action. Returns list of id's of inserted entities
pgInsertManyEntitiesId
  :: forall a m
   . ( Entity a, MonadPostgres m, MonadLogger m
     , ToRow a, FromField (EntityId a))
  => [a]
  -> m [EntityId a]
pgInsertManyEntitiesId [] = return []
pgInsertManyEntitiesId ents' =
    let ents = NL.fromList ents'
        q = [sqlExp|^{insertManyEntities ents} RETURNING id|]
    in map fromOnly <$> pgQuery q

-- | Insert many entities without returning list of id like
-- 'pgInsertManyEntitiesId' does
pgInsertManyEntities
  :: forall a m
   . (Entity a, MonadPostgres m, MonadLogger m, ToRow a)
  => [a]
  -> m Int64
pgInsertManyEntities [] = return 0
pgInsertManyEntities ents' =
    let ents = NL.fromList ents'
    in pgExecute $ insertManyEntities ents


{- | Delete entity.

@
rmUser :: EntityId User -> Handler ()
rmUser uid = do
    pgDeleteEntity uid
@

Return 'True' if row was actually deleted.
-}

pgDeleteEntity
  :: forall a m
   . (Entity a, MonadPostgres m, MonadLogger m, ToField (EntityId a), Functor m)
  => EntityId a
  -> m Bool
pgDeleteEntity eid =
    let p = Proxy :: Proxy a
    in fmap (1 ==)
       $ pgExecute [sqlExp|DELETE FROM ^{tableName p}
                           WHERE id = #{eid}|]


{- | Update entity using 'ToMarkedRow' instanced value. Requires 'Proxy'
while 'EntityId' is not a data type.

@
fixUser :: Text -> EntityId User -> Handler ()
fixUser username uid = do
    pgGetEntity uid
        >>= maybe notFound run
  where
    run user =
        pgUpdateEntity uid
        $ MR [("active", mkValue True)
              ("name", mkValue username)]
@

Returns 'True' if record was actually updated and 'False' if there was
not row with such id (or was more than 1, in fact)
-}

pgUpdateEntity
  :: forall a b m
   . ( ToMarkedRow b, Entity a, MonadPostgres m, MonadLogger m
     , ToField (EntityId a), Functor m, Typeable a, Typeable b)
  => EntityId a
  -> b
  -> m Bool
pgUpdateEntity eid b =
    let p = Proxy :: Proxy a
        mr = toMarkedRow b
    in if L.null $ unMR mr
       then return False
       else fmap (1 ==)
            $ pgExecute [sqlExp|UPDATE ^{tableName p}
                                SET ^{mrToBuilder ", " mr}
                                WHERE id = #{eid}|]

{- | Select count of entities with given query

@
activeUsers :: Handler Integer
activeUsers = do
    pgSelectCount (Proxy :: Proxy User)
        [sqlExp|WHERE active = #{True}|]
@

-}


-- | Executes arbitrary query and parses it as entities and their ids
pgQueryEntities
  :: ( ToSqlBuilder q, MonadPostgres m, MonadLogger m, Entity a
     , FromRow a, FromField (EntityId a))
  => q
  -> m [Ent a]
pgQueryEntities q =
    map toTuples <$> pgQuery q
  where
    toTuples ((Only eid) :. entity) = (eid, entity)

pgSelectCount
  :: forall m a q
   . ( Entity a, MonadPostgres m, MonadLogger m, ToSqlBuilder q )
  => Proxy a
  -> q
  -> m Integer
pgSelectCount p q = do
    r <- pgQuery [sqlExp|SELECT count(id) FROM ^{tableName p} ^{q}|]
    case r of
      [[c]] -> return c
      _ -> error "this should not happen"