WsParser_VS/AstConv/HtmlStruct.fs

namespace HtmlStruct

open AstAccess
open System.Xml
open System
    /// 展现节点 =========================================================================================
    module Present =
        /// 可访问元素
        type PageAccess(hrefs: string) =
            class
                member this.accessLink(): string = hrefs
            end

        /// 内容元素：分卷、章节、引用节点、故事线、情节、定义节点、引用节点
        type IDomUnit = 
            interface
                abstract member name:unit -> string
                abstract member object:unit -> AstImport.AstObject
                abstract member getHtmlWith: pnode:XmlElement -> XmlElement
            end
        
        /// 容器节点：分卷、章节、故事线、情节
        type IContainer =
            interface
                abstract member append:IDomUnit list -> IContainer
                abstract member children:unit -> IDomUnit list
            end

        /// 内容定义元素 =================================================================================
        type Forwards(item: AstImport.AstObject) =
            class
                let mutable assemble_page_url: string = ""

                member this.elementID(): string = item.address()
                member this.setAssembleURL(url: string) =
                    assemble_page_url <- url
                member this.assembleURL():string =
                    assemble_page_url
            end

        /// 回访定义元素 =================================================================================
        type Backwards(bind_item: Forwards, bind_page: PageAccess) =
            class
                member this.elementID(): string =
                    bind_item.elementID()
                member this.backwardsLink(): string =
                    $"{bind_page.accessLink()}#{bind_item.elementID()}"
            end


        /// 访问页面：概括页面、卷宗页面、故事线页面、节点汇总 =================================================
        type VolumePage(page_hrefs: string, volume: IDomUnit, childs: IDomUnit list) =
            class
                inherit PageAccess(page_hrefs)
                new(page_hrefs, volume) = VolumePage(page_hrefs, volume, [])

                interface IDomUnit with
                    member this.name():string = volume.name()
                    member this.object() = 
                        volume.object()
                    member this.getHtmlWith(p: XmlElement): XmlElement =
                        raise (System.NotImplementedException())

                interface IContainer with
                    member this.children(): IDomUnit list = childs
                    member this.append(childs: IDomUnit list): IContainer =
                        raise (System.NotImplementedException())
            end

        type StoryPage(page_hrefs: string, story: IDomUnit, childs: IDomUnit list) =
            class
                inherit PageAccess(page_hrefs)
                new(page_hrefs, story) = StoryPage(page_hrefs, story, [])
                
                interface IDomUnit with
                    member this.name():string = story.name()
                    member this.object() =
                        story.object()
                    member this.getHtmlWith(p: XmlElement): XmlElement =
                        raise (System.NotImplementedException())

                interface IContainer with
                    member this.children(): IDomUnit list = childs
                    member this.append(childs: IDomUnit list): IContainer =
                        raise (System.NotImplementedException())
            end

        type PointPage(page_hrefs: string, point: IDomUnit, refer_list: IDomUnit list) =
            class
                inherit PageAccess(page_hrefs)
                new(page_hrefs, point) = PointPage(page_hrefs, point, [])
                
                interface IDomUnit with
                    member this.name():string = point.name()
                    member this.object() = point.object()
                    member this.getHtmlWith(p: XmlElement): XmlElement =
                        raise (System.NotImplementedException())

                interface IContainer with
                    member this.children(): IDomUnit list = refer_list
                    member this.append(childs: IDomUnit list): IContainer =
                        PointPage(page_hrefs, point, refer_list @ childs)
            end


    /// 内容节点 =========================================================================================
    module Content = 
        type TextContent(word: AstImport.TextItem) =
            class
                interface Present.IDomUnit with
                    member this.name(): string = ""
                    member this.object() = word
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
            end


        type PointRefer(refs: AstImport.PointRef, items: Present.IDomUnit list) =
            class 
                inherit Present.Forwards(refs)

                let ref_signature = $"@{refs.storyRef()}&{refs.sliceRef()}&{refs.pointRef()}"
                let lines = refs.children() |> List.map (fun x->x.content())

                interface Present.IDomUnit with
                    member this.name(): string = ref_signature
                    member this.object() = refs
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = items
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        raise (System.NotImplementedException())
            end
        let refer_assemble (refn: AstImport.PointRef) : PointRefer = 
            let texts = refn.children() |> List.map (fun dom -> TextContent(dom) :> Present.IDomUnit)
            PointRefer(refn, texts)
            

        type PointDefine(defs: AstImport.PointDef, items: Present.IDomUnit list) =
            class 
                inherit Present.Forwards(defs)

                let lines = defs.children() |> List.map (fun x->x.content())

                interface Present.IDomUnit with
                    member this.name(): string = defs.name()
                    member this.object() = defs
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = items
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        raise (System.NotImplementedException())
            end
        let point_assemble (defs: AstImport.PointDef) : PointDefine =
            let texts = defs.children() |> List.map (fun dom -> TextContent(dom) :> Present.IDomUnit)
            PointDefine(defs, texts)


        /// 具有回退功能的元素
        type AssembleRefer<'T when 'T :> Present.Forwards and 'T :> Present.IDomUnit and 'T:> Present.IContainer>(from: string,item: 'T, page: Present.PageAccess) = 
            class
                inherit Present.Backwards(item, page)
                
                interface Present.IDomUnit with
                    member this.name() = from
                    member this.object() = item.object()
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = item.children()
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        raise (System.NotImplementedException())
            end


        type SliceDefine(defs: AstImport.SliceDef, items: Present.IDomUnit list) =
            class
                interface Present.IDomUnit with
                    member this.name(): string = defs.name()
                    member this.object() = defs
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = items
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        raise (System.NotImplementedException())
            end 
        let slice_assemble (defs: AstImport.SliceDef) : SliceDefine =
            let childs = defs.children()
                         |> List.map<AstImport.AstObject,Present.IDomUnit>(fun data ->
                            match data with
                            | :? AstImport.PointRef as refs -> refer_assemble(refs)
                            | :? AstImport.PointDef as defs -> point_assemble(defs)
                            | :? AstImport.TextItem as text -> TextContent(text)
                            | _ -> raise (System.NotImplementedException())
                         )
            SliceDefine(defs, childs)


        type StoryDefine(defs: AstImport.StoryDef, childs: Present.IDomUnit list) =
            class
                interface Present.IDomUnit with
                    member this.name(): string = 
                        defs.name()
                    member this.object() = defs
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = childs
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        raise (System.NotImplementedException())
            end
        let story_assemble (defs: AstImport.StoryDef): StoryDefine =
            let childs = defs.children()
                        |> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
                            match data with 
                            | :? AstImport.SliceDef as defs -> slice_assemble(defs)
                            | :? AstImport.TextItem as text -> TextContent(text)
                            | _ -> raise (System.NotImplementedException())
                        )
            StoryDefine(defs, childs)


        type ArticleDefine(defs: AstImport.ArticleDef, childs: Present.IDomUnit list) =
            class
                interface Present.IDomUnit with
                    member this.name(): string = 
                        defs.name()
                    member this.object() = defs
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = childs
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        raise (System.NotImplementedException())
            end
        let article_assemble (defs: AstImport.ArticleDef) : ArticleDefine =
            let childs = defs.children()
                        |> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
                            match data with 
                            | :? AstImport.TextItem as text -> TextContent(text)
                            | :? AstImport.PointRef as refs -> refer_assemble(refs)
                            | _ -> raise (System.NotImplementedException())
                        )
            ArticleDefine(defs, childs)


        type VolumeDefine(defs: AstImport.VolumeDef, childs: Present.IDomUnit list) =
            class
                interface Present.IDomUnit with
                    member this.name(): string = 
                        defs.name()
                    member this.object() = defs
                    member this.getHtmlWith(pnode: XmlElement): XmlElement = 
                        raise (System.NotImplementedException())
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = childs
                    member this.append(news: Present.IDomUnit list): Present.IContainer =
                        VolumeDefine(defs, childs@news)
            end
        let volume_assemble (defs: AstImport.VolumeDef): VolumeDefine =
            let childs = defs.children()
                        |> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
                            match data with 
                            | :? AstImport.TextItem as text -> TextContent(text)
                            | :? AstImport.ArticleDef as defs -> article_assemble(defs)
                            | _ -> raise (System.NotImplementedException())
                        )
            VolumeDefine(defs, childs)


        type UnitGenerate(root: AstImport.AstObject) =
            class
                // ast 节点序列
                let forwards_map = AstImport.branch_map_conv(root, root.members())
                // 累积结果
                let mutable result_nodes: (int*Present.IDomUnit) list = []

                interface AstImport.AstVisitor with
                    member this.visit(obj: AstImport.AstObject): bool =
                        let refs_depth = AstImport.depth_seek(forwards_map, obj)
                        let childs = result_nodes |> List.filter (fun (depth, _) -> depth > refs_depth)
                                                  |> List.map(fun (_, object) -> object)

                        let datas = match obj with
                                    | :? AstImport.TextItem as text -> 
                                        (refs_depth, TextContent(text) :> Present.IDomUnit)::result_nodes
                                    | :? AstImport.PointRef as refs ->
                                        (refs_depth, PointRefer(refs, childs))::result_nodes
                                    | :? AstImport.PointDef as defs ->
                                        (refs_depth, PointDefine(defs, childs))::result_nodes
                                    | :? AstImport.SliceDef as defs ->
                                        (refs_depth, SliceDefine(defs, childs))::result_nodes
                                    | :? AstImport.StoryDef as defs ->
                                        (refs_depth, StoryDefine(defs, childs))::result_nodes
                                    | :? AstImport.ArticleDef as defs ->
                                        (refs_depth, ArticleDefine(defs, childs))::result_nodes
                                    | :? AstImport.VolumeDef as defs ->
                                        (refs_depth, VolumeDefine(defs, childs))::result_nodes
                                    | :? AstImport.Program -> result_nodes
                                    | _ -> raise (System.NotImplementedException())

                        result_nodes <- datas
                        if refs_depth > 0 then
                            result_nodes <- result_nodes |> List.filter(fun (depth, _) -> depth <= refs_depth)
                        true

                member this.contents() =
                    result_nodes |> List.map(fun (_, obj) -> obj)
            end


    /// 内容组装 =========================================================================================
    module Assemble =
        /// 构建页面名称
        let page_address_make(node: Present.IDomUnit): string =
            let name_seqs = $"{node.name()}_{node.object().address()}".ToCharArray() |> Array.map(fun c-> string(uint16(c)))
            name_seqs |> Array.reduce(fun a b-> a+b)

        /// 构建所有卷宗页面
        let rec volume_page_assemble (nodes: Present.IDomUnit list): Present.VolumePage list =
            match nodes with 
            | [] -> []
            | _ ->
                match nodes.Head with
                | :? Content.VolumeDefine as vole -> 
                    let con: Present.IContainer = vole
                    Present.VolumePage(page_address_make(vole), vole, con.children())::volume_page_assemble(nodes.Tail)
                | _ -> volume_page_assemble(nodes.Tail)

        /// 构建所有故事线页面
        let rec story_page_assemble (nodes: Present.IDomUnit list): Present.StoryPage list =
            match nodes with
            | [] -> []
            | _ -> 
                match nodes.Head with
                | :? Content.StoryDefine as storye ->
                    let con: Present.IContainer = storye
                    Present.StoryPage(page_address_make(storye), storye, con.children())::story_page_assemble(nodes.Tail)
                | _ -> story_page_assemble(nodes.Tail)

        /// 提取point-define和point-refer
        let rec private point_peers_extract(nodes: Present.IDomUnit list):(Present.IDomUnit option*Present.IDomUnit option*Present.IDomUnit option)list =
            match nodes with 
            | [] -> []
            | _ -> 
                let head_data = nodes.Head
                match head_data with
                | :? Content.StoryDefine as story_e ->
                    let con = story_e :> Present.IContainer
                    let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
                    items |> List.map(
                        fun (x, y, z)->
                            match x with
                            | None -> (Some(story_e :> Present.IDomUnit), y, z)
                            | _ -> (x, y, z)
                        )
                | :? Present.StoryPage as story_e ->
                    let con = story_e :> Present.IContainer
                    let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
                    items |> List.map(
                        fun (x, y, z)->
                            match x with
                            | None -> (Some(story_e :> Present.IDomUnit), y, z)
                            | _ -> (x, y, z)
                        )
               
                | :? Content.VolumeDefine as volume_e ->
                    let con = volume_e :> Present.IContainer
                    let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
                    items |> List.map (
                        fun (x, y, z) -> 
                            match x with
                            | None -> (Some(volume_e), y, z)
                            | _ -> (x, y, z)
                        )
                | :? Present.VolumePage as volume_e ->
                    let con = volume_e :> Present.IContainer
                    let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
                    items |> List.map (
                        fun (x, y, z) -> 
                            match x with
                            | None -> (Some(volume_e), y, z)
                            | _ -> (x, y, z)
                        )
                
                | :? Content.SliceDefine as slice_e ->
                    let con = slice_e :> Present.IContainer
                    let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
                    items |> List.map(
                        fun (x, y, z) ->
                            match y with 
                            | None -> (x, Some(slice_e:> Present.IDomUnit), z)
                            | _ -> (x, y, z)
                        )
                
                | :? Content.ArticleDefine as article_e ->
                    let con = article_e :> Present.IContainer
                    let items = point_peers_extract(con.children())@point_peers_extract(nodes.Tail)
                    items |> List.map(
                        fun (x, y, z) ->
                            match y with
                            | None -> (x, Some(article_e), z)
                            | _ -> (x, y, z)
                        )
                
                | :? Content.PointRefer as refer_e ->
                    let ast_obj = refer_e :> Present.IDomUnit
                    let refer = ast_obj.object() :?> AstImport.PointRef
                    (None, None, Some(refer_e :> Present.IDomUnit))::point_peers_extract(nodes.Tail)
                | :? Content.PointDefine as define_e ->
                    let ast_obj = define_e :> Present.IDomUnit
                    (None, None, Some(define_e))::point_peers_extract(nodes.Tail)
                | _ -> point_peers_extract(nodes.Tail)

        /// 构建节点汇总页面
        /// param nodes volume-pages@story-pages
        let rec point_page_assemble(nodes: Present.IDomUnit list) =
            let refers_about = point_peers_extract(nodes)
            let pages = refers_about |> List.map (
                            fun (page_defs, slice_defs, point_defs) ->
                                match point_defs.Value with 
                                | :? Content.PointDefine as defs ->
                                    let name_seqs = $"{page_defs.Value.name()}&{slice_defs.Value.name()}&{point_defs.Value.name()}"
                                    let refer_point = Content.AssembleRefer<Content.PointDefine>(name_seqs, defs, page_defs.Value :?> Present.StoryPage)
                                    let page_assemble = Present.PointPage(page_address_make(defs), refer_point)
                                    defs.setAssembleURL(page_assemble.accessLink())
                                    Some(page_assemble)
                                | _ -> None
                            )
                        |> List.filter (fun d -> d <> None)

            let refer_nodes = refers_about |> List.filter(
                                fun (_, _, n) -> 
                                    match n.Value with
                                    | :? Content.PointRefer -> true
                                    | _ -> false
                                )
                                |> List.map(
                                fun (page_defs, _, point_refs) ->
                                    let refer_object = point_refs.Value.object() :?> AstImport.PointRef
                                    let refer_name = $"{refer_object.storyRef()}&{refer_object.sliceRef()}&{refer_object.pointRef()}"
                                    let refs = point_refs.Value :?> Content.PointRefer
                                    Content.AssembleRefer<Content.PointRefer>(refer_name, refs, page_defs.Value :?> Present.PageAccess)
                                )


            pages   |> List.map(
                        fun page_one -> 
                            let page_old = page_one.Value :> Present.IContainer
                            let page_dom = page_one.Value :> Present.IDomUnit
                            let nodes = refer_nodes |> List.filter(fun d -> (d:>Present.IDomUnit).name() = page_dom.name())
                            page_old.append(nodes |> List.map<Content.AssembleRefer<Content.PointRefer>, Present.IDomUnit> (fun x->x))
                        )