{-# LANGUAGE BlockArguments #-}

module ValueInterfaceTest (tests) where

import Control.Monad (when, (>=>))
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Word (Word16, Word32, Word64, Word8)
import Database.DuckDB.FFI
import Foreign.C.String (peekCString, peekCStringLen, withCString)
import Foreign.C.Types (CBool (..), CDouble (..), CFloat (..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray, withArray)
import Foreign.Marshal.Utils (with, withMany)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (peek, poke)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))
import Utils (destroyDuckValue, destroyLogicalType, withDuckValue)

tests :: TestTree
tests =
    testGroup
        "Value Interface"
        [ scalarCreatesRoundTrip
        , valueTypeReportsLogicalType
        , collectionValuesRoundTrip
        ]

scalarCreatesRoundTrip :: TestTree
scalarCreatesRoundTrip =
    testCase "scalar value constructors and accessors" $ do
        withDuckValue (c_duckdb_create_bool (CBool 1)) (c_duckdb_get_bool >=> (@?= CBool 1))

        withDuckValue (c_duckdb_create_int8 (-8)) (c_duckdb_get_int8 >=> (@?= (-8 :: Int8)))

        withDuckValue (c_duckdb_create_uint8 250) (c_duckdb_get_uint8 >=> (@?= (250 :: Word8)))

        withDuckValue (c_duckdb_create_int16 (-32000)) (c_duckdb_get_int16 >=> (@?= (-32000 :: Int16)))

        withDuckValue (c_duckdb_create_uint16 65000) (c_duckdb_get_uint16 >=> (@?= (65000 :: Word16)))

        withDuckValue
            (c_duckdb_create_int32 (-2000000000))
            ( c_duckdb_get_int32
                >=> (@?= (-2000000000 :: Int32))
            )

        withDuckValue
            (c_duckdb_create_uint32 4000000000)
            ( c_duckdb_get_uint32
                >=> (@?= (4000000000 :: Word32))
            )

        withDuckValue
            (c_duckdb_create_int64 (-9000000000000000000))
            ( c_duckdb_get_int64
                >=> (@?= (-9000000000000000000 :: Int64))
            )

        withDuckValue
            (c_duckdb_create_uint64 10000000000000000000)
            ( c_duckdb_get_uint64
                >=> (@?= (10000000000000000000 :: Word64))
            )

        alloca \hugePtr -> do
            poke hugePtr DuckDBHugeInt{duckDBHugeIntLower = 123, duckDBHugeIntUpper = -1}
            withDuckValue (c_duckdb_create_hugeint hugePtr) \val ->
                alloca \out -> do
                    c_duckdb_get_hugeint val out
                    peek out >>= (@?= DuckDBHugeInt 123 (-1))

        alloca \uhugePtr -> do
            poke uhugePtr DuckDBUHugeInt{duckDBUHugeIntLower = 321, duckDBUHugeIntUpper = 2}
            withDuckValue (c_duckdb_create_uhugeint uhugePtr) \val ->
                alloca \out -> do
                    c_duckdb_get_uhugeint val out
                    peek out >>= (@?= DuckDBUHugeInt 321 2)

        withArray (map (fromIntegral . fromEnum) "1234") \digitsPtr -> do
            let bignum = DuckDBBignum digitsPtr 4 (CBool 0)
            with bignum \bignumPtr ->
                withDuckValue (c_duckdb_create_bignum bignumPtr) \val ->
                    alloca \outPtr -> do
                        c_duckdb_get_bignum val outPtr
                        DuckDBBignum outData outLen outNeg <- peek outPtr
                        outLen @?= 4
                        outNeg @?= CBool 0
                        peekArray (fromIntegral outLen) outData >>= (@?= map (fromIntegral . fromEnum) "1234")
                        when (outData /= nullPtr) $ c_duckdb_free (castPtr outData)

        let hugeValue = DuckDBHugeInt{duckDBHugeIntLower = 42, duckDBHugeIntUpper = 0}
            decimalValue = DuckDBDecimal{duckDBDecimalWidth = 10, duckDBDecimalScale = 2, duckDBDecimalValue = hugeValue}
        with decimalValue \decimalPtr ->
            withDuckValue (c_duckdb_create_decimal decimalPtr) \val ->
                alloca \out -> do
                    c_duckdb_get_decimal val out
                    DuckDBDecimal{duckDBDecimalWidth = w, duckDBDecimalScale = s, duckDBDecimalValue = v} <- peek out
                    (w, s, v) @?= (10, 2, hugeValue)

        withDuckValue (c_duckdb_create_float (CFloat 1.25)) (c_duckdb_get_float >=> (@?= CFloat 1.25))

        withDuckValue (c_duckdb_create_double (CDouble 2.75)) (c_duckdb_get_double >=> (@?= CDouble 2.75))

        let sampleDate = DuckDBDate 12345
        withDuckValue (c_duckdb_create_date sampleDate) (c_duckdb_get_date >=> (@?= sampleDate))

        let sampleTime = DuckDBTime 987654321
        withDuckValue (c_duckdb_create_time sampleTime) (c_duckdb_get_time >=> (@?= sampleTime))

        let sampleTimeNs = DuckDBTimeNs 876543210
        withDuckValue (c_duckdb_create_time_ns sampleTimeNs) (c_duckdb_get_time_ns >=> (@?= sampleTimeNs))

        let sampleTimeTz = DuckDBTimeTz 5555
        withDuckValue (c_duckdb_create_time_tz_value sampleTimeTz) (c_duckdb_get_time_tz >=> (@?= sampleTimeTz))

        let sampleTimestamp = DuckDBTimestamp 444444
        withDuckValue (c_duckdb_create_timestamp sampleTimestamp) (c_duckdb_get_timestamp >=> (@?= sampleTimestamp))

        withDuckValue (c_duckdb_create_timestamp_tz sampleTimestamp) (c_duckdb_get_timestamp_tz >=> (@?= sampleTimestamp))

        let tsSeconds = DuckDBTimestampS 12
        withDuckValue (c_duckdb_create_timestamp_s tsSeconds) (c_duckdb_get_timestamp_s >=> (@?= tsSeconds))

        let tsMillis = DuckDBTimestampMs 12000
        withDuckValue (c_duckdb_create_timestamp_ms tsMillis) (c_duckdb_get_timestamp_ms >=> (@?= tsMillis))

        let tsNanos = DuckDBTimestampNs 12000000
        withDuckValue (c_duckdb_create_timestamp_ns tsNanos) (c_duckdb_get_timestamp_ns >=> (@?= tsNanos))

        let intervalVal = DuckDBInterval{duckDBIntervalMonths = 1, duckDBIntervalDays = 2, duckDBIntervalMicros = 3000}
        with intervalVal \intervalPtr ->
            withDuckValue (c_duckdb_create_interval intervalPtr) \val ->
                alloca \out -> do
                    c_duckdb_get_interval val out
                    peek out >>= (@?= intervalVal)

        let blobBytes = map (fromIntegral . fromEnum) "duckdb-blob"
        withArray blobBytes \blobPtr ->
            withDuckValue (c_duckdb_create_blob blobPtr (fromIntegral (length blobBytes))) \val ->
                alloca \blobOut -> do
                    c_duckdb_get_blob val blobOut
                    DuckDBBlob{duckDBBlobData = datPtr, duckDBBlobSize = size} <- peek blobOut
                    size @?= fromIntegral (length blobBytes)
                    peekArray (fromIntegral size) (castPtr datPtr :: Ptr Word8) >>= (@?= blobBytes)
                    when (datPtr /= nullPtr) $ c_duckdb_free (castPtr datPtr)

        let bitBytes = [0xAA :: Word8]
        withArray bitBytes \bitDataPtr -> do
            let bitVal = DuckDBBit{duckDBBitData = bitDataPtr, duckDBBitSize = 8}
            with bitVal \bitPtr ->
                withDuckValue (c_duckdb_create_bit bitPtr) \val ->
                    alloca \bitOut -> do
                        c_duckdb_get_bit val bitOut
                        DuckDBBit{duckDBBitData = datPtr, duckDBBitSize = size} <- peek bitOut
                        size @?= 8
                        peekArray (fromIntegral ((size + 7) `div` 8)) datPtr >>= (@?= bitBytes)
                        when (datPtr /= nullPtr) $ c_duckdb_free (castPtr datPtr)

        let uuidValue = DuckDBUHugeInt{duckDBUHugeIntLower = 0x0011223344556677, duckDBUHugeIntUpper = 0x8899aabbccddeeff}
        with uuidValue \uuidPtr ->
            withDuckValue (c_duckdb_create_uuid uuidPtr) \val ->
                alloca \out -> do
                    c_duckdb_get_uuid val out
                    peek out >>= (@?= uuidValue)

        withCString "varchar literal" \str ->
            withDuckValue (c_duckdb_create_varchar str) \val -> do
                cPtr <- c_duckdb_get_varchar val
                peekCString cPtr >>= (@?= "varchar literal")
                c_duckdb_free (castPtr cPtr)

        let lenString = "hello\0world"
        withCString lenString \cStr -> do
            let byteLen = fromIntegral (length lenString)
            withDuckValue (c_duckdb_create_varchar_length cStr byteLen) \val -> do
                cPtr <- c_duckdb_get_varchar val
                peekCStringLen (cPtr, length "hello") >>= (@?= "hello")
                c_duckdb_free (castPtr cPtr)

        withDuckValue c_duckdb_create_null_value \val -> do
            c_duckdb_is_null_value val >>= (@?= CBool 1)
            strPtr <- c_duckdb_value_to_string val
            peekCString strPtr >>= (@?= "NULL")
            c_duckdb_free (castPtr strPtr)

valueTypeReportsLogicalType :: TestTree
valueTypeReportsLogicalType =
    testCase "value type identifiers track constructors" $ do
        withDuckValue (c_duckdb_create_int32 42) \intVal -> do
            intType <- c_duckdb_get_value_type intVal
            c_duckdb_get_type_id intType >>= (@?= DuckDBTypeInteger)

        withDuckValue (withCString "duckdb" c_duckdb_create_varchar) \strVal -> do
            strType <- c_duckdb_get_value_type strVal
            c_duckdb_get_type_id strType >>= (@?= DuckDBTypeVarchar)

        listChild <- c_duckdb_create_logical_type DuckDBTypeInteger
        listLogical <- c_duckdb_create_list_type listChild
        elemVal <- c_duckdb_create_int32 7
        withArray [elemVal] \valuesArray -> do
            let count = fromIntegral (1 :: Int)
            withDuckValue (c_duckdb_create_list_value listChild valuesArray count) \listVal -> do
                listType <- c_duckdb_get_value_type listVal
                c_duckdb_get_type_id listType >>= (@?= DuckDBTypeList)
        destroyDuckValue elemVal
        destroyLogicalType listLogical
        destroyLogicalType listChild

collectionValuesRoundTrip :: TestTree
collectionValuesRoundTrip =
    testCase "list/array/map/struct/enum/union constructors" $ do
        -- List value
        listChild <- c_duckdb_create_logical_type DuckDBTypeInteger
        listLogical <- c_duckdb_create_list_type listChild
        listVal1 <- c_duckdb_create_int32 1
        listVal2 <- c_duckdb_create_int32 2
        withArray [listVal1, listVal2] \listArray -> do
            let entryCount = fromIntegral (2 :: Int) :: DuckDBIdx
            withDuckValue (c_duckdb_create_list_value listChild listArray entryCount) \listVal -> do
                _ <- c_duckdb_get_list_size listVal
                child0 <- c_duckdb_get_list_child listVal 0
                c_duckdb_get_int32 child0 >>= (@?= 1)
                destroyDuckValue child0
                child1 <- c_duckdb_get_list_child listVal 1
                c_duckdb_get_int32 child1 >>= (@?= 2)
                destroyDuckValue child1
                listStr <- c_duckdb_value_to_string listVal
                peekCString listStr >>= (@?= "[1, 2]")
                c_duckdb_free (castPtr listStr)
        destroyDuckValue listVal1
        destroyDuckValue listVal2
        destroyLogicalType listLogical
        destroyLogicalType listChild

        -- Array value
        arrayChild <- c_duckdb_create_logical_type DuckDBTypeInteger
        arrayLogical <- c_duckdb_create_array_type arrayChild 2
        arrVal1 <- c_duckdb_create_int32 7
        arrVal2 <- c_duckdb_create_int32 8
        withArray [arrVal1, arrVal2] \arrArray -> do
            let entryCount = fromIntegral (2 :: Int) :: DuckDBIdx
            withDuckValue (c_duckdb_create_array_value arrayChild arrArray entryCount) \arrVal -> do
                _ <- c_duckdb_get_list_size arrVal
                arrStr <- c_duckdb_value_to_string arrVal
                peekCString arrStr >>= (@?= "[7, 8]")
                c_duckdb_free (castPtr arrStr)
        destroyDuckValue arrVal1
        destroyDuckValue arrVal2
        destroyLogicalType arrayLogical
        destroyLogicalType arrayChild

        -- Map value
        keyType <- c_duckdb_create_logical_type DuckDBTypeVarchar
        valType <- c_duckdb_create_logical_type DuckDBTypeInteger
        mapLogical <- c_duckdb_create_map_type keyType valType
        keyValue <- withCString "key" c_duckdb_create_varchar
        valValue <- c_duckdb_create_int32 99
        withArray [keyValue] \keyArray ->
            withArray [valValue] \valArray -> do
                let entryCount = fromIntegral (1 :: Int) :: DuckDBIdx
                withDuckValue (c_duckdb_create_map_value mapLogical keyArray valArray entryCount) \mapVal -> do
                    c_duckdb_get_map_size mapVal >>= (@?= 1)
                    keyHandle <- c_duckdb_get_map_key mapVal 0
                    keyStrPtr <- c_duckdb_get_varchar keyHandle
                    peekCString keyStrPtr >>= (@?= "key")
                    c_duckdb_free (castPtr keyStrPtr)
                    destroyDuckValue keyHandle
                    valHandle <- c_duckdb_get_map_value mapVal 0
                    c_duckdb_get_int32 valHandle >>= (@?= 99)
                    destroyDuckValue valHandle
        destroyDuckValue keyValue
        destroyDuckValue valValue
        destroyLogicalType mapLogical
        destroyLogicalType keyType
        destroyLogicalType valType

        -- Struct value
        structInt <- c_duckdb_create_logical_type DuckDBTypeInteger
        structText <- c_duckdb_create_logical_type DuckDBTypeVarchar
        structLogical <-
            withMany withCString ["id", "name"] \namePtrs ->
                withArray [structInt, structText] \typeArray ->
                    withArray namePtrs \nameArray ->
                        c_duckdb_create_struct_type typeArray nameArray 2
        withDuckValue (c_duckdb_create_int32 1) \idVal ->
            withDuckValue (withCString "Alice" c_duckdb_create_varchar) \nameVal ->
                withArray [idVal, nameVal] \structValues ->
                    withDuckValue (c_duckdb_create_struct_value structLogical structValues) \structVal -> do
                        child <- c_duckdb_get_struct_child structVal 1
                        namePtr <- c_duckdb_get_varchar child
                        peekCString namePtr >>= (@?= "Alice")
                        c_duckdb_free (castPtr namePtr)
                        destroyDuckValue child
        destroyLogicalType structLogical
        destroyLogicalType structInt
        destroyLogicalType structText

        -- Enum value
        enumLogical <-
            withMany withCString ["Red", "Green", "Blue"] \namePtrs ->
                withArray namePtrs (`c_duckdb_create_enum_type` 3)
        withDuckValue (c_duckdb_create_enum_value enumLogical 1) (c_duckdb_get_enum_value >=> (@?= 1))
        destroyLogicalType enumLogical

        -- Union value
        unionInt <- c_duckdb_create_logical_type DuckDBTypeInteger
        unionText <- c_duckdb_create_logical_type DuckDBTypeVarchar
        unionLogical <-
            withMany withCString ["int_member", "text_member"] \namePtrs ->
                withArray [unionInt, unionText] \typeArray ->
                    withArray namePtrs \nameArray ->
                        c_duckdb_create_union_type typeArray nameArray 2
        withDuckValue (c_duckdb_create_int32 42) \unionPayload ->
            withDuckValue (c_duckdb_create_union_value unionLogical 0 unionPayload) \unionVal -> do
                strPtr <- c_duckdb_value_to_string unionVal
                peekCString strPtr >>= (@?= "union_value(int_member := 42)")
                c_duckdb_free (castPtr strPtr)
        destroyLogicalType unionLogical
        destroyLogicalType unionInt
        destroyLogicalType unionText