gistfile1.fs

module TableThirdStage

open Utils
open ModelTypes
open ForeignKeyInfo
open LoadTableInfoIface
open TypesLoader
open TableLoader
open TableSecondStage
open Tekinsoft.meta
open Tekinsoft.meta_dao
open LinkGroups


//========================================================
// topological sort with structure inference


///third stage table description
type IThirdStageTableInfo =
     //abstract member Table:LoadTableInfo
     abstract member TableAfterFix:ILoadTableInfo
     abstract member PrimaryKeyFields:IField seq
     abstract member PrimaryKey:PrimaryKey
     abstract member OwnSqlFields:IField seq
     //abstract member Groups:FieldGroup seq
     abstract member OwnLinks:TableLinks
     abstract member AllLinks:TableLinks

     abstract member Hierarchy:string seq
     abstract member ParentNames:string seq
     abstract member RootTableName:string
     abstract member IsRootTable:bool
     abstract member ParentTableName:string
     abstract member VersionMode:VersionMode
     abstract member AuditMode:AuditMode
     abstract member TableKind:TableKind
     abstract member UniqueID:int

     abstract member AccessPredicate:Predicates.SQLPredicate option
     abstract member EditPredicate:Predicates.CheckPredicate list
     abstract member AuxFilterConds:Predicates.WhereFilter seq
     abstract member AllFields:IFieldFilterData seq

     abstract member TableGrants:Model.DBSchema.Grant seq
     abstract member ViewGrants:Model.DBSchema.Grant seq
     abstract member EndUserGrants:Model.DBSchema.Grant seq
     abstract member LogTableGrants:Model.DBSchema.Grant seq

     abstract member OwnIndices:Model.DBSchema.Index seq
     abstract member AllIndices:Model.DBSchema.Index seq

///List of field groups
type private FieldGroups(groups:FieldGroup seq)=
     member this.Groups = groups |> Seq.toList
     override this.ToString() =
        groups |> commaListA



type private ThirdStage(secondStage:ISecondStageTableInfo,originalLinks:Link seq,ownLinks:Link seq,allLinks:Link seq,rank:int,groups:FieldGroup seq)=
     let ownLinksWrapper = TableLinks(ownLinks)
     let allLinksWrapper = TableLinks(allLinks)

     member this.SecondStage = secondStage
     member this.Rank = rank
     member this.OriginalLinks = originalLinks
     member this.OwnLinks = ownLinksWrapper
     member this.AllLinks = allLinksWrapper
     member this.Groups = groups
     override this.ToString()=sprintf "ThirdStage %s %d\r\n    OriginalLinks:(%s)\r\n    OwnLinks:(%s)\r\n    AllLinks:(%s)\r\n    Groups:(%s)"
                                     secondStage.Table.Name rank
                                     (originalLinks |> commaListA)
                                     (ownLinks |> commaListA)
                                     (allLinks |> commaListA)
                                     (groups |> commaListA)

     interface IThirdStageTableInfo with
        //member this.Table=secondStage.Table
        member this.TableAfterFix=secondStage.TableAfterFix
        member this.PrimaryKeyFields=secondStage.PrimaryKeyFields
        member this.PrimaryKey=PrimaryKey(secondStage.PrimaryKeyFields,groups |> Seq.map(fun g -> PrimaryKeyFieldGroup(g.Name,g.Fields)))
        member this.OwnSqlFields=secondStage.OwnSqlFields
        //member this.Groups=groups
        member this.OwnLinks=ownLinksWrapper
        member this.AllLinks=allLinksWrapper

        member this.Hierarchy = secondStage.Table.Hierarchy |> Seq.map(fun ti -> ti.Name)
        member this.ParentNames = secondStage.Table.ParentNames
        member this.RootTableName = secondStage.Table.RootTable.Name
        member this.IsRootTable = secondStage.Table.IsRootTable
        member this.ParentTableName = secondStage.Table.ParentTableName

        member this.OwnIndices = secondStage.Table.OwnIndices
        member this.AllIndices = secondStage.Table.AllIndices
        member this.AllFields = secondStage.Table.AllFields

        member this.TableGrants = secondStage.Table.TableGrants
        member this.ViewGrants = secondStage.Table.ViewGrants
        member this.EndUserGrants = secondStage.Table.EndUserGrants
        member this.LogTableGrants = secondStage.Table.LogTableGrants

        member this.VersionMode = secondStage.Table.VersionMode
        member this.AuditMode = secondStage.Table.AuditMode
        member this.AccessPredicate = secondStage.Table.AccessPredicate
        member this.EditPredicate = secondStage.Table.EditPredicate
        member this.AuxFilterConds = secondStage.Table.AuxFilterConds
        member this.TableKind = secondStage.Table.TableKind
        member this.UniqueID = secondStage.Table.UniqueID


///convert links to field groups
let private addLinkToGroups (s:FieldGroups) (l:Link) =
    //printfn "  addLinkToGroups %O + %O" s l
    let srcFields = l.Fields |> Seq.map fst |> Set.ofSeq
    let splitGroup (g:FieldGroup) =
        //printfn "    splitGroup %O" g
        if (g.Rank<l.Rank)
        then Seq.singleton g else
        let inLinkFields = g.Fields |> Seq.filter (fun f -> Set.contains f srcFields)
        let notInLinkFields = g.Fields |> Seq.filter (fun f -> Set.contains f srcFields |> not)
        seq{
            if Seq.isEmpty inLinkFields
            then yield g else
              if not(Seq.isEmpty inLinkFields)
              then yield FieldGroup(l.DestTableName,inLinkFields,l.Rank)
              if not(Seq.isEmpty notInLinkFields)
              then yield FieldGroup(g.Name,notInLinkFields,g.Rank)
        }

    let groups = s.Groups |> Seq.collect splitGroup |> Seq.toList
    FieldGroups(groups)


//split links fields list
let private checkSets (links:Link seq) =
    let setToFields map set =
        set |> Seq.map (fun f->Map.find f map)

    let splitSelfLinks (l:Link) =
        if l.DestTableName<>l.SourceTableName
        then Seq.singleton l
        else let selfRefFields = l.Fields |> Seq.filter( fun (fs,fd) -> fs=fd)
             let otherRefFields = l.Fields |> Seq.filter( fun (fs,fd) -> fs<>fd)
             if Seq.isEmpty selfRefFields
             then Seq.singleton l
             else seq {
                let fkDataSelf = LinkFKData(l.ForeignKeyData.Name+"Self",l.ForeignKeyData.UserName,l.ForeignKeyData.PatchedName,l.ForeignKeyData.ForeignKeyType,
                                            l.ForeignKeyData.FilterKind,l.ForeignKeyData.Reference,l.ForeignKeyData.OrderBy,l.ForeignKeyData.Source)
                yield Link(fkDataSelf,l.SourceTableName,l.DestTableName,selfRefFields,Seq.empty,l.Rank,l.InsidePK)//
                let fkDataOther = LinkFKData(l.ForeignKeyData.Name+"Other",l.ForeignKeyData.UserName,l.ForeignKeyData.PatchedName,l.ForeignKeyData.ForeignKeyType,
                                             l.ForeignKeyData.FilterKind,l.ForeignKeyData.Reference,l.ForeignKeyData.OrderBy,l.ForeignKeyData.Source)
                yield Link(fkDataOther,l.SourceTableName,l.DestTableName,otherRefFields,l.AllFKFields,l.Rank,l.InsidePK)
             }

    let addLink (s:Link seq) (l:Link) =
        let intersectLinks ((state,l):Link seq * Link) (r:Link)=
            let lSet = l.Fields |> Seq.map fst |> Set.ofSeq
            let lMap = l.Fields |> Seq.map (fun f->fst f,f) |> Map.ofSeq
            let rSet = r.Fields |> Seq.map fst |> Set.ofSeq
            let rMap = r.Fields |> Seq.map (fun f->fst f,f) |> Map.ofSeq

            let intersect = Set.intersect lSet rSet
            let lRemain = Set.difference lSet intersect
            let rRemain = Set.difference rSet intersect
            let out =
                seq{
                    if not(Set.isEmpty rRemain) then 
                        yield Link(r.ForeignKeyData, r.SourceTableName, r.DestTableName, setToFields rMap rRemain, r.AllFKFields, r.Rank, r.InsidePK)
                    if not(Set.isEmpty intersect) then
                        let maxLink,maxMap = if l.Rank<r.Rank then l,lMap else r,rMap
                        yield Link(maxLink.ForeignKeyData, maxLink.SourceTableName, maxLink.DestTableName, setToFields maxMap intersect, 
                                   maxLink.AllFKFields, maxLink.Rank,maxLink.InsidePK)
                }
            let newRemain = Link(l.ForeignKeyData, l.SourceTableName, l.DestTableName, setToFields lMap lRemain, l.AllFKFields, l.Rank, l.InsidePK)
            Seq.append state out, newRemain

        let news,remain = s |> Seq.fold intersectLinks (Seq.empty,l)
        if Seq.isEmpty remain.Fields
        then news
        else Seq.append news (Seq.singleton remain)

    links |> Seq.collect splitSelfLinks |> Seq.fold addLink Seq.empty


///main worker function for Depth First Search
let private addVisited (n:ISecondStageTableInfo) (visited:ThirdStage list) =
    sprintf "addVisited %A" n.Table.Name |> actionLog
    //merge keys with visited links
    let pkSet = n.PrimaryKeyFields |> Seq.map(fun f->f.Name) |> Set.ofSeq
    let isFKInsideOfPK (fk:ForeignKeyInfo) =
        fk.ModelForeignKey.Fields
             |> Seq.map(fun fkf -> fkf.SourceField)
             |> Seq.forall(fun fn -> pkSet.Contains fn)


    let convertLinks (v:ThirdStage) =
        let convertLink (fk:ForeignKeyInfo)=
            let insidePK = isFKInsideOfPK fk
            let mergeLink (l:Link)=
                //sprintf "   mergeLink %A %A" l fk |> actionLogInfo
                //if l.SourceTableName=l.DestTableName then None else //skip self-links, as they definitely cannot be used in transit FKs
                if not l.InsidePK then None else
                //sprintf "     fk fields: %s" (fk.ModelForeignKey.Fields |> commaListA) |> actionLogInfo
                //sprintf "     link fields: %s" (l.Fields |> commaListA) |> actionLogInfo
                let fields = fk.ModelForeignKey.Fields |> Seq.collect(fun fkf -> l.Fields |> Seq.map(fun lf -> fkf,lf))
                let fields' = fields |> Seq.filter (fun (fkf,(fs2,fd2)) -> //sprintf "%A %s %s" fkf fs2 fd2 |> actionLogInfo
                                                                           fkf.DestField=fs2)
                                     //|> Seq.map (fun (fkf,(fs2,fd2)) -> fkf.SourceField,fd2)
                                     |> Seq.toList
                if Seq.isEmpty fields'
                then //sprintf "  no intersect " |> actionLogInfo
                     None
                else //let fkfields = fk.ModelForeignKey.Fields |> Seq.collect(fun fkf -> l.Fields |> Seq.map(fun lf -> fkf,lf))
                     let linkfields = fields' |> Seq.map (fun (fkf,(fs2,fd2)) -> fkf.SourceField,fd2)
                     let fkfields = fields' |> Seq.map (fun (fkf,(fs2,fd2)) -> Model.DBSchema.ForeignKeyField(fkf.SourceField,fkf.Position,fd2,fkf.Type))

                     let fkData = LinkFKData(l.ForeignKeyData.Name, l.ForeignKeyData.UserName, l.ForeignKeyData.PatchedName,
                                             l.ForeignKeyData.ForeignKeyType, l.ForeignKeyData.FilterKind,
                                             l.ForeignKeyData.Reference, fk.OrderBy, fk.ForeignKeySource)
                                             
                     Some <| Link(fkData, n.Table.Name, l.DestTableName, linkfields, fkfields, l.Rank, l.InsidePK && insidePK)

            if(fk.ModelForeignKey.DestTable=v.SecondStage.Table.Name)
            then //sprintf "   convertLink %A %s " fk v.SecondStage.Table.Name |> actionLogInfo
                 v.OriginalLinks |> Seq.choose mergeLink
            else Seq.empty
        n.TableAfterFix.OwnForeignKeys |> Seq.filter (fun fk->fk.ModelForeignKey.Kind<>FKType.Parent) |>Seq.collect convertLink
    //sprintf "begin merge %A" n.Table.Name |> actionLogInfo
    let auxLinks = visited |> Seq.collect convertLinks |> Seq.toList
    //sprintf "end merge"|> actionLogInfo

    let rank = List.length visited
    //add current node keys
    let foreignKeyToLink (fk:ForeignKeyInfo)=
        let linkRankFound = visited |> List.tryFind (fun f->f.SecondStage.Table.Name=fk.ModelForeignKey.DestTable)
        let linkRank = if linkRankFound.IsSome
                       then linkRankFound.Value.Rank
                       else if fk.ModelForeignKey.DestTable=n.Table.Name
                            then rank+1
                            else sprintf "Rank not found for %A" fk |> actionLogError
                                 rank+1
        let insidePK = isFKInsideOfPK fk
        let fkData = LinkFKData(fk.ModelForeignKey.Name,fk.UserName,fk.PatchedName,fk.ModelForeignKey.Kind,fk.FilterKind,fk.Reference,fk.OrderBy,fk.ForeignKeySource)
        Link(fkData,n.Table.Name,fk.ModelForeignKey.DestTable,fk.ModelForeignKey.Fields |> Seq.map (fun fld->fld.SourceField,fld.DestField),fk.ModelForeignKey.Fields,linkRank,insidePK)

    let orderMap = n.TableAfterFix.OwnFields |> Seq.mapi (fun i f ->f.Field.Name,i) |> Map.ofSeq
    let linkToOrder (l:Link)=
        let order = orderMap.TryFind (l.Fields |> Seq.map(fun (fs,fd)->fs)|> lastElement)
        if order.IsNone then sprintf "Link order not found: %A" l |> actionLogError
        order

    let links = (Seq.append (n.TableAfterFix.OwnForeignKeys |> Seq.map foreignKeyToLink)
                             auxLinks)
                 |> Seq.distinct   //uses Equals
                 |> Seq.sortBy linkToOrder
                 |> Seq.toList

    let startGroups = FieldGroups(Seq.singleton(FieldGroup(n.Table.Name,n.PrimaryKeyFields |> Seq.map (fun f->f.Name),rank+1)))
    let groups = links |> Seq.fold addLinkToGroups startGroups

    //links |> Seq.iter (sprintf "   before %A" >> actionLog)
    let ownLinkGroups = checkSets links

    let ownLinkGroups' = ownLinkGroups |> Seq.sortBy linkToOrder

    //ownLinkGroups' |> Seq.iter (sprintf "   %A" >> actionLog)

    let parentLinkGroups =
        if n.Table.HasParent
        then let parent = visited |> Seq.find (fun v->v.SecondStage.Table.Name = n.Table.ParentTableName)
             parent.AllLinks.Links
        else Seq.empty

    let allLinkGroups = Seq.append parentLinkGroups ownLinkGroups'

    let newItem = ThirdStage(n,links,ownLinkGroups',allLinkGroups,rank+1,groups.Groups)
    newItem::visited


///Depth first search in tables-foreign keys graph, with structure inference
let private convertToStructs (secondStages:ISecondStageTableInfo seq) =
    let tableMap = secondStages |> Seq.map(fun f->f.Table.Name,f) |> Map.ofSeq
    let tableByName = byNameWithMessage tableMap "Not found table"
    let nodeId (n:ISecondStageTableInfo) = n.Table.Name
    let visitedId (t:ThirdStage) = t.SecondStage.Table.Name
    let edges (n:ISecondStageTableInfo) =
        n.TableAfterFix.OwnForeignKeys //|> Seq.filter fkIntersectWithPK
          |> Seq.map (fun f->tableByName f.ModelForeignKey.DestTable) |> Seq.toList

    let onCycle node path visited=visited//failwithf "Cycle found %A" path
    let third = secondStages |> Seq.fold (fun visited table -> Utils.dfs2 nodeId addVisited onCycle visitedId edges visited table) []
    let orderMap = secondStages |> Seq.mapi (fun i f -> f.Table.Name,i) |> Map.ofSeq
    let order (t:ThirdStage) = Map.find t.SecondStage.Table.Name orderMap
    third |> List.sortBy order



type IThirdStageModelInfo =
     abstract member Name : string
     abstract member UserName : UserNameString
     abstract member Tables : IThirdStageTableInfo list
     abstract member TypeByName : TypeByName
     abstract member PrimaryKeyByName : string -> (IField array)
     abstract member ITableByName : TableByName
     abstract member TableReferenceFieldsByName: string -> (IField*FieldReferenceUsageType option) seq


let private thirdStageToITable (t:IThirdStageTableInfo) =
    {new ITable with
      member this.PrimaryKey = t.PrimaryKey
      member this.Fields = t.OwnSqlFields
      member this.Name = t.TableAfterFix.Name
      member this.UserName = t.TableAfterFix.UserName}


///main entry point - convert dao to intermediate model info and than to ISecondStageModelInfo
let getThirdStageModelDescription (dao:meta_TransactionDAO) (typesDict:LoaderTypeDictionary) (model:ModelIfaceRO) (parents:ModelIfaceRO seq) =
    actionLogInfo "getThirdStageModelDescription: start"

    let secondStage,primaryKeyByName,tableReferenceFieldsByName =
        getSecondStageModelDescription dao typesDict model parents

    secondStage |> Seq.iter (fun ss -> (sprintf "SecondStage: %s" ss.Table.Name  |> actionLog))

    actionLogInfo "getThirdStageModelDescription: convert one half stage to pk structs"
    let thirdStage = convertToStructs secondStage
    thirdStage |> Seq.iter (sprintf "ThirdStage structs: %O" >> actionLog)
    //thirdStage |> Seq.iter (fun ts -> (sprintf "ThirdStage structs: %s %d %s" ts.SecondStage.Table.Name ts.Rank
    //                                           (ModelTypes.fieldsToCommaList ts.SecondStage.PrimaryKeyFields) |> actionLogInfo))

    let iTableMap = thirdStage |> Seq.map (fun t -> t.SecondStage.TableAfterFix.Name, thirdStageToITable t)
                               |> Map.ofSeq

    {new IThirdStageModelInfo with
        member this.Name = model.ID
        member this.UserName = UserNameString(model.Name)
        member this.Tables = thirdStage |> List.map (fun t -> t :> IThirdStageTableInfo)
        member this.PrimaryKeyByName name = primaryKeyByName name
        member this.ITableByName = fun name -> Map.find name iTableMap
        member this.TableReferenceFieldsByName name = tableReferenceFieldsByName name
        member this.TypeByName = typesDict.TypeByName}