WsParser_VS/AstConv/HtmlStruct.fs

303 lines
14 KiB
Forth
Raw Normal View History

2025-02-19 05:43:34 +00:00
namespace HtmlStruct
open AstAccess
open System.Xml
open System
module Present =
/// 可访问元素
type Access(hrefs: string) =
class
2025-02-19 06:47:46 +00:00
member this.accessLink(): string = hrefs
2025-02-19 05:43:34 +00:00
end
/// 回退访问元素
type Backward(hrefs: string) =
class
2025-02-19 06:47:46 +00:00
member this.backwardLink(): string = hrefs
2025-02-19 05:43:34 +00:00
end
/// 内容元素:分卷、章节、引用节点、故事线、情节、定义节点、引用节点
type IDomUnit =
interface
abstract member name:unit -> string
abstract member getHtml:XmlElement -> XmlElement
end
/// 容器节点:分卷、章节、故事线、情节
type IContainer =
interface
2025-02-19 06:47:46 +00:00
abstract member append:IDomUnit list -> IContainer
abstract member children:unit -> IDomUnit list
2025-02-19 05:43:34 +00:00
end
/// 访问页面:概括页面、卷宗页面、故事线页面、节点汇总 =================================================
2025-02-19 06:47:46 +00:00
type VolumePage(page_hrefs: string, volume: IDomUnit, childs: IDomUnit list) =
2025-02-19 05:43:34 +00:00
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
2025-02-19 06:47:46 +00:00
member this.children(): IDomUnit list = childs
member this.append(childs: IDomUnit list): IContainer =
2025-02-19 05:43:34 +00:00
raise (System.NotImplementedException())
end
2025-02-19 06:47:46 +00:00
type StoryPage(page_hrefs: string, story: IDomUnit, childs: IDomUnit list) =
2025-02-19 05:43:34 +00:00
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
2025-02-19 06:47:46 +00:00
member this.children(): IDomUnit list = childs
member this.append(childs: IDomUnit list): IContainer =
2025-02-19 05:43:34 +00:00
raise (System.NotImplementedException())
end
2025-02-19 06:47:46 +00:00
type PointPage(page_hrefs: string, point: IDomUnit, refer_list: IDomUnit list) =
2025-02-19 05:43:34 +00:00
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
2025-02-19 06:47:46 +00:00
member this.children(): IDomUnit list = refer_list
member this.append(childs: IDomUnit list): IContainer =
2025-02-19 05:43:34 +00:00
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
2025-02-19 06:47:46 +00:00
type PointRefer(refs: AstImport.PointRef, items: Present.IDomUnit list) =
2025-02-19 05:43:34 +00:00
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
2025-02-19 06:47:46 +00:00
member this.children(): Present.IDomUnit list = items
member this.append(childs: Present.IDomUnit list): Present.IContainer =
2025-02-19 05:43:34 +00:00
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)
2025-02-19 06:47:46 +00:00
type PointDefine(defs: AstImport.PointDef, items: Present.IDomUnit list) =
2025-02-19 05:43:34 +00:00
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
2025-02-19 06:47:46 +00:00
member this.children(): Present.IDomUnit list = items
member this.append(childs: Present.IDomUnit list): Present.IContainer =
2025-02-19 05:43:34 +00:00
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)
2025-02-19 06:47:46 +00:00
type SliceDefine(defs: AstImport.SliceDef, items: Present.IDomUnit list) =
2025-02-19 05:43:34 +00:00
class
interface Present.IDomUnit with
member this.name(): string =
defs.name()
member this.getHtml(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
2025-02-19 06:47:46 +00:00
member this.children(): Present.IDomUnit list = items
member this.append(childs: Present.IDomUnit list): Present.IContainer =
2025-02-19 05:43:34 +00:00
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)
2025-02-19 06:47:46 +00:00
type StoryDefine(defs: AstImport.StoryDef, childs: Present.IDomUnit list) =
2025-02-19 05:43:34 +00:00
class
interface Present.IDomUnit with
member this.name(): string =
defs.name()
member this.getHtml(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
2025-02-19 06:47:46 +00:00
member this.children(): Present.IDomUnit list = childs
member this.append(childs: Present.IDomUnit list): Present.IContainer =
2025-02-19 05:43:34 +00:00
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)
2025-02-19 06:47:46 +00:00
type ArticleDefine(defs: AstImport.ArticleDef, childs: Present.IDomUnit list) =
2025-02-19 05:43:34 +00:00
class
interface Present.IDomUnit with
member this.name(): string =
defs.name()
member this.getHtml(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
2025-02-19 06:47:46 +00:00
member this.children(): Present.IDomUnit list = childs
member this.append(childs: Present.IDomUnit list): Present.IContainer =
2025-02-19 05:43:34 +00:00
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)
2025-02-19 06:47:46 +00:00
type VolumeDefine(defs: AstImport.VolumeDef, childs: Present.IDomUnit list) =
2025-02-19 05:43:34 +00:00
class
interface Present.IDomUnit with
member this.name(): string =
defs.name()
member this.getHtml(pnode: XmlElement): XmlElement =
raise (System.NotImplementedException())
interface Present.IContainer with
2025-02-19 06:47:46 +00:00
member this.children(): Present.IDomUnit list = childs
member this.append(news: Present.IDomUnit list): Present.IContainer =
VolumeDefine(defs, childs@news)
2025-02-19 05:43:34 +00:00
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)
2025-02-19 06:47:46 +00:00
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)