{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}

{- |
Module      : Database.DuckDB.Simple.LogicalRep
Description : Structured logical-type and value representations for DuckDB.
-}
module Database.DuckDB.Simple.LogicalRep (
    -- * Structured value helpers
    StructField (..),
    StructValue (..),
    UnionMemberType (..),
    UnionValue (..),
    LogicalTypeRep (..),
    structValueTypeRep,
    unionValueTypeRep,
    logicalTypeToRep,
    logicalTypeFromRep,
    destroyLogicalType,
) where

import Control.Exception (bracket, throwIO)
import Control.Monad (forM, when)
import Data.Array (Array, elems, listArray)
import Data.Map.Strict (Map)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word16, Word64, Word8)
import Database.DuckDB.FFI
import Foreign.C.String (peekCString, withCString)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (withArray)
import Foreign.Marshal.Utils (withMany)
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.Storable (poke)

-- | A Haskell description of a DuckDB logical type tree.
data LogicalTypeRep
    = LogicalTypeScalar DuckDBType
    | LogicalTypeDecimal !Word8 !Word8
    | LogicalTypeList LogicalTypeRep
    | LogicalTypeArray LogicalTypeRep !Word64
    | LogicalTypeMap LogicalTypeRep LogicalTypeRep
    | LogicalTypeStruct !(Array Int (StructField LogicalTypeRep))
    | LogicalTypeUnion !(Array Int UnionMemberType)
    | LogicalTypeEnum !(Array Int Text)
    deriving (LogicalTypeRep -> LogicalTypeRep -> Bool
(LogicalTypeRep -> LogicalTypeRep -> Bool)
-> (LogicalTypeRep -> LogicalTypeRep -> Bool) -> Eq LogicalTypeRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogicalTypeRep -> LogicalTypeRep -> Bool
== :: LogicalTypeRep -> LogicalTypeRep -> Bool
$c/= :: LogicalTypeRep -> LogicalTypeRep -> Bool
/= :: LogicalTypeRep -> LogicalTypeRep -> Bool
Eq, Int -> LogicalTypeRep -> ShowS
[LogicalTypeRep] -> ShowS
LogicalTypeRep -> String
(Int -> LogicalTypeRep -> ShowS)
-> (LogicalTypeRep -> String)
-> ([LogicalTypeRep] -> ShowS)
-> Show LogicalTypeRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicalTypeRep -> ShowS
showsPrec :: Int -> LogicalTypeRep -> ShowS
$cshow :: LogicalTypeRep -> String
show :: LogicalTypeRep -> String
$cshowList :: [LogicalTypeRep] -> ShowS
showList :: [LogicalTypeRep] -> ShowS
Show)

-- | A named field within a STRUCT-like value or type.
data StructField a = StructField
    { forall a. StructField a -> Text
structFieldName :: !Text
    , forall a. StructField a -> a
structFieldValue :: !a
    }
    deriving (StructField a -> StructField a -> Bool
(StructField a -> StructField a -> Bool)
-> (StructField a -> StructField a -> Bool) -> Eq (StructField a)
forall a. Eq a => StructField a -> StructField a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => StructField a -> StructField a -> Bool
== :: StructField a -> StructField a -> Bool
$c/= :: forall a. Eq a => StructField a -> StructField a -> Bool
/= :: StructField a -> StructField a -> Bool
Eq, Int -> StructField a -> ShowS
[StructField a] -> ShowS
StructField a -> String
(Int -> StructField a -> ShowS)
-> (StructField a -> String)
-> ([StructField a] -> ShowS)
-> Show (StructField a)
forall a. Show a => Int -> StructField a -> ShowS
forall a. Show a => [StructField a] -> ShowS
forall a. Show a => StructField a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> StructField a -> ShowS
showsPrec :: Int -> StructField a -> ShowS
$cshow :: forall a. Show a => StructField a -> String
show :: StructField a -> String
$cshowList :: forall a. Show a => [StructField a] -> ShowS
showList :: [StructField a] -> ShowS
Show)

-- | A fully materialized STRUCT value together with its type metadata.
data StructValue a = StructValue
    { forall a. StructValue a -> Array Int (StructField a)
structValueFields :: !(Array Int (StructField a))
    , forall a. StructValue a -> Array Int (StructField LogicalTypeRep)
structValueTypes :: !(Array Int (StructField LogicalTypeRep))
    , forall a. StructValue a -> Map Text Int
structValueIndex :: !(Map Text Int)
    }
    deriving (StructValue a -> StructValue a -> Bool
(StructValue a -> StructValue a -> Bool)
-> (StructValue a -> StructValue a -> Bool) -> Eq (StructValue a)
forall a. Eq a => StructValue a -> StructValue a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => StructValue a -> StructValue a -> Bool
== :: StructValue a -> StructValue a -> Bool
$c/= :: forall a. Eq a => StructValue a -> StructValue a -> Bool
/= :: StructValue a -> StructValue a -> Bool
Eq, Int -> StructValue a -> ShowS
[StructValue a] -> ShowS
StructValue a -> String
(Int -> StructValue a -> ShowS)
-> (StructValue a -> String)
-> ([StructValue a] -> ShowS)
-> Show (StructValue a)
forall a. Show a => Int -> StructValue a -> ShowS
forall a. Show a => [StructValue a] -> ShowS
forall a. Show a => StructValue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> StructValue a -> ShowS
showsPrec :: Int -> StructValue a -> ShowS
$cshow :: forall a. Show a => StructValue a -> String
show :: StructValue a -> String
$cshowList :: forall a. Show a => [StructValue a] -> ShowS
showList :: [StructValue a] -> ShowS
Show)

-- | A named member within a UNION type.
data UnionMemberType = UnionMemberType
    { UnionMemberType -> Text
unionMemberName :: !Text
    , UnionMemberType -> LogicalTypeRep
unionMemberType :: !LogicalTypeRep
    }
    deriving (UnionMemberType -> UnionMemberType -> Bool
(UnionMemberType -> UnionMemberType -> Bool)
-> (UnionMemberType -> UnionMemberType -> Bool)
-> Eq UnionMemberType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnionMemberType -> UnionMemberType -> Bool
== :: UnionMemberType -> UnionMemberType -> Bool
$c/= :: UnionMemberType -> UnionMemberType -> Bool
/= :: UnionMemberType -> UnionMemberType -> Bool
Eq, Int -> UnionMemberType -> ShowS
[UnionMemberType] -> ShowS
UnionMemberType -> String
(Int -> UnionMemberType -> ShowS)
-> (UnionMemberType -> String)
-> ([UnionMemberType] -> ShowS)
-> Show UnionMemberType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnionMemberType -> ShowS
showsPrec :: Int -> UnionMemberType -> ShowS
$cshow :: UnionMemberType -> String
show :: UnionMemberType -> String
$cshowList :: [UnionMemberType] -> ShowS
showList :: [UnionMemberType] -> ShowS
Show)

-- | A fully materialized UNION value together with its member metadata.
data UnionValue a = UnionValue
    { forall a. UnionValue a -> Word16
unionValueIndex :: !Word16
    , forall a. UnionValue a -> Text
unionValueLabel :: !Text
    , forall a. UnionValue a -> a
unionValuePayload :: !a
    , forall a. UnionValue a -> Array Int UnionMemberType
unionValueMembers :: !(Array Int UnionMemberType)
    }
    deriving (UnionValue a -> UnionValue a -> Bool
(UnionValue a -> UnionValue a -> Bool)
-> (UnionValue a -> UnionValue a -> Bool) -> Eq (UnionValue a)
forall a. Eq a => UnionValue a -> UnionValue a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => UnionValue a -> UnionValue a -> Bool
== :: UnionValue a -> UnionValue a -> Bool
$c/= :: forall a. Eq a => UnionValue a -> UnionValue a -> Bool
/= :: UnionValue a -> UnionValue a -> Bool
Eq, Int -> UnionValue a -> ShowS
[UnionValue a] -> ShowS
UnionValue a -> String
(Int -> UnionValue a -> ShowS)
-> (UnionValue a -> String)
-> ([UnionValue a] -> ShowS)
-> Show (UnionValue a)
forall a. Show a => Int -> UnionValue a -> ShowS
forall a. Show a => [UnionValue a] -> ShowS
forall a. Show a => UnionValue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> UnionValue a -> ShowS
showsPrec :: Int -> UnionValue a -> ShowS
$cshow :: forall a. Show a => UnionValue a -> String
show :: UnionValue a -> String
$cshowList :: forall a. Show a => [UnionValue a] -> ShowS
showList :: [UnionValue a] -> ShowS
Show)

-- | Recover the logical STRUCT type corresponding to a @StructValue@.
structValueTypeRep :: StructValue a -> LogicalTypeRep
structValueTypeRep :: forall a. StructValue a -> LogicalTypeRep
structValueTypeRep StructValue{Array Int (StructField LogicalTypeRep)
structValueTypes :: forall a. StructValue a -> Array Int (StructField LogicalTypeRep)
structValueTypes :: Array Int (StructField LogicalTypeRep)
structValueTypes} = Array Int (StructField LogicalTypeRep) -> LogicalTypeRep
LogicalTypeStruct Array Int (StructField LogicalTypeRep)
structValueTypes

-- | Recover the logical UNION type corresponding to a @UnionValue@.
unionValueTypeRep :: UnionValue a -> LogicalTypeRep
unionValueTypeRep :: forall a. UnionValue a -> LogicalTypeRep
unionValueTypeRep UnionValue{Array Int UnionMemberType
unionValueMembers :: forall a. UnionValue a -> Array Int UnionMemberType
unionValueMembers :: Array Int UnionMemberType
unionValueMembers} = Array Int UnionMemberType -> LogicalTypeRep
LogicalTypeUnion Array Int UnionMemberType
unionValueMembers

-- | Destroy a logical type handle obtained from DuckDB.
destroyLogicalType :: DuckDBLogicalType -> IO ()
destroyLogicalType :: DuckDBLogicalType -> IO ()
destroyLogicalType DuckDBLogicalType
logical =
    (Ptr DuckDBLogicalType -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DuckDBLogicalType
ptr -> do
        Ptr DuckDBLogicalType -> DuckDBLogicalType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DuckDBLogicalType
ptr DuckDBLogicalType
logical
        Ptr DuckDBLogicalType -> IO ()
c_duckdb_destroy_logical_type Ptr DuckDBLogicalType
ptr

-- | Convert a DuckDB logical type handle into the pure @LogicalTypeRep@ tree.
logicalTypeToRep :: DuckDBLogicalType -> IO LogicalTypeRep
logicalTypeToRep :: DuckDBLogicalType -> IO LogicalTypeRep
logicalTypeToRep DuckDBLogicalType
logical = do
    dtype <- DuckDBLogicalType -> IO DuckDBType
c_duckdb_get_type_id DuckDBLogicalType
logical
    case dtype of
        DuckDBType
DuckDBTypeStruct -> do
            childCountRaw <- DuckDBLogicalType -> IO Word64
c_duckdb_struct_type_child_count DuckDBLogicalType
logical
            childCount <- word64ToInt (Text.pack "struct child count") childCountRaw
            fields <-
                forM [0 .. childCount - 1] \Int
idx -> do
                    namePtr <- DuckDBLogicalType -> Word64 -> IO CString
c_duckdb_struct_type_child_name DuckDBLogicalType
logical (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx)
                    when (namePtr == nullPtr) $
                        throwIO (userError "duckdb-simple: struct child name is null")
                    name <- Text.pack <$> peekCString namePtr
                    c_duckdb_free (castPtr namePtr)
                    childLogical <- c_duckdb_struct_type_child_type logical (fromIntegral idx)
                    childRep <-
                        bracket (pure childLogical) destroyLogicalType logicalTypeToRep
                    pure StructField{structFieldName = name, structFieldValue = childRep}
            pure $
                LogicalTypeStruct
                    ( if childCount <= 0
                        then listArray (0, -1) []
                        else listArray (0, childCount - 1) fields
                    )
        DuckDBType
DuckDBTypeUnion -> do
            memberCountRaw <- DuckDBLogicalType -> IO Word64
c_duckdb_union_type_member_count DuckDBLogicalType
logical
            memberCount <- word64ToInt (Text.pack "union member count") memberCountRaw
            members <-
                forM [0 .. memberCount - 1] \Int
idx -> do
                    namePtr <- DuckDBLogicalType -> Word64 -> IO CString
c_duckdb_union_type_member_name DuckDBLogicalType
logical (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx)
                    when (namePtr == nullPtr) $
                        throwIO (userError "duckdb-simple: union member name is null")
                    name <- Text.pack <$> peekCString namePtr
                    c_duckdb_free (castPtr namePtr)
                    memberLogical <- c_duckdb_union_type_member_type logical (fromIntegral idx)
                    memberRep <-
                        bracket (pure memberLogical) destroyLogicalType logicalTypeToRep
                    pure UnionMemberType{unionMemberName = name, unionMemberType = memberRep}
            pure $
                LogicalTypeUnion
                    ( if memberCount <= 0
                        then listArray (0, -1) []
                        else listArray (0, memberCount - 1) members
                    )
        DuckDBType
DuckDBTypeList -> do
            childLogical <- DuckDBLogicalType -> IO DuckDBLogicalType
c_duckdb_list_type_child_type DuckDBLogicalType
logical
            childRep <- bracket (pure childLogical) destroyLogicalType logicalTypeToRep
            pure (LogicalTypeList childRep)
        DuckDBType
DuckDBTypeArray -> do
            childLogical <- DuckDBLogicalType -> IO DuckDBLogicalType
c_duckdb_array_type_child_type DuckDBLogicalType
logical
            childRep <- bracket (pure childLogical) destroyLogicalType logicalTypeToRep
            size <- c_duckdb_array_type_array_size logical
            pure (LogicalTypeArray childRep size)
        DuckDBType
DuckDBTypeMap -> do
            keyLogical <- DuckDBLogicalType -> IO DuckDBLogicalType
c_duckdb_map_type_key_type DuckDBLogicalType
logical
            valueLogical <- c_duckdb_map_type_value_type logical
            keyRep <- bracket (pure keyLogical) destroyLogicalType logicalTypeToRep
            valueRep <- bracket (pure valueLogical) destroyLogicalType logicalTypeToRep
            pure (LogicalTypeMap keyRep valueRep)
        DuckDBType
DuckDBTypeDecimal -> do
            width <- DuckDBLogicalType -> IO Word8
c_duckdb_decimal_width DuckDBLogicalType
logical
            scale <- c_duckdb_decimal_scale logical
            pure (LogicalTypeDecimal width scale)
        DuckDBType
DuckDBTypeEnum -> do
            dictSize <- DuckDBLogicalType -> IO Word32
c_duckdb_enum_dictionary_size DuckDBLogicalType
logical
            let count = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dictSize :: Int
            entries <-
                forM [0 .. count - 1] \Int
idx -> do
                    entryPtr <- DuckDBLogicalType -> Word64 -> IO CString
c_duckdb_enum_dictionary_value DuckDBLogicalType
logical (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx)
                    when (entryPtr == nullPtr) $
                        throwIO (userError "duckdb-simple: enum dictionary value is null")
                    entry <- Text.pack <$> peekCString entryPtr
                    c_duckdb_free (castPtr entryPtr)
                    pure entry
            pure $
                LogicalTypeEnum
                    ( if count <= 0
                        then listArray (0, -1) []
                        else listArray (0, count - 1) entries
                    )
        DuckDBType
_ ->
            LogicalTypeRep -> IO LogicalTypeRep
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DuckDBType -> LogicalTypeRep
LogicalTypeScalar DuckDBType
dtype)

-- | Materialize a DuckDB logical type handle from a @LogicalTypeRep@ tree.
logicalTypeFromRep :: LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep :: LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep = \case
    LogicalTypeScalar DuckDBType
dtype ->
        DuckDBType -> IO DuckDBLogicalType
c_duckdb_create_logical_type DuckDBType
dtype
    LogicalTypeDecimal Word8
width Word8
scale ->
        Word8 -> Word8 -> IO DuckDBLogicalType
c_duckdb_create_decimal_type Word8
width Word8
scale
    LogicalTypeList LogicalTypeRep
elemRep ->
        IO DuckDBLogicalType
-> (DuckDBLogicalType -> IO ())
-> (DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep LogicalTypeRep
elemRep) DuckDBLogicalType -> IO ()
destroyLogicalType DuckDBLogicalType -> IO DuckDBLogicalType
c_duckdb_create_list_type
    LogicalTypeArray LogicalTypeRep
elemRep Word64
size ->
        IO DuckDBLogicalType
-> (DuckDBLogicalType -> IO ())
-> (DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep LogicalTypeRep
elemRep) DuckDBLogicalType -> IO ()
destroyLogicalType ((DuckDBLogicalType -> IO DuckDBLogicalType)
 -> IO DuckDBLogicalType)
-> (DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b. (a -> b) -> a -> b
$
            (DuckDBLogicalType -> Word64 -> IO DuckDBLogicalType)
-> Word64 -> DuckDBLogicalType -> IO DuckDBLogicalType
forall a b c. (a -> b -> c) -> b -> a -> c
flip DuckDBLogicalType -> Word64 -> IO DuckDBLogicalType
c_duckdb_create_array_type Word64
size
    LogicalTypeMap LogicalTypeRep
keyRep LogicalTypeRep
valueRep ->
        IO DuckDBLogicalType
-> (DuckDBLogicalType -> IO ())
-> (DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep LogicalTypeRep
keyRep) DuckDBLogicalType -> IO ()
destroyLogicalType \DuckDBLogicalType
keyType ->
            IO DuckDBLogicalType
-> (DuckDBLogicalType -> IO ())
-> (DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep LogicalTypeRep
valueRep) DuckDBLogicalType -> IO ()
destroyLogicalType ((DuckDBLogicalType -> IO DuckDBLogicalType)
 -> IO DuckDBLogicalType)
-> (DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b. (a -> b) -> a -> b
$
                DuckDBLogicalType -> DuckDBLogicalType -> IO DuckDBLogicalType
c_duckdb_create_map_type DuckDBLogicalType
keyType
    LogicalTypeStruct Array Int (StructField LogicalTypeRep)
fieldArray -> do
        let fields :: [StructField LogicalTypeRep]
fields = Array Int (StructField LogicalTypeRep)
-> [StructField LogicalTypeRep]
forall i e. Array i e -> [e]
elems Array Int (StructField LogicalTypeRep)
fieldArray
            count :: Int
count = [StructField LogicalTypeRep] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StructField LogicalTypeRep]
fields
        if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then (String
 -> (CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType)
-> [String]
-> ([CString] -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany String -> (CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a. String -> (CString -> IO a) -> IO a
withCString [] \[CString]
namePtrs ->
                [CString]
-> (Ptr CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CString]
namePtrs \Ptr CString
nameArray ->
                    [DuckDBLogicalType]
-> (Ptr DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [] \Ptr DuckDBLogicalType
typeArray ->
                        Ptr DuckDBLogicalType
-> Ptr CString -> Word64 -> IO DuckDBLogicalType
c_duckdb_create_struct_type Ptr DuckDBLogicalType
typeArray Ptr CString
nameArray Word64
0
            else do
                childTypes <- (StructField LogicalTypeRep -> IO DuckDBLogicalType)
-> [StructField LogicalTypeRep] -> IO [DuckDBLogicalType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep (LogicalTypeRep -> IO DuckDBLogicalType)
-> (StructField LogicalTypeRep -> LogicalTypeRep)
-> StructField LogicalTypeRep
-> IO DuckDBLogicalType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructField LogicalTypeRep -> LogicalTypeRep
forall a. StructField a -> a
structFieldValue) [StructField LogicalTypeRep]
fields
                let names = (StructField LogicalTypeRep -> String)
-> [StructField LogicalTypeRep] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
Text.unpack (Text -> String)
-> (StructField LogicalTypeRep -> Text)
-> StructField LogicalTypeRep
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructField LogicalTypeRep -> Text
forall a. StructField a -> Text
structFieldName) [StructField LogicalTypeRep]
fields
                result <-
                    withMany withCString names \[CString]
namePtrs ->
                        [CString]
-> (Ptr CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CString]
namePtrs \Ptr CString
nameArray ->
                            [DuckDBLogicalType]
-> (Ptr DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [DuckDBLogicalType]
childTypes \Ptr DuckDBLogicalType
typeArray ->
                                Ptr DuckDBLogicalType
-> Ptr CString -> Word64 -> IO DuckDBLogicalType
c_duckdb_create_struct_type Ptr DuckDBLogicalType
typeArray Ptr CString
nameArray (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)
                mapM_ destroyLogicalType childTypes
                pure result
    LogicalTypeUnion Array Int UnionMemberType
memberArray -> do
        let members :: [UnionMemberType]
members = Array Int UnionMemberType -> [UnionMemberType]
forall i e. Array i e -> [e]
elems Array Int UnionMemberType
memberArray
            count :: Int
count = [UnionMemberType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UnionMemberType]
members
        if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then (String
 -> (CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType)
-> [String]
-> ([CString] -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany String -> (CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a. String -> (CString -> IO a) -> IO a
withCString [] \[CString]
namePtrs ->
                [CString]
-> (Ptr CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CString]
namePtrs \Ptr CString
nameArray ->
                    [DuckDBLogicalType]
-> (Ptr DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [] \Ptr DuckDBLogicalType
memberPtr ->
                        Ptr DuckDBLogicalType
-> Ptr CString -> Word64 -> IO DuckDBLogicalType
c_duckdb_create_union_type Ptr DuckDBLogicalType
memberPtr Ptr CString
nameArray Word64
0
            else do
                memberTypes <- (UnionMemberType -> IO DuckDBLogicalType)
-> [UnionMemberType] -> IO [DuckDBLogicalType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LogicalTypeRep -> IO DuckDBLogicalType
logicalTypeFromRep (LogicalTypeRep -> IO DuckDBLogicalType)
-> (UnionMemberType -> LogicalTypeRep)
-> UnionMemberType
-> IO DuckDBLogicalType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMemberType -> LogicalTypeRep
unionMemberType) [UnionMemberType]
members
                let names = (UnionMemberType -> String) -> [UnionMemberType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
Text.unpack (Text -> String)
-> (UnionMemberType -> Text) -> UnionMemberType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMemberType -> Text
unionMemberName) [UnionMemberType]
members
                result <-
                    withMany withCString names \[CString]
namePtrs ->
                        [CString]
-> (Ptr CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CString]
namePtrs \Ptr CString
nameArray ->
                            [DuckDBLogicalType]
-> (Ptr DuckDBLogicalType -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [DuckDBLogicalType]
memberTypes \Ptr DuckDBLogicalType
memberPtr ->
                                Ptr DuckDBLogicalType
-> Ptr CString -> Word64 -> IO DuckDBLogicalType
c_duckdb_create_union_type Ptr DuckDBLogicalType
memberPtr Ptr CString
nameArray (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)
                mapM_ destroyLogicalType memberTypes
                pure result
    LogicalTypeEnum Array Int Text
dictArray -> do
        let entries :: [Text]
entries = Array Int Text -> [Text]
forall i e. Array i e -> [e]
elems Array Int Text
dictArray
            count :: Int
count = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
entries
        if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Ptr CString -> Word64 -> IO DuckDBLogicalType
c_duckdb_create_enum_type Ptr CString
forall a. Ptr a
nullPtr Word64
0
            else (String
 -> (CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType)
-> [String]
-> ([CString] -> IO DuckDBLogicalType)
-> IO DuckDBLogicalType
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany String -> (CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a. String -> (CString -> IO a) -> IO a
withCString ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Text.unpack [Text]
entries) \[CString]
namePtrs ->
                [CString]
-> (Ptr CString -> IO DuckDBLogicalType) -> IO DuckDBLogicalType
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CString]
namePtrs \Ptr CString
nameArray ->
                    Ptr CString -> Word64 -> IO DuckDBLogicalType
c_duckdb_create_enum_type Ptr CString
nameArray (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count)

word64ToInt :: Text -> Word64 -> IO Int
word64ToInt :: Text -> Word64 -> IO Int
word64ToInt Text
label Word64
value =
    let actual :: Integer
actual = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
value
        limit :: Integer
limit = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
     in if Integer
actual Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
limit
            then Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value)
            else
                IOError -> IO Int
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO
                    ( String -> IOError
userError
                        ( String
"duckdb-simple: "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
label
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" exceeds Int range"
                        )
                    )