{-# LANGUAGE BlockArguments #-}

{- |
Module      : Database.DuckDB.Simple.Config
Description : High-level helpers for DuckDB 1.5 configuration inspection.
-}
module Database.DuckDB.Simple.Config (
    ConfigFlag (..),
    ConfigValue (..),
    listConfigFlags,
    getConfigOption,
) where

import Control.Exception (bracket)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Foreign as TextForeign
import Database.DuckDB.FFI
import Database.DuckDB.Simple.Internal (Connection, destroyValue, withClientContext)
import Foreign.C.String (peekCString)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.Storable (peek, poke)

-- | Static metadata describing a known DuckDB configuration flag.
data ConfigFlag = ConfigFlag
    { ConfigFlag -> Text
configFlagName :: !Text
    , ConfigFlag -> Text
configFlagDescription :: !Text
    }
    deriving (ConfigFlag -> ConfigFlag -> Bool
(ConfigFlag -> ConfigFlag -> Bool)
-> (ConfigFlag -> ConfigFlag -> Bool) -> Eq ConfigFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigFlag -> ConfigFlag -> Bool
== :: ConfigFlag -> ConfigFlag -> Bool
$c/= :: ConfigFlag -> ConfigFlag -> Bool
/= :: ConfigFlag -> ConfigFlag -> Bool
Eq, Int -> ConfigFlag -> ShowS
[ConfigFlag] -> ShowS
ConfigFlag -> String
(Int -> ConfigFlag -> ShowS)
-> (ConfigFlag -> String)
-> ([ConfigFlag] -> ShowS)
-> Show ConfigFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigFlag -> ShowS
showsPrec :: Int -> ConfigFlag -> ShowS
$cshow :: ConfigFlag -> String
show :: ConfigFlag -> String
$cshowList :: [ConfigFlag] -> ShowS
showList :: [ConfigFlag] -> ShowS
Show)

-- | The current value of a configuration option plus its scope, when available.
data ConfigValue = ConfigValue
    { ConfigValue -> Text
configValueText :: !Text
    , ConfigValue -> Maybe DuckDBConfigOptionScope
configValueScope :: !(Maybe DuckDBConfigOptionScope)
    }
    deriving (ConfigValue -> ConfigValue -> Bool
(ConfigValue -> ConfigValue -> Bool)
-> (ConfigValue -> ConfigValue -> Bool) -> Eq ConfigValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigValue -> ConfigValue -> Bool
== :: ConfigValue -> ConfigValue -> Bool
$c/= :: ConfigValue -> ConfigValue -> Bool
/= :: ConfigValue -> ConfigValue -> Bool
Eq, Int -> ConfigValue -> ShowS
[ConfigValue] -> ShowS
ConfigValue -> String
(Int -> ConfigValue -> ShowS)
-> (ConfigValue -> String)
-> ([ConfigValue] -> ShowS)
-> Show ConfigValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigValue -> ShowS
showsPrec :: Int -> ConfigValue -> ShowS
$cshow :: ConfigValue -> String
show :: ConfigValue -> String
$cshowList :: [ConfigValue] -> ShowS
showList :: [ConfigValue] -> ShowS
Show)

-- | List all configuration flags known to the linked DuckDB runtime.
listConfigFlags :: IO [ConfigFlag]
listConfigFlags :: IO [ConfigFlag]
listConfigFlags = do
    count <- IO CSize
c_duckdb_config_count
    let indices = [Int
0 .. CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] :: [Int]
    mapM fetchFlag indices
  where
    fetchFlag :: a -> IO ConfigFlag
fetchFlag a
idx =
        (Ptr CString -> IO ConfigFlag) -> IO ConfigFlag
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CString
namePtr ->
            (Ptr CString -> IO ConfigFlag) -> IO ConfigFlag
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CString
descPtr -> do
                rc <- CSize -> Ptr CString -> Ptr CString -> IO DuckDBState
c_duckdb_get_config_flag (a -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
idx) Ptr CString
namePtr Ptr CString
descPtr
                if rc /= DuckDBSuccess
                    then pure ConfigFlag{configFlagName = Text.pack (show idx), configFlagDescription = Text.pack ""}
                    else do
                        name <- peek namePtr >>= peekCString
                        description <- peek descPtr >>= peekCString
                        pure ConfigFlag{configFlagName = Text.pack name, configFlagDescription = Text.pack description}

-- | Read a configuration option from a live connection's client context.
getConfigOption :: Connection -> Text -> IO (Maybe ConfigValue)
getConfigOption :: Connection -> Text -> IO (Maybe ConfigValue)
getConfigOption Connection
conn Text
name =
    Connection
-> (DuckDBClientContext -> IO (Maybe ConfigValue))
-> IO (Maybe ConfigValue)
forall a. Connection -> (DuckDBClientContext -> IO a) -> IO a
withClientContext Connection
conn \DuckDBClientContext
ctx ->
        Text
-> (CString -> IO (Maybe ConfigValue)) -> IO (Maybe ConfigValue)
forall a. Text -> (CString -> IO a) -> IO a
TextForeign.withCString Text
name \CString
cName ->
            (Ptr DuckDBConfigOptionScope -> IO (Maybe ConfigValue))
-> IO (Maybe ConfigValue)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBConfigOptionScope
scopePtr -> do
                Ptr DuckDBConfigOptionScope -> DuckDBConfigOptionScope -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBConfigOptionScope
scopePtr DuckDBConfigOptionScope
DuckDBConfigOptionScopeInvalid
                value <- DuckDBClientContext
-> CString -> Ptr DuckDBConfigOptionScope -> IO DuckDBValue
c_duckdb_client_context_get_config_option DuckDBClientContext
ctx CString
cName Ptr DuckDBConfigOptionScope
scopePtr
                if value == nullPtr
                    then pure Nothing
                    else bracket
                        (pure value)
                        destroyValue
                        \DuckDBValue
duckValue -> do
                            strPtr <- DuckDBValue -> IO CString
c_duckdb_get_varchar DuckDBValue
duckValue
                            rendered <-
                                if strPtr == nullPtr
                                    then pure Text.empty
                                    else do
                                        txt <- Text.pack <$> peekCString strPtr
                                        c_duckdb_free (castPtr strPtr)
                                        pure txt
                            scope <- peek scopePtr
                            pure $
                                Just
                                    ConfigValue
                                        { configValueText = rendered
                                        , configValueScope =
                                            if scope == DuckDBConfigOptionScopeInvalid
                                                then Nothing
                                                else Just scope
                                        }