WsParser_VS/AstConv/HtmlStruct.fs

namespace HtmlStruct

open AstAccess
open System.Xml
open System
open System.IO

    /// 展现节点 =========================================================================================
    module Present =

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

        /// 可访问页面
        type PageAccess(name: string) =
            class
                let mutable root: string = ""
                member this.pageURL(): string = $"{root}{name}.html"
                member this.setPageRoot(path: Uri) =
                    if path.AbsolutePath.EndsWith "/" then
                        root <- path.AbsolutePath
                    else
                        root <- path.AbsolutePath + "/"
            end

        /// 内容定义元素 =================================================================================
        type Forwards(item: AstImport.AstObject) =
            class
                let mutable defines_page: Option<PageAccess> = None
                let mutable assemble_page: Option<PageAccess> = None

                member this.elementID(): string = item.address()
                /// 节点定义页面，本元素完整URL
                member this.definedURL(): string =
                    match defines_page with
                    | Some v -> $"{v.pageURL()}#{this.elementID()}"
                    | None -> failwith "节点元素定义页面配置错误"
                member this.setDefines(page: PageAccess) =
                    defines_page <- Some(page)

                /// 节点汇集页面，本元素完整URL
                member this.assembleURL():string =
                    match assemble_page with
                    | Some v -> $"{v.pageURL()}#{this.elementID()}"
                    | None -> failwith "节点元素汇集页面配置错误"
                member this.setAssemble(page: PageAccess) =
                    assemble_page <- Some(page)
            end
            
        /// 回访定义元素 =================================================================================
        type Backwards(bind_item: Forwards, refer_anchor: string) =
            class
                member this.defsElement() =
                    bind_item
                member this.elementID(): string =
                    bind_item.elementID()
                member this.backwardsLink(): string =
                    bind_item.definedURL()
                member this.referAnchor(): string = refer_anchor
            end


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

                interface IDomUnit with
                    member this.name():string = volume.name()
                    member this.object() = 
                        volume.object()

                interface IContainer with
                    member this.children(): IDomUnit list = childs
                    member this.append(new_list: IDomUnit list): IContainer =
                        VolumePage(page_name, volume, childs@new_list)
            end

        type StoryPage(page_name: string, story: IDomUnit, childs: IDomUnit list) =
            class
                inherit PageAccess(page_name)
                new(page_name, story) = StoryPage(page_name, story, [])
                
                interface IDomUnit with
                    member this.name():string = story.name()
                    member this.object() =
                        story.object()

                interface IContainer with
                    member this.children(): IDomUnit list = childs
                    member this.append(list: IDomUnit list): IContainer =
                        StoryPage(page_name, story, childs@list)
            end

        type PointPage(page_name: string, point: IDomUnit, refer_list: IDomUnit list) =
            class
                inherit PageAccess(page_name)
                new(page_name, point) = PointPage(page_name, point, [])

                member this.defines() = 
                    point
                
                interface IDomUnit with
                    member this.name():string = point.name()
                    member this.object() = point.object()

                interface IContainer with
                    member this.children(): IDomUnit list = refer_list
                    member this.append(childs: IDomUnit list): IContainer =
                        PointPage(page_name, 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
            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
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = items
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        failwith "append"
            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
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = items
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        failwith "append"
            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>(item: 'T, refer_anchor: string) = 
            class
                inherit Present.Backwards(item, refer_anchor)
                
                interface Present.IDomUnit with
                    member this.name() = refer_anchor
                    member this.object() = item.object()
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = item.children()
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        failwith "append"
            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
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = items
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        failwith "append"
            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)
                            | _ -> failwith "match error"
                         )
            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
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = childs
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        failwith "append"
            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)
                            | _ -> failwith "match error"
                        )
            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
                        
                interface Present.IContainer with
                    member this.children(): Present.IDomUnit list = childs
                    member this.append(childs: Present.IDomUnit list): Present.IContainer =
                        failwith "append"
            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)
                            | _ -> failwith "match error"
                        )
            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
                        
                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)
                            | _ -> failwith "match error"
                        )
            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 -> 
                                        result_nodes@[(refs_depth, TextContent(text) :> Present.IDomUnit)]
                                    | :? AstImport.PointRef as refs ->
                                        result_nodes@[(refs_depth, PointRefer(refs, childs))]
                                    | :? AstImport.PointDef as defs ->
                                        result_nodes@[(refs_depth, PointDefine(defs, childs))]
                                    | :? AstImport.SliceDef as defs ->
                                        result_nodes@[(refs_depth, SliceDefine(defs, childs))]
                                    | :? AstImport.StoryDef as defs ->
                                        result_nodes@[(refs_depth, StoryDefine(defs, childs))]
                                    | :? AstImport.ArticleDef as defs ->
                                        result_nodes@[(refs_depth, ArticleDefine(defs, childs))]
                                    | :? AstImport.VolumeDef as defs ->
                                        result_nodes@[(refs_depth, VolumeDefine(defs, childs))]
                                    | :? AstImport.Program -> result_nodes
                                    | _ -> failwith "match error"

                        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_name_encode(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_name_encode(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_name_encode(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(pages: Present.IDomUnit list) =
            let checked_list = pages |> List.filter(
                            fun it -> 
                                match it with
                                | :? Present.PageAccess -> true
                                | _ -> false
                            )
            if checked_list.Length <> pages.Length then
                failwith "传入的参数pages必须是PageAccess的子类集合"


            let points_about= point_peers_extract(pages)
            // 所有的节点关联定义页面
            points_about |> List.iter (
                            fun (page, midx, deref) ->
                                match deref.Value with 
                                | :? Present.Forwards as forwards_elm ->
                                    let page_def = page.Value :?> Present.PageAccess
                                    forwards_elm.setDefines(page_def)
                                | _ -> failwith "point_peers_extract结果类型错误"
                            )
            let refer_nodes = points_about |> List.filter(
                                fun (_, _, n) -> 
                                    match n.Value with
                                    | :? Content.PointRefer -> true
                                    | _ -> false
                                )
                                |> List.map(
                                fun (page_defs, mid_defs, point_refs) ->
                                    let refn = point_refs.Value.object() :?> AstImport.PointRef
                                    let refer_name = $"{page_defs.Value.name()}&{mid_defs.Value.name()}@<this>"
                                    let refs = point_refs.Value :?> Content.PointRefer
                                    $"{refn.storyRef()}&{refn.sliceRef()}&{refn.pointRef()}", Content.AssembleRefer<Content.PointRefer>(refs, refer_name)
                                )

            // 构建节点汇集页面
            let pages = points_about |> List.filter(
                            fun (_, _, n) ->
                                match n.Value with 
                                | :? Content.PointDefine -> true
                                | _ -> false
                            )
                            |> List.map (
                            fun (page_defs, slice_defs, point_defs) ->
                                let defs = point_defs.Value :?> Content.PointDefine
                                let name_seqs = $"{page_defs.Value.name()}&{slice_defs.Value.name()}&{point_defs.Value.name()}"
                                let refer_point = Content.AssembleRefer<Content.PointDefine>(defs, name_seqs)
                                let page_assemble = Present.PointPage(page_name_encode(defs), refer_point)
                                defs.setAssemble(page_assemble)
                                name_seqs,page_assemble
                            )

            pages |> List.map(
                        fun (key, page_one) -> 
                            let page_old = page_one :> Present.IContainer
                            let page_dom = page_one :> Present.IDomUnit
                            let nodes = refer_nodes |> List.filter(fun (k, _) -> k = key)
                            nodes |> List.iter (fun (_, data) -> data.defsElement().setAssemble(page_one))
                            let p = page_old.append(page_dom::(nodes |> List.map(fun (_, x)->x :> Present.IDomUnit)))
                            p :?> Present.IDomUnit
                        )

        type PageText =
            interface
                abstract member bindPage:unit ->obj
                abstract member getHtmlText:unit -> string
            end

        type PageMaker<'T when 
            'T :> Present.PageAccess and
            'T :> Present.IDomUnit and 
            'T :> Present.IContainer>(page: 'T) =
            class
                member this.getHtmlDocument(): XmlDocument =
                    let doc = XmlDocument()

                    let doc_type = doc.CreateDocumentType("html", null, null, null)
                    doc.AppendChild(doc_type) |> ignore

                    let html = doc.CreateElement("html")
                    let head = doc.CreateElement("head")
                    let charset = doc.CreateElement("meta")
                    charset.SetAttribute("charset", "UTF-8")
                    head.AppendChild(charset) |> ignore

                    let title = doc.CreateElement("title")
                    title.AppendChild(doc.CreateTextNode(page.name())) |> ignore
                    head.AppendChild(title) |> ignore

                    let style = doc.CreateElement("style")
                    style.AppendChild(doc.CreateTextNode("""body{
			background-color:lightgray;
		}
		
		h1 {
			margin-left:300px;
			margin-top: 50px;
			margin-bottom: 30px;
		}
		div.outline
		{
			max-width:90%;
			#outline:green dotted thick;
			margin:auto;
			display:flex;
			background-color:#f0f0f0;
		}
		div#left-nav
		{
			min-width:30%;
			max-width:30%;
			
			# border:1px solid red;
			# outline:green dotted thick;
			overflow:clip;
			padding:20px;
			background-image: linear-gradient(
				to right,
				#e0e0e0 0%,
				#ffffff 100%
			);
		}
		div#left-nav p {
			word-wrap:break-word;
			text-align:right;
		}
		
		div.content {
			padding: 20px;
			max-width: 90%;
            outline: #e0e0e0 solid 1px;
            box-shadow: 2px 2px 2px gray;
		}
		.content p {
			word-wrap:break-word;
		}
                        img {
                            max-width:100%;
                        }
                    """)) |> ignore
                    head.AppendChild(style) |> ignore

                    html.AppendChild(head) |> ignore
                    doc.AppendChild(html) |> ignore

                    let body = doc.CreateElement("body")
                    html.AppendChild(body) |> ignore

                    let h1 = doc.CreateElement("h1")
                    h1.AppendChild(doc.CreateTextNode(page.name())) |> ignore
                    body.AppendChild(h1) |> ignore

                    let div_outline = doc.CreateElement("div")
                    div_outline.SetAttribute("class", "outline")
                    body.AppendChild(div_outline) |> ignore

                    let div_nav = doc.CreateElement("div")
                    div_nav.SetAttribute("id", "left-nav")
                    div_outline.AppendChild(div_nav) |> ignore
                    this.initNavigate(div_nav) |> ignore

                    let div_content = doc.CreateElement("div")
                    div_content.SetAttribute("id", "content")
                    div_content.SetAttribute("class", "content")
                    div_outline.AppendChild(div_content) |> ignore
                    this.contentAppend(div_content, page.children())

                    doc

                member this.initNavigate(nav: XmlElement):XmlElement =
                    let rec nav_items_expand(nav: XmlElement, items: (Present.IDomUnit option*Present.IDomUnit option*Present.IDomUnit option) list) =
                        match items with 
                        | [] -> ()
                        | _ -> 
                            let doc_o = nav.OwnerDocument
                            let (_, _, head) = items.Head
                            match head.Value with
                            | :? Present.Forwards as fx ->
                                let p = doc_o.CreateElement("p")
                                let a = doc_o.CreateElement("a")
                                a.SetAttribute("href", $"#{fx.elementID()}")
                                a.AppendChild(doc_o.CreateTextNode(head.Value.name())) |> ignore
                                p.AppendChild(a) |> ignore
                                nav.AppendChild(p) |> ignore
                            | :? Present.Backwards as bx ->
                                let p = doc_o.CreateElement("p")
                                let a = doc_o.CreateElement("a")
                                a.SetAttribute("href", $"#{bx.elementID()}")
                                a.AppendChild(doc_o.CreateTextNode(head.Value.name())) |> ignore
                                p.AppendChild(a) |> ignore
                                nav.AppendChild(p) |> ignore
                            | _ -> ()

                            nav_items_expand(nav, items.Tail)

                    let objp = page :> obj
                    let point_peers = if (objp :? Present.PointPage) then
                                          (objp :?>Present.PointPage).defines()::page.children() |> List.map(fun x-> None, None, Some(x))
                                      else
                                          point_peers_extract(page.children())

                    match point_peers with
                    | [] -> 
                        let empty = nav.OwnerDocument.CreateElement("p")
                        empty.AppendChild(nav.OwnerDocument.CreateTextNode("当前文档无索引")) |> ignore
                        nav.AppendChild(empty) |> ignore
                    | _ ->
                        nav_items_expand(nav, point_peers)

                    nav

                member this.contentAppend(pnode: XmlElement, contents: Present.IDomUnit list) =
                    let vdoc = pnode.OwnerDocument
                    match contents with 
                    | [] -> ()
                    | _ -> 
                        match contents.Head with
                        | :? Content.TextContent ->
                            let text_ast = contents.Head.object() :?> AstImport.TextItem
                            let text_line = contents.Tail |> List.filter(
                                            fun content_item->
                                                match content_item with
                                                | :? Content.TextContent ->
                                                    let curr_ast = content_item.object() :?> AstImport.TextItem
                                                    curr_ast.row() = text_ast.row()
                                                | _ -> false
                                            )
                            let one_line = contents.Head::text_line
                            let p = vdoc.CreateElement("p")
                            for t in one_line do
                                let text_content = t.object() :?> AstImport.TextItem
                                let content = text_content.content()
                                p.AppendChild(vdoc.CreateTextNode(content)) |> ignore
                            pnode.AppendChild(p) |> ignore
                            this.contentAppend(pnode, List.skip one_line.Length contents)

                        | :? Content.SliceDefine as slice_defs->
                            let div_slice = vdoc.CreateElement("div")
                            div_slice.SetAttribute("data-type", "slice")
                            div_slice.SetAttribute("class", "content")
                            let slice_title = vdoc.CreateElement("h3")
                            slice_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
                            div_slice.AppendChild(slice_title) |> ignore
                            pnode.AppendChild(div_slice) |> ignore
                            let slice_con = slice_defs :> Present.IContainer
                            this.contentAppend(div_slice, slice_con.children())
                            this.contentAppend(pnode, contents.Tail)

                        | :? Content.ArticleDefine as article_defs ->
                            let div_article = vdoc.CreateElement("div")
                            div_article.SetAttribute("data-type", "article")
                            div_article.SetAttribute("class", "content")
                            let article_title = vdoc.CreateElement("h3")
                            article_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
                            div_article.AppendChild(article_title) |> ignore
                            pnode.AppendChild(div_article) |> ignore
                            let article_con = article_defs :> Present.IContainer
                            this.contentAppend(div_article, article_con.children())
                            this.contentAppend(pnode, contents.Tail)

                        | :? Present.PointPage as page_point ->
                            let page_defs = page_point.defines() :?> Content.AssembleRefer<Content.PointDefine>
                            this.contentAppend(pnode, [page_defs])
                            this.contentAppend(pnode, contents.Tail)
                            

                        | :? Present.Forwards as object_defs ->
                            let type_name = match object_defs with
                                            | :? Content.PointDefine -> "point"
                                            | :? Content.PointRefer -> "refer"
                                            | _ -> failwith "type mismatch"

                            let div_forwards = vdoc.CreateElement("div")
                            div_forwards.SetAttribute("data-type", type_name)
                            div_forwards.SetAttribute("class", "content")
                            
                            let define_title = vdoc.CreateElement("h3")
                            define_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
                            div_forwards.AppendChild(define_title) |> ignore
                            let define_a = vdoc.CreateElement("a")
                            define_a.SetAttribute("id", object_defs.elementID())
                            define_a.SetAttribute("href", object_defs.assembleURL())
                            define_a.AppendChild(define_title) |> ignore
                            div_forwards.AppendChild(define_a) |> ignore

                            pnode.AppendChild(div_forwards) |> ignore
                            let point_con = contents.Head :?> Present.IContainer
                            this.contentAppend(div_forwards, point_con.children())
                            this.contentAppend(pnode, contents.Tail)

                        | :? Present.Backwards as object_backs ->
                            let div_backwards = vdoc.CreateElement("div")
                            div_backwards.SetAttribute("data-type", "assemble")
                            div_backwards.SetAttribute("class", "content")
                            
                            let define_title = vdoc.CreateElement("h3")
                            define_title.AppendChild(vdoc.CreateTextNode(contents.Head.name())) |> ignore
                            div_backwards.AppendChild(define_title) |> ignore
                            let define_a = vdoc.CreateElement("a")
                            define_a.SetAttribute("id", object_backs.elementID())
                            define_a.SetAttribute("href", object_backs.backwardsLink())
                            define_a.AppendChild(define_title) |> ignore
                            div_backwards.AppendChild(define_a) |> ignore

                            pnode.AppendChild(div_backwards) |> ignore
                            let point_con = contents.Head :?> Present.IContainer
                            this.contentAppend(div_backwards, point_con.children())
                            this.contentAppend(pnode, contents.Tail)

                        | _ -> ()
            
                interface PageText with
                    member this.bindPage():obj =
                        page

                    member this.getHtmlText(): string =
                        let doc = this.getHtmlDocument()

                        let out = new StringWriter()
                        let writer = new XmlTextWriter(out)
                        writer.Formatting = Formatting.Indented |> ignore
                        doc.WriteTo(writer)
                        writer.Flush()
                        out.ToString()
            end

        type IndexPage(name: string, childs: Present.IDomUnit list) =
            class
                inherit Present.PageAccess("index")
                new(name) = IndexPage(name, [])

                member this.append(arg: Present.IDomUnit list) =
                    IndexPage(name, childs @ arg)

                interface Present.IDomUnit with
                    member this.name(): string = name
                    member this.object(): AstImport.AstObject = 
                        raise (System.NotImplementedException())

                interface PageText with
                    member this.bindPage(): obj = this
                    member this.getHtmlText(): string = 
                        let doc = XmlDocument()

                        let doc_type = doc.CreateDocumentType("html", null, null, null)
                        doc.AppendChild(doc_type) |> ignore

                        let html = doc.CreateElement("html")
                        let head = doc.CreateElement("head")
                        let charset = doc.CreateElement("meta")
                        charset.SetAttribute("charset", "UTF-8")
                        head.AppendChild(charset) |> ignore

                        let title = doc.CreateElement("title")
                        title.AppendChild(doc.CreateTextNode(name)) |> ignore
                        head.AppendChild(title) |> ignore

                        let style = doc.CreateElement("style")
                        style.AppendChild(doc.CreateTextNode("""body{
            	    		background-color:lightgray;
                		}
		
                		h1 {
			                margin-left:300px;
                			margin-top: 50px;
			                margin-bottom: 30px;
		                }
                		div.outline {
                			max-width:90%;
			                #outline:green dotted thick;
                  			margin:auto;
                			display:flex;
                			background-color:#f0f0f0;
                		}
                		div#left-nav{
                			min-width:30%;
			                max-width:30%;
			
                			# border:1px solid red;
                			# outline:green dotted thick;
                			overflow:clip;
                			padding:20px;
                			background-image: linear-gradient(
            	    			to right,
            		    		#e0e0e0 0%,
            			    	#ffffff 100%
               			    );
                		}
                		div#left-nav p {
            	    		word-wrap:break-word;
			                text-align:right;
                		}
		
                		div.content {
                            padding: 20px;
                			max-width: 90%;
                            outline: #e0e0e0 solid 1px;
                            box-shadow: 2px 2px 2px gray;
		                }
                   		.content p {
                			word-wrap:break-word;
		                }
                        img {
                            max-width:100%;
                        }
                        """)) |> ignore
                        head.AppendChild(style) |> ignore

                        html.AppendChild(head) |> ignore
                        doc.AppendChild(html) |> ignore

                        let body = doc.CreateElement("body")
                        html.AppendChild(body) |> ignore

                        let h1 = doc.CreateElement("h1")
                        h1.AppendChild(doc.CreateTextNode(name)) |> ignore
                        body.AppendChild(h1) |> ignore

                        let div_outline = doc.CreateElement("div")
                        div_outline.SetAttribute("class", "outline")
                        body.AppendChild(div_outline) |> ignore

                        let div_nav = doc.CreateElement("div")
                        div_nav.SetAttribute("id", "left-nav")
                        div_outline.AppendChild(div_nav) |> ignore
                        this.initNavigate(div_nav) |> ignore

                        let div_content = doc.CreateElement("div")
                        div_content.SetAttribute("id", "content")
                        div_content.SetAttribute("class", "content")
                        div_outline.AppendChild(div_content) |> ignore
                        this.contentAppend(div_content, childs)

                        let out = new StringWriter()
                        let writer = new XmlTextWriter(out)
                        writer.Formatting = Formatting.Indented |> ignore
                        doc.WriteTo(writer)
                        writer.Flush()
                        out.ToString()

                member this.initNavigate(nav: XmlElement): unit =
                    let vdoc = nav.OwnerDocument
                    let p1 = vdoc.CreateElement("p")
                    let a1 = vdoc.CreateElement("a")
                    a1.SetAttribute("href", "#volume");
                    a1.AppendChild(vdoc.CreateTextNode("卷宗组织")) |> ignore
                    p1.AppendChild(a1) |> ignore
                    nav.AppendChild(p1) |> ignore

                    let p2 = vdoc.CreateElement("p")
                    let a2 = vdoc.CreateElement("a")
                    a2.SetAttribute("href", "#story");
                    a2.AppendChild(vdoc.CreateTextNode("故事脉络")) |> ignore
                    p2.AppendChild(a2) |> ignore
                    nav.AppendChild(p2) |> ignore

                    let p4 = vdoc.CreateElement("p")
                    let a4 = vdoc.CreateElement("a")
                    a4.SetAttribute("href", "#story-graph");
                    a4.AppendChild(vdoc.CreateTextNode("脉络图示")) |> ignore
                    p4.AppendChild(a4) |> ignore
                    nav.AppendChild(p4) |> ignore

                    let p3 = vdoc.CreateElement("p")
                    let a3 = vdoc.CreateElement("a")
                    a3.SetAttribute("href", "#volume-graph");
                    a3.AppendChild(vdoc.CreateTextNode("卷宗图示")) |> ignore
                    p3.AppendChild(a3) |> ignore
                    nav.AppendChild(p3) |> ignore
                    
                member this.contentAppend(content: XmlElement, childs: Present.IDomUnit list): unit =
                    let vdoc = content.OwnerDocument
                    // volume汇总
                    let div_volume = vdoc.CreateElement("div")
                    div_volume.SetAttribute("data-type", "volume")
                    div_volume.SetAttribute("class", "content")
                    let volume_title = vdoc.CreateElement("h3")
                    volume_title.SetAttribute("id", "volume")
                    volume_title.AppendChild(vdoc.CreateTextNode("卷宗组织")) |> ignore
                    div_volume.AppendChild(volume_title) |> ignore
                    content.AppendChild(div_volume) |> ignore
                    for p in childs do
                        match p with
                        | :? Present.VolumePage ->
                            let div_page = vdoc.CreateElement("div")
                            let page_a = vdoc.CreateElement("a")
                            let page_bind = p :?> Present.PageAccess
                            page_a.SetAttribute("href", page_bind.pageURL())
                            page_a.AppendChild(vdoc.CreateTextNode(p.name())) |> ignore
                            div_page.AppendChild(page_a) |> ignore
                            div_volume.AppendChild(div_page) |> ignore
                        | _ -> ()

                    // story汇总
                    let div_story = vdoc.CreateElement("div")
                    div_story.SetAttribute("data-type", "story")
                    div_story.SetAttribute("class", "content")
                    let story_title = vdoc.CreateElement("h3")
                    story_title.SetAttribute("id", "story")
                    story_title.AppendChild(vdoc.CreateTextNode("故事脉络")) |> ignore
                    div_story.AppendChild(story_title) |> ignore
                    content.AppendChild(div_story) |> ignore
                    for p in childs do
                        match p with
                        | :? Present.StoryPage ->
                            let div_page = vdoc.CreateElement("div")
                            let page_a = vdoc.CreateElement("a")
                            let page_bind = p :?> Present.PageAccess
                            page_a.SetAttribute("href", page_bind.pageURL())
                            page_a.AppendChild(vdoc.CreateTextNode(p.name())) |> ignore
                            div_page.AppendChild(page_a) |> ignore
                            div_story.AppendChild(div_page) |> ignore
                        | _ -> ()

                    // storylines 网络图
                    let div_story_svg = vdoc.CreateElement("div")
                    div_story_svg.SetAttribute("data-type", "story_svg")
                    div_story_svg.SetAttribute("id", "story-graph")
                    let story_h3 = vdoc.CreateElement("h3")
                    story_h3.AppendChild(vdoc.CreateTextNode("脉络图示")) |> ignore
                    div_story_svg.AppendChild(story_h3) |> ignore
                    let image = vdoc.CreateElement("img")
                    image.SetAttribute("src", "./storys_display.svg")
                    div_story_svg.AppendChild(image) |> ignore
                    content.AppendChild(div_story_svg) |> ignore

                    // volumes 引用图
                    let div_volume_svg = vdoc.CreateElement("div")
                    div_volume_svg.SetAttribute("data-type", "volume_svg")
                    div_volume_svg.SetAttribute("id", "volume-graph")
                    let volume_h3 = vdoc.CreateElement("h3")
                    volume_h3.AppendChild(vdoc.CreateTextNode("卷宗图示")) |> ignore
                    div_volume_svg.AppendChild(volume_h3) |> ignore
                    let image2 = vdoc.CreateElement("img")
                    image2.SetAttribute("src", "./volume_display.svg")
                    div_volume_svg.AppendChild(image2) |> ignore
                    content.AppendChild(div_volume_svg) |> ignore
            end




        type StorylineGraphMake(gname:string, items: Present.PageAccess list) =
            class
                let lines = items |> List.filter(fun v-> v :? Present.StoryPage) 
                                       |> List.map(fun v->v:?>Present.StoryPage)
                                       |> List.map(fun s->s :> Present.IDomUnit)
                                       |> List.map(fun s->s.object() :?> AstImport.StoryDef)

                member private this.node_collect(objs: AstImport.AstObject list) =
                    match objs with 
                    | [] -> []
                    | _ -> 
                        match objs.Head with 
                        | :? AstImport.StoryDef as story ->
                            let list_a = this.node_collect(story.children())
                            (list_a|> List.map(fun (_, b, c) -> Some(story), b, c))@this.node_collect(objs.Tail)
                        | :? AstImport.SliceDef as slice ->
                            let list_a = this.node_collect(slice.children())
                            (list_a|> List.map(fun (_, _, c) -> None, Some(slice), c))@this.node_collect(objs.Tail)
                        | :? AstImport.PointDef as point ->
                            (None, None, point :> AstImport.AstObject)::this.node_collect(objs.Tail)
                        | :? AstImport.PointRef as refer ->
                            (None, None, refer)::this.node_collect(objs.Tail)
                        | _ -> this.node_collect(objs.Tail)

                member this.getGraphCode(): string =
                    let node_about = this.node_collect(lines|> List.map(fun d -> d :> AstImport.AstObject))
                    
                    // 获取节点字典
                    let node_map = node_about|> List.filter(fun (_, _, c) -> c :? AstImport.PointDef)
                                        |> List.map(
                                            fun (a, b, c) ->
                                                $"{a.Value.name()}&{b.Value.name()}&{(c:?>AstImport.PointDef).name()}", c.address()
                                            )


                    // 节点声明
                    let story_decl = lines  |> List.map(fun story -> 
                                                    $"""node_{story.address()}[label="{story.name()}" shape="cds"]""")
                                            |> List.reduce(fun a b -> a + "\n" + b)
                    let points_decl = node_about |> List.map(fun (_, _, point) ->
                                                    match point with 
                                                    | :? AstImport.PointDef as def->
                                                        $"""node_{point.address()}[label="{def.name()}" shape="rect"]"""
                                                    | :? AstImport.PointRef as ref ->
                                                        $"""node_{point.address()}[label="{ref.pointRef()}" style="dotted"]"""
                                                    | _ -> failwith "mismatch"
                                                )
                                               |> List.reduce(fun a b -> a + "\n" + b)
                    let nodes_decl = story_decl + points_decl


                    // 提取所有情节声明
                    let slice_nodes = node_about|> List.map(fun (a, b, _)->a.Value,b.Value)|> List.distinctBy(fun (_, b) -> b.address())
                    let rec get_slice_decl = fun (slices_t: (AstImport.StoryDef*AstImport.SliceDef) list)->
                        match slices_t with 
                        | [] -> []
                        | _ -> 
                            let story, slice = slices_t.Head
                            let slice_childs = node_about
                                                |> List.filter(
                                                    fun (_, b, _) ->
                                                        slice.address() = b.Value.address()
                                                    )
                                                |> List.map(fun (_, _, n) -> $"node_{n.address()}")
                                                |> List.reduce(fun a b -> $"{a}->{b}")

                            let slice_def = $"""subgraph cluster_{slice.address()}{{ label="{story.name()}::{slice.name()}" {slice_childs} }}"""
                            slice_def::get_slice_decl(slices_t.Tail)
                    let slice_relates = get_slice_decl(slice_nodes)|> List.reduce(fun a b -> a + "\n" + b)


                    // 构建引用指向
                    let refer_nodes = node_about|> List.filter(fun (_, _, n) -> n:? AstImport.PointRef)
                                                |> List.map(fun (_, _, n) -> n :?> AstImport.PointRef)
                    let rec get_refer_decl = fun(list_def: (string*string)list) ->
                        match list_def with
                        | [] -> []
                        | _ -> 
                            let node_name,node_addr = list_def.Head
                            let refers_about = refer_nodes|> List.filter(fun d -> node_name = $"{d.storyRef()}&{d.sliceRef()}&{d.pointRef()}")
                            match refers_about with
                            | [] -> get_refer_decl(list_def.Tail)
                            | _ ->
                                let refer_arrows = refers_about|> List.map(fun d -> $"node_{d.address()}->node_{node_addr}")
                                                               |> List.reduce(fun a b -> a + "\n" + b)
                                refer_arrows::get_refer_decl(list_def.Tail)
                    let refer_arrows = get_refer_decl(node_map)|> List.reduce(fun a b -> a + "\n" + b)


                    // 串联情节
                    let rec slice_combine = fun(items: AstImport.AstObject list) ->
                        match items with
                        | [] -> []
                        | _ ->
                            match items.Head with
                            | :? AstImport.SliceDef as defs ->
                                let points = defs.children()|> List.filter(fun d -> not(d :? AstImport.TextItem))
                                match points with
                                | [] -> slice_combine(items.Tail)
                                | _ ->
                                    (points.Head, points.Item(points.Length-1))::slice_combine(items.Tail)
                            | :? AstImport.StoryDef as defs ->
                                slice_combine(defs.children())
                            | _ -> slice_combine(items.Tail)
                    let story_arrows =  lines |> List.map(fun story ->
                                            let slice_ends = slice_combine([story])
                                            match slice_ends with
                                            | [] -> ""
                                            | _ ->
                                                let arrow_link = slice_ends |> List.map(fun (a,b) -> $"node_{a.address()} node_{b.address()}")
                                                                            |> List.reduce(fun a b -> $"{a}->{b}")
                                                $"""node_{story.address()}->{arrow_link}"""
                                        )
                                        |> List.reduce(fun a b -> a + "\n" + b)

                    $"""digraph node_relates{{
                        rankdir=LR
                        label="{gname}"
                        {nodes_decl}
                        {slice_relates}
                        {refer_arrows}
                        {story_arrows}
                    }}"""
            end

        type VolumeGraphMake(gname: string, story_volume_set: Present.PageAccess list) =
            class
                member private this.node_collect(objs: AstImport.AstObject list) =
                    match objs with 
                    | [] -> []
                    | _ -> 
                        match objs.Head with
                        | :? AstImport.StoryDef as story ->
                            let list = this.node_collect(story.children())
                            (list|> List.map(fun (_, b, c) -> Some(story :> AstImport.AstObject), b, c))@this.node_collect(objs.Tail)
                        | :? AstImport.SliceDef as slice ->
                            let list = this.node_collect(slice.children())
                            (list|> List.map(fun (_, _, c) -> None, Some(slice :> AstImport.AstObject), c))@this.node_collect(objs.Tail)
                        | :? AstImport.VolumeDef as volume ->
                            let list = this.node_collect(volume.children())
                            (list|> List.map(fun (_, b, c) -> Some(volume), b, c))@this.node_collect(objs.Tail)
                        | :? AstImport.ArticleDef as article ->
                            let list = this.node_collect(article.children())
                            (list|> List.map(fun (_, _, c) -> None, Some(article), c))@this.node_collect(objs.Tail)
                        | :? AstImport.PointDef as point ->
                            (None, None, point :> AstImport.AstObject)::this.node_collect(objs.Tail)
                        | :? AstImport.PointRef as refer ->
                            (None, None, refer)::this.node_collect(objs.Tail)
                        | _ -> this.node_collect(objs.Tail)

                member this.getGraphCode(): string = 
                    let storys = story_volume_set
                                |> List.filter(fun dt -> dt :? Present.StoryPage)
                                |> List.map(fun d -> d :?> Present.StoryPage)
                                |> List.map(fun d -> d :> Present.IDomUnit)
                                |> List.map(fun d -> d.object())
                    let volumes= story_volume_set
                                |> List.filter(fun dt -> dt :? Present.VolumePage)
                                |> List.map(fun dt -> dt :?> Present.VolumePage)
                                |> List.map(fun d -> d :> Present.IDomUnit)
                                |> List.map(fun d -> d.object())

                    let rec point_code_generate(list: AstImport.AstObject list) = 
                        match list with
                        | [] -> []
                        | _ -> 
                            let item_current = list.Head
                            match item_current with
                            | :? AstImport.StoryDef as story ->
                                let subcluster = point_code_generate(story.children())
                                let clusters_desc = if subcluster.Length > 0 then subcluster|> List.reduce(fun a b -> a + "\n" + b) else ""
                                let story_desc = $""" subgraph cluster_{story.address()} {{ label="{story.name()}" {clusters_desc} }} """
                                story_desc::point_code_generate(list.Tail)
                            | :? AstImport.SliceDef as slice ->
                                let node_exists = point_code_generate(slice.children())
                                let nodes_desc = if node_exists.Length > 0 then node_exists|> List.reduce(fun a b -> a+"\n"+b) else ""
                                let slice_desc = $""" subgraph cluster_{slice.address()} {{ label="{slice.name()}" {nodes_desc} }} """
                                slice_desc::point_code_generate(list.Tail)
                            | :? AstImport.PointDef as point ->
                                let node_desc = $""" node_{point.address()}[label="{point.name()}" shape="rect" style="diagonals"] """
                                node_desc::point_code_generate(list.Tail)
                            | :? AstImport.PointRef as refer ->
                                let refer_desc = $""" node_{refer.address()}[label="{refer.pointRef()}" style="dotted"] """
                                refer_desc::point_code_generate(list.Tail)
                            | :? AstImport.ArticleDef as article ->
                                let refer_descx = point_code_generate(article.children())
                                let nodes_desc = if refer_descx.Length > 0 then refer_descx|> List.reduce(fun a b -> a+"\n"+b) else ""
                                let article_desc = $""" subgraph cluster_{article.address()} {{ label="{article.name()}" {nodes_desc} }} """
                                article_desc::point_code_generate(list.Tail)
                            | :? AstImport.VolumeDef as volume ->
                                let subclusters = point_code_generate(volume.children())
                                let clusters_desc = if subclusters.Length > 0 then subclusters|> List.reduce(fun a b -> a + "\n" + b) else ""
                                let volume_desc = $""" subgraph cluster_{volume.address()} {{ label="{volume.name()}" {clusters_desc} }} """
                                volume_desc::point_code_generate(list.Tail)
                            | _ -> point_code_generate(list.Tail)
                                
                    let clusters_desc = (point_code_generate(storys)@point_code_generate(volumes))|> List.reduce(fun a b -> a + "\n" + b)
                    
                    let points_about = this.node_collect(storys @ volumes)
                    let point_map = points_about|> List.filter(fun (_, _, d) -> d :? AstImport.PointDef)
                                                |> List.map(fun (a, b, c) -> 
                                                    let story_def = a.Value :?> AstImport.StoryDef
                                                    let slice_def = b.Value :?> AstImport.SliceDef
                                                    $"{story_def.name()}&{slice_def.name()}&{(c :?> AstImport.PointDef).name()}", c.address()
                                                )
                    let rec refers_link_assemble(nodes: (string*string)list) =
                        match nodes with 
                        | [] -> []
                        | _ -> 
                            let node_sig, address = nodes.Head
                            let referx = points_about|> List.filter(fun (_, _, n) -> n :? AstImport.PointRef)
                                            |> List.map(fun (_, _, c) -> c :?> AstImport.PointRef)
                                            |> List.filter(fun n -> 
                                                let sig_ref = $"{n.storyRef()}&{n.sliceRef()}&{n.pointRef()}"
                                                sig_ref = node_sig
                                            )
                            let code_curr = referx |> List.map(fun x-> $"node_{x.address()}--node_{address}")
                            code_curr@refers_link_assemble(nodes.Tail)

                    let temps = refers_link_assemble(point_map)
                    let refer_arrows = refers_link_assemble(point_map)|> List.reduce(fun a b -> a + "\n" + b)

                    $"""graph{{ label="{gname}" {clusters_desc} {refer_arrows} }}"""

            end