{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE Strict #-}
module Database.PostgreSQL.Entity
(
Entity (..)
, Field
, selectById
, selectOneByField
, selectManyByField
, selectWhereNotNull
, selectWhereNull
, joinSelectById
, insert
, update
, updateFieldsBy
, delete
, deleteByField
, _select
, _selectWithFields
, _where
, _selectWhere
, _selectWhereNotNull
, _selectWhereNull
, _joinSelect
, _innerJoin
, _joinSelectWithFields
, _insert
, _update
, _updateBy
, _updateFields
, _updateFieldsBy
, _delete
, _deleteWhere
) where
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO)
import Data.Foldable (fold)
import Data.Int
import Data.Vector (Vector)
import qualified Data.Vector as V
import Database.PostgreSQL.Simple (Only (..))
import Database.PostgreSQL.Simple.FromRow (FromRow)
import Database.PostgreSQL.Simple.ToField (ToField)
import Database.PostgreSQL.Simple.ToRow (ToRow (..))
import Database.PostgreSQL.Simple.Types (Query (..))
import Database.PostgreSQL.Transact (DBT)
import Database.PostgreSQL.Entity.DBT (QueryNature (..), execute, query, queryOne, query_)
import Database.PostgreSQL.Entity.Internal
import Database.PostgreSQL.Entity.Types
selectById :: forall e value m.
(Entity e, FromRow e, MonadIO m, ToRow value)
=> value -> DBT m (Maybe e)
selectById :: value -> DBT m (Maybe e)
selectById value
value = Field -> value -> DBT m (Maybe e)
forall e value (m :: * -> *).
(Entity e, FromRow e, MonadIO m, ToRow value) =>
Field -> value -> DBT m (Maybe e)
selectOneByField (Entity e => Field
forall e. Entity e => Field
primaryKey @e) value
value
selectOneByField :: forall e value m.
(Entity e, FromRow e, MonadIO m, ToRow value)
=> Field -> value -> DBT m (Maybe e)
selectOneByField :: Field -> value -> DBT m (Maybe e)
selectOneByField Field
f value
value = QueryNature -> Query -> value -> DBT m (Maybe e)
forall params result (m :: * -> *).
(ToRow params, FromRow result, MonadIO m) =>
QueryNature -> Query -> params -> DBT m (Maybe result)
queryOne QueryNature
Select (Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_selectWhere @e [Item (Vector Field)
Field
f]) value
value
selectManyByField :: forall e value m.
(Entity e, FromRow e, MonadIO m, ToRow value)
=> Field -> value -> DBT m (Vector e)
selectManyByField :: Field -> value -> DBT m (Vector e)
selectManyByField Field
f value
value = QueryNature -> Query -> value -> DBT m (Vector e)
forall params result (m :: * -> *).
(ToRow params, FromRow result, MonadIO m) =>
QueryNature -> Query -> params -> DBT m (Vector result)
query QueryNature
Select (Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_selectWhere @e [Item (Vector Field)
Field
f]) value
value
selectWhereNotNull :: forall e m.
(Entity e, FromRow e, MonadIO m)
=> Vector Field -> DBT m (Vector e)
selectWhereNotNull :: Vector Field -> DBT m (Vector e)
selectWhereNotNull Vector Field
fs = QueryNature -> Query -> DBT m (Vector e)
forall result (m :: * -> *).
(FromRow result, MonadIO m) =>
QueryNature -> Query -> DBT m (Vector result)
query_ QueryNature
Select (Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_selectWhereNotNull @e Vector Field
fs)
selectWhereNull :: forall e m.
(Entity e, FromRow e, MonadIO m)
=> Vector Field -> DBT m (Vector e)
selectWhereNull :: Vector Field -> DBT m (Vector e)
selectWhereNull Vector Field
fs = QueryNature -> Query -> DBT m (Vector e)
forall result (m :: * -> *).
(FromRow result, MonadIO m) =>
QueryNature -> Query -> DBT m (Vector result)
query_ QueryNature
Select (Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_selectWhereNull @e Vector Field
fs)
joinSelectById :: forall e1 e2 m.
(Entity e1, Entity e2, FromRow e1, MonadIO m)
=> DBT m (Vector e1)
joinSelectById :: DBT m (Vector e1)
joinSelectById = QueryNature -> Query -> DBT m (Vector e1)
forall result (m :: * -> *).
(FromRow result, MonadIO m) =>
QueryNature -> Query -> DBT m (Vector result)
query_ QueryNature
Select ((Entity e1, Entity e2) => Query
forall e1 e2. (Entity e1, Entity e2) => Query
_joinSelect @e1 @e2)
insert :: forall e values m.
(Entity e, ToRow values, MonadIO m)
=> values -> DBT m ()
insert :: values -> DBT m ()
insert values
fs = DBT m Int64 -> DBT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DBT m Int64 -> DBT m ()) -> DBT m Int64 -> DBT m ()
forall a b. (a -> b) -> a -> b
$ QueryNature -> Query -> values -> DBT m Int64
forall params (m :: * -> *).
(ToRow params, MonadIO m) =>
QueryNature -> Query -> params -> DBT m Int64
execute QueryNature
Insert (Entity e => Query
forall e. Entity e => Query
_insert @e) values
fs
update :: forall e newValue m.
(Entity e, ToRow newValue, MonadIO m)
=> newValue -> DBT m ()
update :: newValue -> DBT m ()
update newValue
fs = DBT m Int64 -> DBT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DBT m Int64 -> DBT m ()) -> DBT m Int64 -> DBT m ()
forall a b. (a -> b) -> a -> b
$ QueryNature -> Query -> UpdateRow newValue -> DBT m Int64
forall params (m :: * -> *).
(ToRow params, MonadIO m) =>
QueryNature -> Query -> params -> DBT m Int64
execute QueryNature
Update (Entity e => Query
forall e. Entity e => Query
_update @e) (newValue -> UpdateRow newValue
forall a. a -> UpdateRow a
UpdateRow newValue
fs)
updateFieldsBy :: forall e v1 v2 m.
(Entity e, MonadIO m, ToRow v2, ToField v1)
=> Vector Field
-> (Field, v1)
-> v2
-> DBT m Int64
updateFieldsBy :: Vector Field -> (Field, v1) -> v2 -> DBT m Int64
updateFieldsBy Vector Field
fs (Field
f, v1
oldValue) v2
newValue = QueryNature -> Query -> [Action] -> DBT m Int64
forall params (m :: * -> *).
(ToRow params, MonadIO m) =>
QueryNature -> Query -> params -> DBT m Int64
execute QueryNature
Update (Vector Field -> Field -> Query
forall e. Entity e => Vector Field -> Field -> Query
_updateFieldsBy @e Vector Field
fs Field
f) (v2 -> [Action]
forall a. ToRow a => a -> [Action]
toRow v2
newValue [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ Only v1 -> [Action]
forall a. ToRow a => a -> [Action]
toRow (v1 -> Only v1
forall a. a -> Only a
Only v1
oldValue))
delete :: forall e value m.
(Entity e, ToRow value, MonadIO m)
=> value -> DBT m ()
delete :: value -> DBT m ()
delete value
value = Vector Field -> value -> DBT m ()
forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
Vector Field -> values -> DBT m ()
deleteByField @e [Entity e => Field
forall e. Entity e => Field
primaryKey @e] value
value
deleteByField :: forall e values m.
(Entity e, ToRow values, MonadIO m)
=> Vector Field -> values -> DBT m ()
deleteByField :: Vector Field -> values -> DBT m ()
deleteByField Vector Field
fs values
values = DBT m Int64 -> DBT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DBT m Int64 -> DBT m ()) -> DBT m Int64 -> DBT m ()
forall a b. (a -> b) -> a -> b
$ QueryNature -> Query -> values -> DBT m Int64
forall params (m :: * -> *).
(ToRow params, MonadIO m) =>
QueryNature -> Query -> params -> DBT m Int64
execute QueryNature
Delete (Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_deleteWhere @e Vector Field
fs) values
values
_select :: forall e. Entity e => Query
_select :: Query
_select = Text -> Query
textToQuery (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"SELECT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e => Text
forall e. Entity e => Text
expandQualifiedFields @e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e => Text
forall e. Entity e => Text
getTableName @e
_selectWithFields :: forall e. Entity e => Vector Field -> Query
_selectWithFields :: Vector Field -> Query
_selectWithFields Vector Field
fs = Text -> Query
textToQuery (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"SELECT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Text -> Text
expandQualifiedFields' Vector Field
fs Text
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteName Text
tn
where tn :: Text
tn = Entity e => Text
forall e. Entity e => Text
tableName @e
_where :: forall e. Entity e => Vector Field -> Query
_where :: Vector Field -> Query
_where Vector Field
fs' = Text -> Query
textToQuery (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
" WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
clauseFields
where
fieldNames :: Vector Text
fieldNames = (Field -> Text) -> Vector Field -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Text
fieldName Vector Field
fs'
fs :: Vector Field
fs = (Field -> Bool) -> Vector Field -> Vector Field
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\Field
f -> Field -> Text
fieldName Field
f Text -> Vector Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Vector Text
fieldNames) (Entity e => Vector Field
forall e. Entity e => Vector Field
fields @e)
clauseFields :: Text
clauseFields = Vector Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Vector Text -> Text) -> Vector Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Vector Text -> Vector Text
intercalateVector Text
" AND " ((Field -> Text) -> Vector Field -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field -> Text
placeholder Vector Field
fs)
_selectWhere :: forall e. Entity e => Vector Field -> Query
_selectWhere :: Vector Field -> Query
_selectWhere Vector Field
fs = Entity e => Query
forall e. Entity e => Query
_select @e Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_where @e Vector Field
fs
_selectWhereNotNull :: forall e. Entity e => Vector Field -> Query
_selectWhereNotNull :: Vector Field -> Query
_selectWhereNotNull Vector Field
fs = Entity e => Query
forall e. Entity e => Query
_select @e Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Text -> Query
textToQuery (Text
" WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Text
isNotNull Vector Field
fs)
_selectWhereNull :: forall e. Entity e => Vector Field -> Query
_selectWhereNull :: Vector Field -> Query
_selectWhereNull Vector Field
fs = Entity e => Query
forall e. Entity e => Query
_select @e Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Text -> Query
textToQuery (Text
" WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Text
isNull Vector Field
fs)
_joinSelect :: forall e1 e2. (Entity e1, Entity e2) => Query
_joinSelect :: Query
_joinSelect = Text -> Query
textToQuery (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"SELECT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e1 => Text
forall e. Entity e => Text
expandQualifiedFields @e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e2 => Text
forall e. Entity e => Text
expandQualifiedFields @e2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e1 => Text
forall e. Entity e => Text
getTableName @e1
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Query -> Text
queryToText (Field -> Query
forall e. Entity e => Field -> Query
_innerJoin @e2 (Entity e2 => Field
forall e. Entity e => Field
primaryKey @e2))
_innerJoin :: forall e. (Entity e) => Field -> Query
_innerJoin :: Field -> Query
_innerJoin Field
f = Text -> Query
textToQuery (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
" INNER JOIN " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e => Text
forall e. Entity e => Text
getTableName @e
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" USING(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Field -> Text
fieldName Field
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
_joinSelectWithFields :: forall e1 e2. (Entity e1, Entity e2)
=> Vector Field -> Vector Field -> Query
_joinSelectWithFields :: Vector Field -> Vector Field -> Query
_joinSelectWithFields Vector Field
fs1 Vector Field
fs2 =
Text -> Query
textToQuery (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"SELECT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Text -> Text
expandQualifiedFields' Vector Field
fs1 Text
tn1
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Text -> Text
expandQualifiedFields' Vector Field
fs2 Text
tn2
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e1 => Text
forall e. Entity e => Text
getTableName @e1
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Query -> Text
queryToText (Field -> Query
forall e. Entity e => Field -> Query
_innerJoin @e2 (Entity e2 => Field
forall e. Entity e => Field
primaryKey @e2))
where
tn1 :: Text
tn1 = Entity e1 => Text
forall e. Entity e => Text
tableName @e1
tn2 :: Text
tn2 = Entity e2 => Text
forall e. Entity e => Text
tableName @e2
_insert :: forall e. Entity e => Query
_insert :: Query
_insert = Text -> Query
textToQuery (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"INSERT INTO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e => Text
forall e. Entity e => Text
getTableName @e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" VALUES " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ps
where
fs :: Text
fs = Text -> Text
inParens (Entity e => Text
forall e. Entity e => Text
expandFields @e)
ps :: Text
ps = Text -> Text
inParens (Vector Field -> Text
generatePlaceholders (Vector Field -> Text) -> Vector Field -> Text
forall a b. (a -> b) -> a -> b
$ Entity e => Vector Field
forall e. Entity e => Vector Field
fields @e)
_update :: forall e. Entity e => Query
_update :: Query
_update = Field -> Query
forall e. Entity e => Field -> Query
_updateBy @e (Entity e => Field
forall e. Entity e => Field
primaryKey @e)
_updateBy :: forall e. Entity e => Field -> Query
_updateBy :: Field -> Query
_updateBy Field
f = Vector Field -> Field -> Query
forall e. Entity e => Vector Field -> Field -> Query
_updateFieldsBy @e (Entity e => Vector Field
forall e. Entity e => Vector Field
fields @e) Field
f
_updateFields :: forall e. Entity e => Vector Field -> Query
_updateFields :: Vector Field -> Query
_updateFields Vector Field
fs = Vector Field -> Field -> Query
forall e. Entity e => Vector Field -> Field -> Query
_updateFieldsBy @e Vector Field
fs (Entity e => Field
forall e. Entity e => Field
primaryKey @e)
_updateFieldsBy :: forall e. Entity e
=> Vector Field
-> Field
-> Query
_updateFieldsBy :: Vector Field -> Field -> Query
_updateFieldsBy Vector Field
fs' Field
f = Text -> Query
textToQuery (
Text
"UPDATE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e => Text
forall e. Entity e => Text
getTableName @e
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" SET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
updatedFields Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newValues)
Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_where @e [Item (Vector Field)
Field
f]
where
fs :: Vector Field
fs = (Field -> Bool) -> Vector Field -> Vector Field
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Field -> Field -> Bool
forall a. Eq a => a -> a -> Bool
/= (Entity e => Field
forall e. Entity e => Field
primaryKey @e)) Vector Field
fs'
newValues :: Text
newValues = Text
"ROW" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Vector Field -> Text
generatePlaceholders Vector Field
fs)
updatedFields :: Text
updatedFields = Text -> Text
inParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
(Text -> Text -> Text) -> Vector Text -> Text
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' (\Text
element Text
acc -> Text
element Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
acc) (Text -> Text
quoteName (Text -> Text) -> (Field -> Text) -> Field -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Text
fieldName (Field -> Text) -> Vector Field -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Field
fs)
_delete :: forall e. Entity e => Query
_delete :: Query
_delete = Text -> Query
textToQuery (Text
"DELETE FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity e => Text
forall e. Entity e => Text
getTableName @e) Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_where @e [Entity e => Field
forall e. Entity e => Field
primaryKey @e]
_deleteWhere :: forall e. Entity e => Vector Field -> Query
_deleteWhere :: Vector Field -> Query
_deleteWhere Vector Field
fs = Text -> Query
textToQuery (Text
"DELETE FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Entity e => Text
forall e. Entity e => Text
tableName @e)) Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Vector Field -> Query
forall e. Entity e => Vector Field -> Query
_where @e Vector Field
fs