{-|
Module:             Database.PostgreSQL.Typed.Lifted.Protocol
Description:        Protocol package.
Copyright:          © 2017 All rights reserved.
License:            BSD3
Maintainer:         Evan Cofsky <evan@theunixman.com>
Stability:          experimental
Portability:        POSIX
-}

module Database.PostgreSQL.Typed.Lifted.Protocol (
    module Database.PostgreSQL.Typed,
    module Database.PostgreSQL.Typed.Protocol,
    module Database.PostgreSQL.Typed.Types,
    RawStatement,
    ChunkRows,
    pgConnect,
    pgDisconnect,
    pgReconnect,

    pgDescribe,
    pgSimpleQuery,
    pgSimpleQueries_,
    pgPreparedQuery,
    pgPreparedLazyQuery,
    pgCloseStatement,

    pgBegin,
    pgCommit,
    pgRollback,
    pgCommitAll,
    pgRollbackAll,
    pgTransaction
    ) where

import Prelude.Unicode
import Data.String (IsString(..))
import Data.Word
import Control.Lens
import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Monad.Catch
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BS

import Database.PostgreSQL.Typed.Types

import Database.PostgreSQL.Typed (
    pgSQL,
    PGDatabase(..),
    defaultPGDatabase)
import Database.PostgreSQL.Typed.Protocol (PGConnection)
import qualified Database.PostgreSQL.Typed.Protocol as P


-- * Connection management

pgConnect ∷ (MonadBaseControl IO m) ⇒ PGDatabase -> m PGConnection
pgConnect = liftBase ∘ P.pgConnect

pgDisconnect ∷ (MonadBaseControl IO m) ⇒ PGConnection -> m ()
pgDisconnect = liftBase ∘ P.pgDisconnect

pgReconnect ∷ (MonadBaseControl IO m) ⇒ PGConnection → PGDatabase → m PGConnection
pgReconnect conn = liftBase ∘ P.pgReconnect conn

-- * Simple Queries that are just raw SQL

-- | Wrapper for raw SQL statements.
newtype RawStatement = RawStatement {unRawStatement ∷ BSL.ByteString}
    deriving (Eq, Ord, Show, Monoid, IsString)

raw ∷ Iso' RawStatement BSL.ByteString
raw = iso unRawStatement RawStatement

strictRaw ∷ Iso' RawStatement BS.ByteString
strictRaw = iso (BSL.toStrict ∘ unRawStatement) (RawStatement ∘ BSL.fromStrict)

-- ** Operations on a PGConnection

pgDescribe ∷ (MonadBaseControl IO m, Traversable f) ⇒
             PGConnection
             → RawStatement -- ^ SQL string
           → f OID -- ^ Optional type specifications
           → Bool -- ^ Guess nullability, otherwise assume everything is
           → m ([OID], [(BS.ByteString, OID, Bool)])
           -- ^ a list of parameter types, and a list of result
           -- field names, types, and nullability indicators.
pgDescribe c s types nulls = liftBase $ P.pgDescribe c (s ^. raw) (toListOf traversed types) nulls

pgSimpleQuery ∷ (MonadBaseControl IO m) ⇒
    PGConnection
    → RawStatement
    → m (Int, [PGValues])
pgSimpleQuery c s = liftBase $ P.pgSimpleQuery c (s ^. raw)

pgSimpleQueries_ ∷ (MonadBaseControl IO m) ⇒
    PGConnection
    → RawStatement
    → m ()
pgSimpleQueries_ c s = liftBase $ P.pgSimpleQueries_ c (s ^. raw)

pgPreparedQuery ∷ (MonadBaseControl IO m, Traversable f) ⇒
    PGConnection
    → RawStatement
    → f OID
    → PGValues
    → f Bool
    → m (Int, [PGValues])
pgPreparedQuery c s oids vals bins =
    liftBase
    $ P.pgPreparedQuery c (s ^. strictRaw) (toListOf traversed oids) vals (toListOf traversed bins)

newtype ChunkRows = ChunkRows {unChunkRows ∷ Word32}
    deriving (Eq, Ord, Show, Bounded, Enum, Real, Integral, Num)

chunkRows ∷ Iso' ChunkRows Word32
chunkRows = iso unChunkRows ChunkRows

pgPreparedLazyQuery ∷ (MonadBaseControl IO m, Traversable f) ⇒
    PGConnection
    → RawStatement
    → f OID
    → PGValues
    → f Bool
    → ChunkRows
    → m ([PGValues])
pgPreparedLazyQuery c s oids vals bins chunk =
    liftBase
    $ P.pgPreparedLazyQuery c (s ^. strictRaw) (toListOf traversed oids)
    vals (toListOf traversed bins) (chunk ^. chunkRows)

pgCloseStatement ∷ (MonadBaseControl IO m, Traversable f) ⇒
    PGConnection → RawStatement → f OID → m ()
pgCloseStatement c s oids =
    liftBase $ P.pgCloseStatement c (s ^. strictRaw) (toListOf traversed oids)

-- * Transactions

pgBegin ∷ (MonadBaseControl IO m) ⇒ PGConnection → m ()
pgBegin = liftBase ∘ P.pgBegin

pgCommit ∷ (MonadBaseControl IO m) ⇒ PGConnection → m ()
pgCommit = liftBase ∘ P.pgCommit

pgRollback ∷ (MonadBaseControl IO m) ⇒ PGConnection → m ()
pgRollback = liftBase ∘ P.pgRollback

pgCommitAll ∷ (MonadBaseControl IO m) ⇒ PGConnection → m ()
pgCommitAll = liftBase ∘ P.pgCommitAll

pgRollbackAll ∷ (MonadBaseControl IO m) ⇒ PGConnection → m ()
pgRollbackAll = liftBase ∘ P.pgRollbackAll

pgTransaction ∷ (MonadCatch m, MonadBaseControl IO m) ⇒ PGConnection → m a → m a
pgTransaction conn f = do
    pgBegin conn
    a ← onException f (pgRollback conn)
    pgCommit conn
    return a