{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StrictData #-}

{- |
Module      : Database.DuckDB.Simple.Internal
Description : Internal machinery backing the duckdb-simple API surface.

This module provides access to the opaque data constructors and helper
utilities required by the high-level API.  It is not part of the supported
public interface; consumers should depend on 'Database.DuckDB.Simple' instead.
-}
module Database.DuckDB.Simple.Internal (
    -- * Data constructors (internal use only)
    Query (..),
    Connection (..),
    ConnectionState (..),
    Statement (..),
    StatementState (..),
    StatementStreamState (..),
    StatementStream (..),
    StatementStreamColumn (..),
    StatementStreamChunk (..),
    StatementStreamChunkVector (..),
    SQLError (..),
    toSQLError,

    -- * Helpers
    connectionClosedError,
    statementClosedError,
    withConnectionHandle,
    withStatementHandle,
    withQueryCString,
) where

import Control.Exception (Exception, throwIO)
import Data.IORef (IORef, readIORef)
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Foreign as TextForeign
import Data.Word (Word64)
import Database.DuckDB.FFI (
    DuckDBDataChunk,
    DuckDBConnection,
    DuckDBDatabase,
    DuckDBErrorType,
    DuckDBPreparedStatement,
    DuckDBResult,
    DuckDBType,
    DuckDBVector,
 )
import Foreign.C.String (CString)
import Foreign.Ptr (Ptr)

-- | Represents a textual SQL query with UTF-8 encoding semantics.
newtype Query = Query
    { Query -> Text
fromQuery :: Text
    -- ^ Extract the underlying textual representation of the query.
    }
    deriving stock (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
/= :: Query -> Query -> Bool
Eq, Eq Query
Eq Query =>
(Query -> Query -> Ordering)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Query)
-> (Query -> Query -> Query)
-> Ord Query
Query -> Query -> Bool
Query -> Query -> Ordering
Query -> Query -> Query
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Query -> Query -> Ordering
compare :: Query -> Query -> Ordering
$c< :: Query -> Query -> Bool
< :: Query -> Query -> Bool
$c<= :: Query -> Query -> Bool
<= :: Query -> Query -> Bool
$c> :: Query -> Query -> Bool
> :: Query -> Query -> Bool
$c>= :: Query -> Query -> Bool
>= :: Query -> Query -> Bool
$cmax :: Query -> Query -> Query
max :: Query -> Query -> Query
$cmin :: Query -> Query -> Query
min :: Query -> Query -> Query
Ord, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> String
show :: Query -> String
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Show)

instance Semigroup Query where
    Query Text
a <> :: Query -> Query -> Query
<> Query Text
b = Text -> Query
Query (Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b)

instance IsString Query where
    fromString :: String -> Query
fromString = Text -> Query
Query (Text -> Query) -> (String -> Text) -> String -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Tracks the lifetime of a DuckDB database and connection pair.
newtype Connection = Connection { Connection -> IORef ConnectionState
connectionState :: IORef ConnectionState }

-- | Internal connection lifecycle state.
data ConnectionState
    = ConnectionClosed
    | ConnectionOpen
        { ConnectionState -> DuckDBDatabase
connectionDatabase :: DuckDBDatabase
        , ConnectionState -> DuckDBConnection
connectionHandle :: DuckDBConnection
        }

-- | Tracks the lifetime of a prepared statement.
data Statement = Statement
    { Statement -> IORef StatementState
statementState :: IORef StatementState
    , Statement -> Connection
statementConnection :: Connection
    , Statement -> Query
statementQuery :: Query
    , Statement -> IORef StatementStreamState
statementStream :: IORef StatementStreamState
    }

-- | Internal statement lifecycle state.
data StatementState
    = StatementClosed
    | StatementOpen
        { StatementState -> DuckDBPreparedStatement
statementHandle :: DuckDBPreparedStatement
        }

-- | Streaming execution state for prepared statements.
data StatementStreamState
    = StatementStreamIdle
    | StatementStreamActive !StatementStream

-- | Streaming cursor backing an active result set.
data StatementStream = StatementStream
    { StatementStream -> Ptr DuckDBResult
statementStreamResult :: Ptr DuckDBResult
    , StatementStream -> [StatementStreamColumn]
statementStreamColumns :: [StatementStreamColumn]
    , StatementStream -> Maybe StatementStreamChunk
statementStreamChunk :: Maybe StatementStreamChunk
    }

-- | Metadata describing a result column surfaced through streaming.
data StatementStreamColumn = StatementStreamColumn
    { StatementStreamColumn -> Int
statementStreamColumnIndex :: Int
    , StatementStreamColumn -> Text
statementStreamColumnName :: Text
    , StatementStreamColumn -> DuckDBType
statementStreamColumnType :: DuckDBType
    }

-- | Currently loaded data chunk plus iteration cursor.
data StatementStreamChunk = StatementStreamChunk
    { StatementStreamChunk -> DuckDBDataChunk
statementStreamChunkPtr :: DuckDBDataChunk
    , StatementStreamChunk -> Int
statementStreamChunkSize :: Int
    , StatementStreamChunk -> Int
statementStreamChunkIndex :: Int
    , StatementStreamChunk -> [StatementStreamChunkVector]
statementStreamChunkVectors :: [StatementStreamChunkVector]
    }

-- | Raw vector pointers backing a chunk column.
data StatementStreamChunkVector = StatementStreamChunkVector
    { StatementStreamChunkVector -> DuckDBVector
statementStreamChunkVectorHandle :: DuckDBVector
    , StatementStreamChunkVector -> Ptr ()
statementStreamChunkVectorData :: Ptr ()
    , StatementStreamChunkVector -> Ptr Word64
statementStreamChunkVectorValidity :: Ptr Word64
    }

-- | Represents an error reported by DuckDB or by duckdb-simple itself.
data SQLError = SQLError
    { SQLError -> Text
sqlErrorMessage :: Text
    , SQLError -> Maybe DuckDBErrorType
sqlErrorType :: Maybe DuckDBErrorType
    , SQLError -> Maybe Query
sqlErrorQuery :: Maybe Query
    }
    deriving stock (SQLError -> SQLError -> Bool
(SQLError -> SQLError -> Bool)
-> (SQLError -> SQLError -> Bool) -> Eq SQLError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLError -> SQLError -> Bool
== :: SQLError -> SQLError -> Bool
$c/= :: SQLError -> SQLError -> Bool
/= :: SQLError -> SQLError -> Bool
Eq, Int -> SQLError -> ShowS
[SQLError] -> ShowS
SQLError -> String
(Int -> SQLError -> ShowS)
-> (SQLError -> String) -> ([SQLError] -> ShowS) -> Show SQLError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQLError -> ShowS
showsPrec :: Int -> SQLError -> ShowS
$cshow :: SQLError -> String
show :: SQLError -> String
$cshowList :: [SQLError] -> ShowS
showList :: [SQLError] -> ShowS
Show)

instance Exception SQLError

toSQLError :: Exception e => e -> SQLError
toSQLError :: forall e. Exception e => e -> SQLError
toSQLError e
ex = SQLError
    { sqlErrorMessage :: Text
sqlErrorMessage = String -> Text
Text.pack (e -> String
forall a. Show a => a -> String
show e
ex)
    , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
    , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Maybe Query
forall a. Maybe a
Nothing
    }

-- | Shared error value used when an operation targets a closed connection.
connectionClosedError :: SQLError
connectionClosedError :: SQLError
connectionClosedError =
    SQLError
        { sqlErrorMessage :: Text
sqlErrorMessage = String -> Text
Text.pack String
"duckdb-simple: connection is closed"
        , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
        , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Maybe Query
forall a. Maybe a
Nothing
        }

-- | Shared error value used when an operation targets a closed statement.
statementClosedError :: Statement -> SQLError
statementClosedError :: Statement -> SQLError
statementClosedError Statement{Query
statementQuery :: Statement -> Query
statementQuery :: Query
statementQuery} =
    SQLError
        { sqlErrorMessage :: Text
sqlErrorMessage = String -> Text
Text.pack String
"duckdb-simple: statement is closed"
        , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
        , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Query -> Maybe Query
forall a. a -> Maybe a
Just Query
statementQuery
        }

-- | Provide a UTF-8 encoded C string view of the query text.
withQueryCString :: Query -> (CString -> IO a) -> IO a
withQueryCString :: forall a. Query -> (CString -> IO a) -> IO a
withQueryCString (Query Text
txt) = Text -> (CString -> IO a) -> IO a
forall a. Text -> (CString -> IO a) -> IO a
TextForeign.withCString Text
txt

-- | Internal helper for safely accessing the underlying prepared statement.
withStatementHandle :: Statement -> (DuckDBPreparedStatement -> IO a) -> IO a
withStatementHandle :: forall a. Statement -> (DuckDBPreparedStatement -> IO a) -> IO a
withStatementHandle stmt :: Statement
stmt@Statement{IORef StatementState
statementState :: Statement -> IORef StatementState
statementState :: IORef StatementState
statementState} DuckDBPreparedStatement -> IO a
action = do
    StatementState
state <- IORef StatementState -> IO StatementState
forall a. IORef a -> IO a
readIORef IORef StatementState
statementState
    case StatementState
state of
        StatementState
StatementClosed -> SQLError -> IO a
forall e a. Exception e => e -> IO a
throwIO (Statement -> SQLError
statementClosedError Statement
stmt)
        StatementOpen{DuckDBPreparedStatement
statementHandle :: StatementState -> DuckDBPreparedStatement
statementHandle :: DuckDBPreparedStatement
statementHandle} -> DuckDBPreparedStatement -> IO a
action DuckDBPreparedStatement
statementHandle

-- | Internal helper for safely accessing the underlying connection handle.
withConnectionHandle :: Connection -> (DuckDBConnection -> IO a) -> IO a
withConnectionHandle :: forall a. Connection -> (DuckDBConnection -> IO a) -> IO a
withConnectionHandle Connection{IORef ConnectionState
connectionState :: Connection -> IORef ConnectionState
connectionState :: IORef ConnectionState
connectionState} DuckDBConnection -> IO a
action = do
    ConnectionState
state <- IORef ConnectionState -> IO ConnectionState
forall a. IORef a -> IO a
readIORef IORef ConnectionState
connectionState
    case ConnectionState
state of
        ConnectionState
ConnectionClosed -> SQLError -> IO a
forall e a. Exception e => e -> IO a
throwIO SQLError
connectionClosedError
        ConnectionOpen{DuckDBConnection
connectionHandle :: ConnectionState -> DuckDBConnection
connectionHandle :: DuckDBConnection
connectionHandle} -> DuckDBConnection -> IO a
action DuckDBConnection
connectionHandle