InformationSchema.fs

namespace Npgsql.FSharp.Analyzers.Core

open System
open System.Collections.Generic

open System.Data 

open System.Data.SqlClient


open System.Collections
open System.Net

module RewriteSqlUsingParser =

    type internal SqlDataReader with

        member cursor.GetValueOrDefault(name: string, defaultValue) =
            let i = cursor.GetOrdinal(name)
            if cursor.IsDBNull(i) then defaultValue else cursor.GetFieldValue(i)

    let ParseParameterInfo(cmd: SqlCommand) = 
        seq {
            let cursor = cmd.ExecuteReader()
            while cursor.Read() do
                yield (string cursor.["name"], 
                    unbox<int> cursor.["suggested_system_type_id"], 
                    unbox<int> (cursor.GetValueOrDefault( "suggested_user_type_id",0)),
                    unbox<bool> cursor.["suggested_is_output"],
                    unbox<bool> cursor.["suggested_is_input"],
                    cursor.["suggested_max_length"] |> unbox<int16> |> int,
                    unbox cursor.["suggested_precision"] |> unbox<byte>,
                    unbox cursor.["suggested_scale"] |> unbox<byte>)
        }

    let getVariables tsql = 
                let parser = Microsoft.SqlServer.TransactSql.ScriptDom.TSql140Parser( true)
                let tsqlReader = new System.IO.StringReader(tsql)
                let errors = ref Unchecked.defaultof<_>
                let fragment = parser.Parse(tsqlReader, errors)

                let allVars = ResizeArray()
                let declaredVars = ResizeArray()

                fragment.Accept {
                    new Microsoft.SqlServer.TransactSql.ScriptDom.TSqlFragmentVisitor() with
                        member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.VariableReference) = 
                            base.Visit node
                            allVars.Add(node.Name, node.StartOffset, node.FragmentLength)
                        member __.Visit(node : Microsoft.SqlServer.TransactSql.ScriptDom.DeclareVariableElement) = 
                            base.Visit node
                            declaredVars.Add(node.VariableName.Value)
                }
                let unboundVars = 
                    allVars 
                    |> Seq.groupBy (fun (name, _, _)  -> name)
                    |> Seq.choose (fun (name, xs) -> 
                        if declaredVars.Contains name 
                        then None 
                        else Some(name, xs |> Seq.mapi (fun i (_, start, length) -> sprintf "%s%i" name i, start, length)) 
                    )
                    |> dict

                unboundVars, !errors

    let ReWriteSqlStatementToEnableMoreThanOneParameterDeclaration (query:string) (unboundVars:Generic.IDictionary<string,seq<string * int * int >>) =
        let mutable tsql = query
        let mutable startAdjustment = 0
        // order vars according to position so adjustment works well
        let orderdVars = unboundVars.Values |> List |> Seq.collect id |> Seq.sortBy (fun (newName, start, len) -> start)

        for newName, start, len in orderdVars do
            let before = tsql
            let start = start + startAdjustment
            let after = before.Remove(start, len).Insert(start, newName)
            tsql <- after
            startAdjustment <- startAdjustment + (after.Length - before.Length)
        tsql


    let ExtractParamtersFromQuery (query: string) connection = 
            use cmd = new SqlCommand("sys.sp_describe_undeclared_parameters", connection, CommandType = CommandType.StoredProcedure)
            cmd.Parameters.AddWithValue("@tsql", query) |> ignore
            let tsql = cmd.Parameters.["@tsql"].Value.ToString()
            let unboundVars, parseErrors = getVariables tsql
            if parseErrors.Count = 0
            then 
                let newTsql = (ReWriteSqlStatementToEnableMoreThanOneParameterDeclaration tsql unboundVars)
                cmd.Parameters.["@tsql"].Value <- newTsql
                let altered = ParseParameterInfo cmd
                let mapBack = unboundVars |> Seq.collect(fun (KeyValue(name, xs)) -> [ for newName, _, _ in xs -> newName, name ]) |> dict
                let tryUnify = 
                    altered
                    |> Seq.map (fun (name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) -> 
                        let oldName = 
                            match mapBack.TryGetValue name with 
                            | true, original -> original 
                            | false, _ -> name
                        oldName, (sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale)
                    )
                    |> Seq.groupBy fst

                    |> Seq.map( fun (name, xs) -> name, xs |> Seq.map snd |> Seq.distinct |> Seq.toArray)
                    |> Seq.toArray

                // if same parameter found with different values all parameters will be dicarded
                // here you can add some error messages
                if tryUnify |> Array.exists( fun (_, xs) -> xs.Length > 1)
                then 
                    None
                else
                    tryUnify 
                    |> Array.map (fun (name, xs) -> 
                        // userTypeId is returnd null
                        let sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale = xs.[0] //|> Seq.exactlyOne
                        name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale
                    )
                    |> Some
            else
                None


module InformationSchema =

    type internal SqlDataReader with

        member cursor.GetValueOrDefault(name: string, defaultValue) =
            let i = cursor.GetOrdinal(name)
            if cursor.IsDBNull(i) then defaultValue else cursor.GetFieldValue(i)

    let inline openConnection connectionString =
        let conn = new SqlConnection(connectionString)
        conn.Open()
        conn
        

    type DataType = {
        Name: string
        Schema: string
        IsArray : bool
        ClrType: System.Type
    } 
    type Schema =
        { OID : string
          Name : string }

    type Table =
        { OID : string
          Name : string
          Description : string option }

    type Column =
        { ColumnAttributeNumber : int16
          Name: string
          DataType: DataType
          Nullable: bool
          MaxLength: int
          ReadOnly: bool
          AutoIncrement: bool
          DefaultConstraint: string
          Description: string
          UDT: System.Type option Lazy // must be lazt due to late binding of columns with user defined types.
          PartOfPrimaryKey: bool
          BaseSchemaName: string
          BaseTableName: string }
        with

        member this.ClrType = this.DataType.ClrType

        member this.ClrTypeConsideringNullability =
            if this.Nullable
            then typedefof<_ option>.MakeGenericType this.DataType.ClrType
            else this.DataType.ClrType

        member this.HasDefaultConstraint = string this.DefaultConstraint <> ""
        member this.OptionalForInsert = this.Nullable || this.HasDefaultConstraint || this.AutoIncrement

    type DbEnum =
        { Name: string
          Values: string list }

    type DbSchemaLookupItem =
        { Schema : Schema
          Tables : Dictionary<Table, HashSet<Column>>
          Enums : Map<string, DbEnum> }

    type ColumnLookupKey = { SchemaName :string; TableName : string; ColumnName: string }

    type DbSchemaLookups =
        { Schemas : Dictionary<string, DbSchemaLookupItem>
          Columns : Dictionary<ColumnLookupKey, Column>
          Enums : Map<string, DbEnum> }

    type Parameter =
        { Name: string
          Direction: ParameterDirection
          MaxLength: int
          Precision: byte
          Scale : byte
          Optional: bool
          DataType: DataType
          IsNullable : bool }
        with

        member this.Size = this.MaxLength

    // check types in FSqlClient if thye match
    //https://github.com/fsprojects/FSharp.Data.SqlClient/blob/c96a2e2445debd078aa7dea2779333f3e149ff84/src/SqlClient.DesignTime/SqlClientExtensions.fs
    let private builtins = [
            "bit", typeof<bool>;

            "tinyint", typeof<byte>;
            "smallint", typeof<int16>;
            "int", typeof<int32>;
            "bigint", typeof<int64>;


            "real", typeof<single>; "float", typeof<double>
            "double precision", typeof<double>; "float8", typeof<double>

            "smallmoney" , typeof<decimal>; "money" , typeof<decimal>;
            "numeric", typeof<decimal>; "decimal", typeof<decimal>;


            "varchar", typeof<string>; "nvarchar", typeof<string>;
            "nchar", typeof<string>; "char", typeof<string>

            "text", typeof<string>; "ntext", typeof<string>
            "xml", typeof<string>
            "hierarchyid", typeof<string>

            "binary", typeof<BitArray>;
            "varbinary", typeof<BitArray>;
            "image", typeof<BitArray>;
            "timestamp", typeof<BitArray>
            "rowversion", typeof<BitArray>

            "uniqueidentifier", typeof<Guid>

            "smalldatetime", typeof<DateTime>
            "datetime", typeof<DateTime>
            "datetime2", typeof<DateTime>
            "date", typeof<DateTime>
            "datetimeoffset", typeof<DateTimeOffset>
            "time", typeof<TimeSpan>
        ]

    let getTypeMapping =
        let allMappings = dict builtins
        fun datatype ->
            let exists, value = allMappings.TryGetValue(datatype)
            if exists then value else failwithf "Unsupported datatype %s." datatype

    let getTypeNameWithIds conn =
        let sqlEngineTypes = 
            use cmd = new SqlCommand("""
            SELECT 
              T.NAME, T.SYSTEM_TYPE_ID, T.USER_TYPE_ID, T.IS_TABLE_TYPE, S.NAME AS SCHEMA_NAME, T.IS_USER_DEFINED, T.[PRECISION], T.SCALE
            FROM 
              SYS.TYPES AS T
              JOIN SYS.SCHEMAS AS S ON T.SCHEMA_ID = S.SCHEMA_ID
            """
            ,conn)   
            use reader = cmd.ExecuteReader()
            [| while reader.Read() do
                  let system_type_id = reader.["system_type_id"] |> unbox<byte>  |> int
                  let user_type_id = unbox<int> reader.["user_type_id"]
                  let name = string reader.["name"]
                  yield 
                      (system_type_id,user_type_id),name
            |] |> dict
        sqlEngineTypes


    let GetFullQualityColumnInfo connectionString commandText (dbSchemaLookups: DbSchemaLookups)= 

        // rewrite query to fix paramters that are used more than once
        let unboundvars, erros = RewriteSqlUsingParser.getVariables commandText
        let alterdQuery = RewriteSqlUsingParser.ReWriteSqlStatementToEnableMoreThanOneParameterDeclaration commandText unboundvars

        use connection = openConnection connectionString

        let typeIdName = getTypeNameWithIds connection

        use cmd = new SqlCommand("sys.sp_describe_first_result_set", connection, CommandType = CommandType.StoredProcedure)
        cmd.Parameters.AddWithValue("@tsql", alterdQuery) |> ignore
        cmd.Parameters.AddWithValue("@params", null) |> ignore
        cmd.Parameters.AddWithValue("@include_browse_information", true) |> ignore
        use row = cmd.ExecuteReader()

        seq {
        while row.Read() do
            let table = string row.["source_table"]
            let schema = string row.["source_schema"]
            let sourceColumn = string row.["source_column"]
            let resultColumn = string row.["name"]
            let typeid = unbox<int> row.["system_type_id"]
            let userTypeId = row.GetValueOrDefault("user_type_id",0)

            // some times user type Id is returned as null
            let found,typeName1 = typeIdName.TryGetValue ((typeid,userTypeId))
            let _,typeName2 = typeIdName.TryGetValue ((typeid,typeid))
            let typeName = if found then typeName1 else typeName2

            if table <> "" && schema <> "" && sourceColumn <> "" then
                let lookup = {SchemaName = schema; TableName = table; ColumnName = sourceColumn}
                yield { dbSchemaLookups.Columns.[lookup] with Name = resultColumn }
            else
            yield {
                ColumnAttributeNumber = row.["column_ordinal"] |> unbox<int> |> int16
                Name = string row.["name"]
                DataType = {
                    Name = typeName
                    Schema = null
                    IsArray = false
                    ClrType = getTypeMapping typeName}
                Nullable = row.GetValueOrDefault("is_nullable", true)
                MaxLength = row.GetValueOrDefault("max_length", -1s) |> int
                ReadOnly = row.GetValueOrDefault("is_updateable", true)
                AutoIncrement = row.GetValueOrDefault("is_identity_column", false)
                DefaultConstraint = ""
                Description = ""
                UDT = lazy None
                PartOfPrimaryKey = row.GetValueOrDefault("is_part_of_unique_key", false)
                BaseSchemaName = string row.["source_schema"]
                BaseTableName = string row.["source_table"]
            }
        } |> Seq.toList


    let extractParametersAndOutputColumns(connectionString, query,allParametersOptional, dbSchemaLookups: DbSchemaLookups) =
        let columns = GetFullQualityColumnInfo connectionString query dbSchemaLookups

        use cn =openConnection connectionString
        let typeIdName = getTypeNameWithIds cn
        let paramtersValuse = RewriteSqlUsingParser.ExtractParamtersFromQuery  query cn

        let getDirection isOutput isInput =
            match (isOutput, isInput) with
            | (true, true) -> ParameterDirection.InputOutput
            | (true, false) -> ParameterDirection.Output
            | (false, true) -> ParameterDirection.Input

        let paramters =
            match paramtersValuse with
            | None -> [||]
            |Some p ->
                p
                |> Array.map (fun (name, sqlEngineTypeId, userTypeId, suggested_is_output, suggested_is_input, max_length, precision, scale) ->

                    // some times user type Id is returned as null
                    let found,typeName1 = typeIdName.TryGetValue ((sqlEngineTypeId,userTypeId))
                    let _,typeName2 = typeIdName.TryGetValue ((sqlEngineTypeId,sqlEngineTypeId))
                    let typeName = if found then typeName1 else typeName2
                    
                    {
                       Name = name.Replace("@","")
                       Direction = getDirection suggested_is_output suggested_is_input
                       MaxLength = max_length
                       Precision = precision
                       Scale = scale
                       Optional = allParametersOptional
                       DataType = {
                           Name = typeName
                           Schema = ""
                           IsArray = false
                           ClrType = getTypeMapping(typeName)
                       } 
                       IsNullable = false
                    })

        paramters |> Array.toList , columns,Map<string,DbEnum> []


    let getDbSchemaLookups(connectionString) =
        use connection = openConnection connectionString
        
        let cmd = new SqlCommand(
                    """
                    SELECT 
                    SCHEMA_ID(col.TABLE_SCHEMA) as schema_oid
                    ,col.TABLE_SCHEMA as schema_name
                    ,object_id(col.TABLE_SCHEMA + '.' + col.TABLE_NAME) as table_oid
                    ,col.TABLE_NAME as table_name
                    ,'' as table_description
                    ,col.ORDINAL_POSITION as col_number 
                    ,col.DATA_TYPE as col_data_type
                    ,col.COLUMN_NAME as col_name
                    ,col.DATA_TYPE col_udt_name
                    ,CASE WHEN col.IS_NULLABLE = 'YES' THEN CAST(1 AS BIT) else CAST(0 AS BIT) end as col_null
                    ,col.CHARACTER_MAXIMUM_LENGTH as col_max_length
                    , CAST(1 AS BIT) as col_is_updatable 
                    ,CAST (columnproperty(object_id(col.TABLE_SCHEMA + '.' + col.TABLE_NAME),col.COLUMN_NAME,'IsIdentity') AS BIT) as col_is_identity
                    ,col.COLUMN_DEFAULT as col_default
                    ,'' as col_description
                    ,Type_ID(col.DATA_TYPE) as col_typeoid 
                    ,CASE WHEN (K.CONSTRAINT_NAME) IS NULL THEN CAST(0 AS BIT) ELSE CAST(1 AS BIT) END as col_part_of_primary_key
                    FROM INFORMATION_SCHEMA.COLUMNS  col 
                    LEFT JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE AS K ON k.COLUMN_NAME = col.COLUMN_NAME and k.TABLE_NAME = col.TABLE_NAME and k.TABLE_SCHEMA = col.TABLE_SCHEMA
                    LEFT JOIN  INFORMATION_SCHEMA.TABLE_CONSTRAINTS AS C ON C.TABLE_NAME = K.TABLE_NAME
                                                                                  AND C.CONSTRAINT_CATALOG = K.CONSTRAINT_CATALOG
                                                                                  AND C.CONSTRAINT_SCHEMA = K.CONSTRAINT_SCHEMA
                                                                                  AND C.CONSTRAINT_NAME = K.CONSTRAINT_NAME
                                                      AND   C.CONSTRAINT_TYPE = 'PRIMARY KEY'
                    JOIN sys.schemas s ON s.name = col.TABLE_SCHEMA
                    JOIN sys.sysusers u on u.uid = s.principal_id
                    where u.issqlrole = 0
                        and u.name not in ('sys', 'guest', 'INFORMATION_SCHEMA')
                      """
              ,connection)
        let schemas = Dictionary<string, DbSchemaLookupItem>()
        let columns = Dictionary<ColumnLookupKey, Column>()

        use row = cmd.ExecuteReader()
        while row.Read() do
            let schema : Schema =
                { OID = string row.["schema_oid"]
                  Name = string row.["schema_name"] }

            if not <| schemas.ContainsKey(schema.Name) then

                schemas.Add(schema.Name, { Schema = schema
                                           Tables = Dictionary();
                                           Enums = Map.empty })

            match row.["table_oid"] |> Option.ofObj with
            | None -> ()
            | Some oid ->
                let table =
                    { OID = string oid
                      Name = string row.["table_name"]
                      Description = row.["table_description"] |> Option.ofObj |> Option.map string }

                if not <| schemas.[schema.Name].Tables.ContainsKey(table) then
                    schemas.[schema.Name].Tables.Add(table, HashSet())

                match row.GetValueOrDefault<int>("col_number", -1) with
                | -1 -> ()
                | attnum ->
                    let udtName = string row.["col_udt_name"]
                    let isArray = string row.["col_data_type"] = "ARRAY"
                    let dataType = if isArray then udtName.TrimStart('_') else udtName
                    let isUdt =
                        schemas.[schema.Name].Enums
                        |> Map.tryFind dataType
                        |> Option.isSome

                    let clrType =
                        match string row.["col_data_type"] with
                        | "ARRAY" ->
                            let elemType = getTypeMapping(udtName.TrimStart('_') )
                            elemType.MakeArrayType()
                        | "USER-DEFINED" ->
                            if isUdt then typeof<string> else typeof<obj>
                        | dataType ->
                            getTypeMapping(dataType)

                    let column =
                        { ColumnAttributeNumber = attnum |> int16
                          Name = string row.["col_name"]
                          DataType = { Name = dataType
                                       Schema = schema.Name
                                       IsArray = false // always false since sql server doesn't have arrays
                                       ClrType = clrType }
                          Nullable = row.["col_null"] |> unbox
                          MaxLength = row.GetValueOrDefault("col_max_length", -1) 
                          ReadOnly = false
                          AutoIncrement = unbox<bool> row.["col_is_identity"]
                          DefaultConstraint = row.GetValueOrDefault("col_default", "")
                          Description = row.GetValueOrDefault("col_description", "")
                          UDT = lazy None
                          PartOfPrimaryKey = unbox row.["col_part_of_primary_key"]
                          BaseSchemaName = schema.Name
                          BaseTableName = string row.["table_name"] }

                    if not <| schemas.[schema.Name].Tables.[table].Contains(column) then
                        schemas.[schema.Name].Tables.[table].Add(column) |> ignore

                    let lookupKey = { SchemaName = schema.Name
                                      TableName = table.Name
                                      ColumnName = column.Name}
                    if not <| columns.ContainsKey(lookupKey) then
                        columns.Add(lookupKey, column)

        { Schemas = schemas
          Columns = columns
          Enums = Map []}