module Database.DuckDB.Connection
    ( -- * Error reporting
      DuckDBError
    , isDuckDBError

      -- * Monad
    , DuckDBMonad (..)
    , liftIO
    , liftIOEither
    , runDuckDB

      -- * Version
    , version

      -- * Database and Connection
    , open
    , configure
    , configCount
    , getConfigFlag
    , setConfig
    , destroyConfig
    , openExt
    , connect
    , defaultConnection
    , withDefaultConnection
    , close
    , closeConnection
    , closeDatabase
    )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Database.DuckDB.Internal
import Database.DuckDB.Internal.FFI
    ( DuckDBConfig
    , DuckDBConnection
    , DuckDBDatabase
    )
import Database.DuckDB.Internal.FFI qualified as FFI
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Storable

open :: String -> DuckDBMonad DuckDBDatabase
open :: String -> DuckDBMonad DuckDBDatabase
open String
path = do
    DuckDBDatabase
db <- forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
path forall a b. (a -> b) -> a -> b
$ \CString
path' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBDatabase
db' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
            DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CString -> Ptr DuckDBDatabase -> IO DuckDBState
FFI.duckdb_open CString
path' Ptr DuckDBDatabase
db'
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
                forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_open failed"
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr DuckDBDatabase
db'
    forall (m :: * -> *) a. Monad m => a -> m a
return DuckDBDatabase
db

configure :: DuckDBMonad DuckDBConfig
configure :: DuckDBMonad DuckDBConfig
configure = do
    DuckDBConfig
config <- forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBConfig
config' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Ptr DuckDBConfig -> IO DuckDBState
FFI.duckdb_create_config Ptr DuckDBConfig
config'
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_create_config failed"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr DuckDBConfig
config'
    forall (m :: * -> *) a. Monad m => a -> m a
return DuckDBConfig
config

configCount :: DuckDBMonad Int
configCount :: DuckDBMonad Int
configCount = do
    CSize
count <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO CSize
FFI.duckdb_config_count
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
count)

getConfigFlag
    :: Int
    -> DuckDBMonad
        ( String
        , -- \^ name
          String
        )
-- \^ description

getConfigFlag :: Int -> DuckDBMonad (String, String)
getConfigFlag Int
index = do
    (String
name, String
description) <- forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
name' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
description' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        DuckDBState
err <-
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CSize -> Ptr CString -> Ptr CString -> IO DuckDBState
FFI.duckdb_get_config_flag (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) Ptr CString
name' Ptr CString
description'
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_config_get_flag failed"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek Ptr CString
name' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Storable a => Ptr a -> IO a
peek Ptr CString
description' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString)
    forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, String
description)

setConfig
    :: DuckDBConfig
    -> String
    -- ^ name
    -> String
    -- ^ option
    -> DuckDBMonad ()
setConfig :: DuckDBConfig -> String -> String -> DuckDBMonad ()
setConfig DuckDBConfig
config String
name String
option = do
    forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
name forall a b. (a -> b) -> a -> b
$ \CString
name' -> forall a. String -> (CString -> IO a) -> IO a
withCString String
option forall a b. (a -> b) -> a -> b
$ \CString
option' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBConfig -> CString -> CString -> IO DuckDBState
FFI.duckdb_set_config DuckDBConfig
config CString
name' CString
option'
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_set_config failed"

destroyConfig :: DuckDBConfig -> DuckDBMonad ()
destroyConfig :: DuckDBConfig -> DuckDBMonad ()
destroyConfig DuckDBConfig
config = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBConfig
config' -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBConfig
config' DuckDBConfig
config
        Ptr DuckDBConfig -> IO ()
FFI.duckdb_destroy_config Ptr DuckDBConfig
config'

openExt :: String -> DuckDBConfig -> DuckDBMonad DuckDBDatabase
openExt :: String -> DuckDBConfig -> DuckDBMonad DuckDBDatabase
openExt String
path DuckDBConfig
config = do
    DuckDBDatabase
db <- forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
path forall a b. (a -> b) -> a -> b
$ \CString
path' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBDatabase
db' ->
            forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CString
err' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
                DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CString
-> Ptr DuckDBDatabase
-> DuckDBConfig
-> Ptr CString
-> IO DuckDBState
FFI.duckdb_open_ext CString
path' Ptr DuckDBDatabase
db' DuckDBConfig
config Ptr CString
err'
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$ do
                    String
message <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                        CString
p <- forall a. Storable a => Ptr a -> IO a
peek Ptr CString
err'
                        String
m <- CString -> IO String
peekCString CString
p
                        forall a. Ptr a -> IO ()
FFI.duckdb_free CString
p
                        forall (m :: * -> *) a. Monad m => a -> m a
return String
m
                    forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"duckdb_open failed: " forall a. [a] -> [a] -> [a]
++ String
message
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr DuckDBDatabase
db'
    forall (m :: * -> *) a. Monad m => a -> m a
return DuckDBDatabase
db

connect :: DuckDBDatabase -> DuckDBMonad DuckDBConnection
connect :: DuckDBDatabase -> DuckDBMonad DuckDBConnection
connect DuckDBDatabase
db = do
    DuckDBConnection
conn <- forall a. IO (Either String a) -> DuckDBMonad a
liftIOEither forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBConnection
conn' -> forall a. DuckDBMonad a -> IO (Either String a)
runDuckDB forall a b. (a -> b) -> a -> b
$ do
        DuckDBState
err <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DuckDBDatabase -> Ptr DuckDBConnection -> IO DuckDBState
FFI.duckdb_connect DuckDBDatabase
db Ptr DuckDBConnection
conn'
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DuckDBState -> Bool
isDuckDBError DuckDBState
err) forall a b. (a -> b) -> a -> b
$
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"duckdb_connect failed"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr DuckDBConnection
conn'
    forall (m :: * -> *) a. Monad m => a -> m a
return DuckDBConnection
conn

defaultConnection :: DuckDBMonad (DuckDBDatabase, DuckDBConnection)
defaultConnection :: DuckDBMonad (DuckDBDatabase, DuckDBConnection)
defaultConnection = do
    DuckDBDatabase
db <- String -> DuckDBMonad DuckDBDatabase
open String
":memory:"
    DuckDBConnection
conn <- DuckDBDatabase -> DuckDBMonad DuckDBConnection
connect DuckDBDatabase
db
    forall (m :: * -> *) a. Monad m => a -> m a
return (DuckDBDatabase
db, DuckDBConnection
conn)

withDefaultConnection
    :: ((DuckDBDatabase, DuckDBConnection) -> DuckDBMonad a) -> DuckDBMonad a
withDefaultConnection :: forall a.
((DuckDBDatabase, DuckDBConnection) -> DuckDBMonad a)
-> DuckDBMonad a
withDefaultConnection (DuckDBDatabase, DuckDBConnection) -> DuckDBMonad a
f = do
    (DuckDBDatabase
db, DuckDBConnection
conn) <- DuckDBMonad (DuckDBDatabase, DuckDBConnection)
defaultConnection
    a
r <- (DuckDBDatabase, DuckDBConnection) -> DuckDBMonad a
f (DuckDBDatabase
db, DuckDBConnection
conn)
    (DuckDBDatabase, DuckDBConnection) -> DuckDBMonad ()
close (DuckDBDatabase
db, DuckDBConnection
conn)
    forall (m :: * -> *) a. Monad m => a -> m a
return a
r

close :: (DuckDBDatabase, DuckDBConnection) -> DuckDBMonad ()
close :: (DuckDBDatabase, DuckDBConnection) -> DuckDBMonad ()
close (DuckDBDatabase
db, DuckDBConnection
conn) = do
    DuckDBConnection -> DuckDBMonad ()
closeConnection DuckDBConnection
conn
    DuckDBDatabase -> DuckDBMonad ()
closeDatabase DuckDBDatabase
db

closeConnection :: DuckDBConnection -> DuckDBMonad ()
closeConnection :: DuckDBConnection -> DuckDBMonad ()
closeConnection DuckDBConnection
conn = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBConnection
conn' -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBConnection
conn' DuckDBConnection
conn
        Ptr DuckDBConnection -> IO ()
FFI.duckdb_disconnect Ptr DuckDBConnection
conn'

closeDatabase :: DuckDBDatabase -> DuckDBMonad ()
closeDatabase :: DuckDBDatabase -> DuckDBMonad ()
closeDatabase DuckDBDatabase
db = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr DuckDBDatabase
db' -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBDatabase
db' DuckDBDatabase
db
        Ptr DuckDBDatabase -> IO ()
FFI.duckdb_close Ptr DuckDBDatabase
db'