module Rel8.Statement.Run
  ( run_
  , runN
  , run1
  , runMaybe
  , run
  , runVector
  )
where

-- base
import Data.Int (Int64)
import Prelude

-- hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Statement as Hasql

-- rel8
import Rel8.Query (Query)
import Rel8.Statement (Statement, ppDecodeStatement)
import Rel8.Statement.Rows (Rows (..))
import Rel8.Statement.Select (ppSelect)
import Rel8.Table.Serialize (Serializable)

-- text
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)

-- vector
import Data.Vector (Vector)


makeRun :: Rows exprs a -> Statement exprs -> Hasql.Statement () a
makeRun :: forall exprs a. Rows exprs a -> Statement exprs -> Statement () a
makeRun Rows exprs a
rows Statement exprs
statement = ByteString -> Params () -> Result a -> Bool -> Statement () a
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Hasql.Statement ByteString
bytes Params ()
params Result a
decode Bool
prepare
  where
    bytes :: ByteString
bytes = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
sql
    params :: Params ()
params = Params ()
Hasql.noParams
    prepare :: Bool
prepare = Bool
False
    sql :: String
sql = Doc -> String
forall a. Show a => a -> String
show Doc
doc
    (Doc
doc, Result a
decode) = (forall x. Table Expr x => Query x -> State Tag Doc)
-> Rows exprs a -> Statement exprs -> (Doc, Result a)
forall exprs a.
(forall x. Table Expr x => Query x -> State Tag Doc)
-> Rows exprs a -> Statement exprs -> (Doc, Result a)
ppDecodeStatement Query x -> State Tag Doc
forall x. Table Expr x => Query x -> State Tag Doc
ppSelect Rows exprs a
rows Statement exprs
statement


-- | Convert a 'Statement' to a runnable 'Hasql.Statement', disregarding the
-- results of that statement (if any).
run_ :: Statement exprs -> Hasql.Statement () ()
run_ :: forall exprs. Statement exprs -> Statement () ()
run_ = Rows exprs () -> Statement exprs -> Statement () ()
forall exprs a. Rows exprs a -> Statement exprs -> Statement () a
makeRun Rows exprs ()
forall returning. Rows returning ()
Void


-- | Convert a 'Statement' to a runnable 'Hasql.Statement', returning the
-- number of rows affected by that statement (for 'Rel8.insert's,
-- 'Rel8.update's or Rel8.delete's with 'Rel8.NoReturning').
runN :: Statement () -> Hasql.Statement () Int64
runN :: Statement () -> Statement () Int64
runN = Rows () Int64 -> Statement () -> Statement () Int64
forall exprs a. Rows exprs a -> Statement exprs -> Statement () a
makeRun Rows () Int64
RowsAffected


-- | Convert a 'Statement' to a runnable 'Hasql.Statement', processing the
-- result of the statement as a single row. If the statement returns a number
-- of rows other than 1, a runtime exception is thrown.
run1 :: Serializable exprs 
  a=> Statement (Query exprs) -> Hasql.Statement () a
run1 :: forall exprs a.
Serializable exprs a =>
Statement (Query exprs) -> Statement () a
run1 = Rows (Query exprs) a -> Statement (Query exprs) -> Statement () a
forall exprs a. Rows exprs a -> Statement exprs -> Statement () a
makeRun Rows (Query exprs) a
forall exprs result.
Serializable exprs result =>
Rows (Query exprs) result
Single


-- | Convert a 'Statement' to a runnable 'Hasql.Statement', processing the
-- result of the statement as 'Maybe' a single row. If the statement returns
-- a number of rows other than 0 or 1, a runtime exception is thrown.
runMaybe :: Serializable exprs 
  a=> Statement (Query exprs) -> Hasql.Statement () (Maybe a)
runMaybe :: forall exprs a.
Serializable exprs a =>
Statement (Query exprs) -> Statement () (Maybe a)
runMaybe = Rows (Query exprs) (Maybe a)
-> Statement (Query exprs) -> Statement () (Maybe a)
forall exprs a. Rows exprs a -> Statement exprs -> Statement () a
makeRun Rows (Query exprs) (Maybe a)
forall exprs a.
Serializable exprs a =>
Rows (Query exprs) (Maybe a)
Maybe


-- | Convert a 'Statement' to a runnable 'Hasql.Statement', processing the
-- result of the statement as a list of rows.
run :: Serializable exprs a
  => Statement (Query exprs) -> Hasql.Statement () [a]
run :: forall exprs a.
Serializable exprs a =>
Statement (Query exprs) -> Statement () [a]
run = Rows (Query exprs) [a]
-> Statement (Query exprs) -> Statement () [a]
forall exprs a. Rows exprs a -> Statement exprs -> Statement () a
makeRun Rows (Query exprs) [a]
forall exprs a. Serializable exprs a => Rows (Query exprs) [a]
List


-- | Convert a 'Statement' to a runnable 'Hasql.Statement', processing the
-- result of the statement as a 'Vector' of rows.
runVector :: Serializable exprs a
  => Statement (Query exprs) -> Hasql.Statement () (Vector a)
runVector :: forall exprs a.
Serializable exprs a =>
Statement (Query exprs) -> Statement () (Vector a)
runVector = Rows (Query exprs) (Vector a)
-> Statement (Query exprs) -> Statement () (Vector a)
forall exprs a. Rows exprs a -> Statement exprs -> Statement () a
makeRun Rows (Query exprs) (Vector a)
forall exprs a.
Serializable exprs a =>
Rows (Query exprs) (Vector a)
Vector