Attribute VB_Name = "Sql"
'==========================================================================
' Sql - generate SQL text from a 2D array (modern successor to SQLp_* in
'       TheBigOne). Stateless, no connection, no ORM - it just writes SQL.
'
' Convention: callers pass a 2D Variant array whose FIRST ROW is the header
' (exactly what Range.Value returns for a block with a header row). Column
' SQL types are inferred from the Excel cell VarType per column:
'       date cells    -> DATE
'       numeric cells -> DECIMAL(18, scale)
'       everything else (incl. text-stored codes) -> N/VARCHAR(len)
'
' Final insert shape is INSERT ... SELECT * FROM (VALUES ...) x(cols) - a
' derived table, so SQL Server's 1000-row VALUES limit does not apply.
'==========================================================================

Option Explicit

Public Enum SqlDialect
    dlSqlServer = 0
    dlPostgres = 1
End Enum

Public Enum ColKind
    ckText = 0
    ckNumber = 1
    ckDate = 2
End Enum


'----- low-level building blocks ------------------------------------------

' Quote an identifier for the dialect, escaping the close-quote char.
Public Function BracketId(ByVal name As String, ByVal dialect As SqlDialect) As String
    If dialect = dlSqlServer Then
        BracketId = "[" & Replace(name, "]", "]]") & "]"
    Else
        BracketId = """" & Replace(name, """", """""") & """"
    End If
End Function

' One SQL literal for a value of the given kind. maxLen > 0 truncates text.
Public Function Literal(ByVal v As Variant, ByVal kind As ColKind, _
                        ByVal dialect As SqlDialect, Optional ByVal maxLen As Long = 0) As String
    If IsEmpty(v) Or IsNull(v) Or IsError(v) Then
        Literal = "NULL"
        Exit Function
    End If

    Select Case kind
        Case ckDate
            If IsDate(v) Then
                Literal = "'" & Format$(CDate(v), "yyyy-mm-dd") & "'"
            Else
                Literal = "NULL"
            End If

        Case ckNumber
            If Not IsNumeric(v) Or Len(Trim$(CStr(v))) = 0 Then
                Literal = "NULL"
            Else
                ' Str$ is locale-invariant ('.' decimal, leading space for sign)
                Literal = Trim$(Str$(v))
            End If

        Case Else   ' ckText
            Dim s As String
            s = CStr(v)
            If maxLen > 0 And Len(s) > maxLen Then s = Left$(s, maxLen)
            Literal = "'" & Replace(s, "'", "''") & "'"
    End Select
End Function

' Map a column kind to a SQL type. DECIMAL is valid in both dialects.
Public Function SqlType(ByVal kind As ColKind, ByVal dialect As SqlDialect, _
                        Optional ByVal numScale As Long = 2, Optional ByVal textLen As Long = 100) As String
    Select Case kind
        Case ckDate
            SqlType = "DATE"
        Case ckNumber
            SqlType = "DECIMAL(18," & numScale & ")"
        Case Else
            If dialect = dlSqlServer Then
                SqlType = "NVARCHAR(" & textLen & ")"
            Else
                SqlType = "VARCHAR(" & textLen & ")"
            End If
    End Select
End Function


'----- inference & lookups ------------------------------------------------

' Infer a ColKind per column from the first non-empty data cell.
' Returns a Long() indexed to match the data's column bounds.
Public Function InferKinds(ByVal data As Variant) As Variant
    Dim rLo As Long, rHi As Long, cLo As Long, cHi As Long, i As Long, j As Long
    rLo = LBound(data, 1): rHi = UBound(data, 1)
    cLo = LBound(data, 2): cHi = UBound(data, 2)

    Dim k() As Long
    ReDim k(cLo To cHi)
    For j = cLo To cHi
        k(j) = ckText
        For i = rLo + 1 To rHi                    ' skip header row
            If Not IsEmpty(data(i, j)) Then
                If Not IsError(data(i, j)) Then
                    Select Case VarType(data(i, j))
                        Case vbDate
                            k(j) = ckDate
                        Case vbDouble, vbSingle, vbInteger, vbLong, vbCurrency, vbDecimal
                            k(j) = ckNumber
                        Case Else
                            k(j) = ckText
                    End Select
                    Exit For
                End If
            End If
        Next i
    Next j
    InferKinds = k
End Function

' 1-based-or-whatever column index of a header by name; 0 if not found.
Public Function ColIndex(ByVal data As Variant, ByVal headerName As String) As Long
    Dim cLo As Long, cHi As Long, j As Long, hdr As Long
    hdr = LBound(data, 1)
    cLo = LBound(data, 2): cHi = UBound(data, 2)
    For j = cLo To cHi
        If StrComp(Trim$(CStr(data(hdr, j))), headerName, vbTextCompare) = 0 Then
            ColIndex = j
            Exit Function
        End If
    Next j
    ColIndex = 0
End Function

' Distinct non-empty text values in a column (skips header). 0-based array.
Public Function DistinctText(ByVal data As Variant, ByVal colIndex As Long) As Variant
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare
    Dim rLo As Long, rHi As Long, i As Long, s As String
    rLo = LBound(data, 1): rHi = UBound(data, 1)
    For i = rLo + 1 To rHi
        If Not IsEmpty(data(i, colIndex)) And Not IsError(data(i, colIndex)) Then
            s = Trim$(CStr(data(i, colIndex)))
            If Len(s) > 0 Then If Not d.Exists(s) Then d.Add s, True
        End If
    Next i
    DistinctText = d.Keys
End Function


'----- composite generators -----------------------------------------------

' Comma list of bracketed header names, e.g. [Date], [Account GL], ...
Public Function ColumnList(ByVal data As Variant, ByVal dialect As SqlDialect) As String
    Dim cLo As Long, cHi As Long, j As Long, hdr As Long
    hdr = LBound(data, 1)
    cLo = LBound(data, 2): cHi = UBound(data, 2)
    Dim parts() As String
    ReDim parts(cLo To cHi)
    For j = cLo To cHi
        parts(j) = BracketId(CStr(data(hdr, j)), dialect)
    Next j
    ColumnList = Join(parts, ", ")
End Function

' Quote a 1D array of values as a comma list for an IN (...) clause (text).
Public Function InList(ByVal values As Variant, ByVal dialect As SqlDialect) As String
    If IsEmpty(values) Then Exit Function
    Dim lo As Long, hi As Long, i As Long
    lo = LBound(values): hi = UBound(values)
    If hi < lo Then Exit Function
    Dim parts() As String
    ReDim parts(lo To hi)
    For i = lo To hi
        parts(i) = "'" & Replace(CStr(values(i)), "'", "''") & "'"
    Next i
    InList = Join(parts, ", ")
End Function

' SELECT * FROM (VALUES (..),(..)) x([col],[col]) over the data rows.
Public Function ValuesSelect(ByVal data As Variant, ByVal dialect As SqlDialect, _
                             Optional ByRef kinds As Variant, Optional ByVal textLen As Long = 0) As String
    Dim rLo As Long, rHi As Long, cLo As Long, cHi As Long, i As Long, j As Long, r As Long
    rLo = LBound(data, 1): rHi = UBound(data, 1)
    cLo = LBound(data, 2): cHi = UBound(data, 2)
    If IsMissing(kinds) Then kinds = InferKinds(data)

    Dim rows() As String, cells() As String
    ReDim rows(1 To rHi - rLo)                    ' data rows = total - header
    ReDim cells(cLo To cHi)
    For i = rLo + 1 To rHi
        For j = cLo To cHi
            cells(j) = Literal(data(i, j), kinds(j), dialect, textLen)
        Next j
        r = r + 1
        rows(r) = "(" & Join(cells, ",") & ")"
    Next i

    ValuesSelect = "SELECT * FROM (VALUES" & vbCrLf & _
                   Join(rows, "," & vbCrLf) & vbCrLf & _
                   ") x (" & ColumnList(data, dialect) & ")"
End Function

' Full INSERT INTO <fq> (cols) SELECT * FROM (VALUES ...) x(cols).
Public Function InsertSelectValues(ByVal fq As String, ByVal data As Variant, ByVal dialect As SqlDialect, _
                                   Optional ByRef kinds As Variant, Optional ByVal textLen As Long = 0) As String
    If IsMissing(kinds) Then kinds = InferKinds(data)
    InsertSelectValues = "INSERT INTO " & fq & " (" & ColumnList(data, dialect) & ")" & vbCrLf & _
                         ValuesSelect(data, dialect, kinds, textLen)
End Function

' DDL that creates <fq> only if it doesn't already exist, with inferred types.
Public Function CreateTableIfMissing(ByVal fq As String, ByVal data As Variant, ByVal dialect As SqlDialect, _
                                     Optional ByRef kinds As Variant, _
                                     Optional ByVal numScale As Long = 2, Optional ByVal textLen As Long = 100) As String
    If IsMissing(kinds) Then kinds = InferKinds(data)
    Dim cLo As Long, cHi As Long, j As Long, hdr As Long
    hdr = LBound(data, 1)
    cLo = LBound(data, 2): cHi = UBound(data, 2)
    Dim parts() As String
    ReDim parts(cLo To cHi)
    For j = cLo To cHi
        parts(j) = BracketId(CStr(data(hdr, j)), dialect) & " " & SqlType(kinds(j), dialect, numScale, textLen)
    Next j
    Dim ddl As String
    ddl = Join(parts, ", ")

    If dialect = dlSqlServer Then
        Dim plain As String
        plain = Replace(Replace(fq, "[", ""), "]", "")
        CreateTableIfMissing = "IF OBJECT_ID('" & plain & "','U') IS NULL CREATE TABLE " & fq & " (" & ddl & ")"
    Else
        CreateTableIfMissing = "CREATE TABLE IF NOT EXISTS " & fq & " (" & ddl & ")"
    End If
End Function