-- |
-- Module      : Database.Custom.PostgreSQL
-- Copyright   : 2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides custom APIs with appropriate configuration
-- for PostgreSQL.
module Database.Custom.PostgreSQL (
  module Database.Relational,

  relationalQuery,

  insertValue, insertValueNoPH, insertQuery,
  update, updateNoPH,
  delete, deleteNoPH,
  ) where

import Language.SQL.Keyword (Keyword)
import Database.Relational.Schema.PostgreSQL.Config (config)
import Database.Relational hiding
  (relationalQuery,
   insertValue, insertValueNoPH, insertQuery,
   update, updateNoPH,
   delete, deleteNoPH, )

-- | From 'Relation' into typed 'Query' with suffix SQL words.
relationalQuery :: Relation p r  -- ^ relation to finalize building
                -> [Keyword]     -- ^ suffix SQL words. for example, `[FOR, UPDATE]`, `[FETCH, FIRST, "3", ROWS, ONLY]` ...
                -> Query p r     -- ^ finalized query
relationalQuery :: forall p r. Relation p r -> [Keyword] -> Query p r
relationalQuery = forall p r. Config -> Relation p r -> [Keyword] -> Query p r
relationalQuery_ Config
config

-- | Make 'Insert' from derived table and monadic built 'Register' object.
insertValue :: TableDerivable r
            => Register r (PlaceHolders p)
            -> Insert p
insertValue :: forall r p.
TableDerivable r =>
Register r (PlaceHolders p) -> Insert p
insertValue = forall r p.
TableDerivable r =>
Config -> Register r (PlaceHolders p) -> Insert p
insertValue' Config
config

-- | Make 'Insert' from derived table and monadic built 'Register' object with no(unit) placeholder.
insertValueNoPH :: TableDerivable r
                => Register r ()
                -> Insert ()
insertValueNoPH :: forall r. TableDerivable r => Register r () -> Insert ()
insertValueNoPH Register r ()
body = forall r p.
TableDerivable r =>
Register r (PlaceHolders p) -> Insert p
insertValue forall a b. (a -> b) -> a -> b
$ Register r ()
body forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return PlaceHolders ()
unitPH

-- | Make 'InsertQuery' from derived table, 'Pi' and 'Relation'.
insertQuery :: TableDerivable r => Pi r r' -> Relation p r' -> InsertQuery p
insertQuery :: forall r r' p.
TableDerivable r =>
Pi r r' -> Relation p r' -> InsertQuery p
insertQuery = forall r r' p.
TableDerivable r =>
Config -> Pi r r' -> Relation p r' -> InsertQuery p
insertQuery' Config
config

-- | Make 'Update' from derived table and 'Assign' computation.
update :: TableDerivable r
       => (Record Flat r -> Assign r (PlaceHolders p))
       -> Update p
update :: forall r p.
TableDerivable r =>
(Record Flat r -> Assign r (PlaceHolders p)) -> Update p
update = forall r p.
TableDerivable r =>
Config -> (Record Flat r -> Assign r (PlaceHolders p)) -> Update p
update' Config
config

-- | Make 'Update' from derived table and 'Assign' computation with no(unit) placeholder.
updateNoPH :: TableDerivable r
           => (Record Flat r -> Assign r ())
           -> Update ()
updateNoPH :: forall r.
TableDerivable r =>
(Record Flat r -> Assign r ()) -> Update ()
updateNoPH Record Flat r -> Assign r ()
body = forall r p.
TableDerivable r =>
(Record Flat r -> Assign r (PlaceHolders p)) -> Update p
update forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return PlaceHolders ()
unitPH) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record Flat r -> Assign r ()
body

-- | Make 'Delete' from derived table and 'Restrict' computation.
delete :: TableDerivable r
       => (Record Flat r -> Restrict (PlaceHolders p))
       -> Delete p
delete :: forall r p.
TableDerivable r =>
(Record Flat r -> Restrict (PlaceHolders p)) -> Delete p
delete = forall r p.
TableDerivable r =>
Config -> (Record Flat r -> Restrict (PlaceHolders p)) -> Delete p
delete' Config
config

-- | Make 'Delete' from 'defaultConfig', derived table and 'Restrict' computation with no(unit) placeholder.
deleteNoPH :: TableDerivable r
           => (Record Flat r -> Restrict ())
           -> Delete ()
deleteNoPH :: forall r.
TableDerivable r =>
(Record Flat r -> Restrict ()) -> Delete ()
deleteNoPH Record Flat r -> Restrict ()
body = forall r p.
TableDerivable r =>
(Record Flat r -> Restrict (PlaceHolders p)) -> Delete p
delete forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return PlaceHolders ()
unitPH) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record Flat r -> Restrict ()
body