namespace HtmlStruct open AstAccess open System.Xml open System module Present = /// 可访问元素 type Access(hrefs: string) = class member this.accessLink(): string = hrefs end /// 回退访问元素 type Backward(hrefs: string) = class member this.backwardLink(): string = hrefs end /// 内容元素:分卷、章节、引用节点、故事线、情节、定义节点、引用节点 type IDomUnit = interface abstract member name:unit -> string abstract member getHtml:XmlElement -> XmlElement end /// 容器节点:分卷、章节、故事线、情节 type IContainer = interface abstract member append:IDomUnit list -> IContainer abstract member children:unit -> IDomUnit list end /// 访问页面:概括页面、卷宗页面、故事线页面、节点汇总 ================================================= type VolumePage(page_hrefs: string, volume: IDomUnit, childs: IDomUnit list) = class inherit Access(page_hrefs) new(page_hrefs, volume) = VolumePage(page_hrefs, volume, []) interface IDomUnit with member this.name():string = volume.name() member this.getHtml(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 Access(page_hrefs) new(page_hrefs, story) = StoryPage(page_hrefs, story, []) interface IDomUnit with member this.name():string = story.name() member this.getHtml(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 Access(page_hrefs) new(page_hrefs, point) = PointPage(page_hrefs, point, []) interface IDomUnit with member this.name():string = point.name() member this.getHtml(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.getHtml(pnode: XmlElement): XmlElement = raise (System.NotImplementedException()) end type PointRefer(refs: AstImport.PointRef, items: Present.IDomUnit list) = class 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.getHtml(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 let lines = defs.children() |> List.map (fun x->x.content()) interface Present.IDomUnit with member this.name(): string = defs.name() member this.getHtml(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 SliceDefine(defs: AstImport.SliceDef, items: Present.IDomUnit list) = class interface Present.IDomUnit with member this.name(): string = defs.name() member this.getHtml(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.getHtml(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.getHtml(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.getHtml(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)