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 = raise (System.NotImplementedException()) 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 AssemblePoint<'T when 'T :> Present.Forwards and 'T :> Present.IDomUnit and 'T:> Present.IContainer>(item: 'T, page: Present.PageAccess) = class inherit Present.Backwards(item, page) interface Present.IDomUnit with member this.name(): string = item.name() 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(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(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(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(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().ToCharArray() |> Array.map(fun c-> string(uint16(c))) name_seqs |> Array.reduce(fun a b-> a+b) /// 构建所有卷宗页面 let rec volume_page_build (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_build(nodes.Tail) | _ -> volume_page_build(nodes.Tail) /// 构建所有故事线页面 let rec story_page_build (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_build(nodes.Tail) | _ -> story_page_build(nodes.Tail) /// 提取point-define和point-refer let rec point_peers_extract(nodes: Present.IDomUnit list):(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)-> match x with | None -> (Some(story_e :> Present.IDomUnit), y) | _ -> (x, y) ) | :? 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)-> match x with | None -> (Some(story_e :> Present.IDomUnit), y) | _ -> (x, y) ) | :? 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) -> match x with | None -> (Some(volume_e), y) | _ -> (x, y) ) | :? 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) -> match x with | None -> (Some(volume_e), y) | _ -> (x, y) ) | :? Content.SliceDefine as slice_e -> let con = slice_e :> Present.IContainer point_peers_extract(con.children())@point_peers_extract(nodes.Tail) | :? Content.ArticleDefine as article_e -> let con = article_e :> Present.IContainer point_peers_extract(con.children())@point_peers_extract(nodes.Tail) | :? Content.PointRefer as refer_e -> (None, Some(refer_e :> Present.IDomUnit))::point_peers_extract(nodes.Tail) | :? Content.PointDefine as define_e -> (None, Some(define_e))::point_peers_extract(nodes.Tail) | _ -> point_peers_extract(nodes.Tail)