266 lines
12 KiB
Forth
266 lines
12 KiB
Forth
|
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:List<IDomUnit> -> IContainer
|
||
|
end
|
||
|
|
||
|
/// 访问页面:概括页面、卷宗页面、故事线页面、节点汇总 =================================================
|
||
|
type VolumePage(page_hrefs: string, volume: IDomUnit, childs: List<IDomUnit>) =
|
||
|
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.append(childs: List<IDomUnit>): IContainer =
|
||
|
raise (System.NotImplementedException())
|
||
|
end
|
||
|
|
||
|
type StoryPage(page_hrefs: string, story: IDomUnit, childs: List<IDomUnit>) =
|
||
|
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.append(childs: List<IDomUnit>): IContainer =
|
||
|
raise (System.NotImplementedException())
|
||
|
end
|
||
|
|
||
|
type PointPage(page_hrefs: string, point: IDomUnit, refer_list: List<IDomUnit>) =
|
||
|
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.append(childs: List<IDomUnit>): 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: List<Present.IDomUnit>) =
|
||
|
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.append(childs: List<Present.IDomUnit>): 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: List<Present.IDomUnit>) =
|
||
|
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.append(childs: List<Present.IDomUnit>): 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: List<Present.IDomUnit>) =
|
||
|
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.append(childs: List<Present.IDomUnit>): Present.IContainer =
|
||
|
raise (System.NotImplementedException())
|
||
|
end
|
||
|
let slice_assemble (defs: AstImport.SliceDef) : SliceDefine =
|
||
|
let childs = defs.children()
|
||
|
|> List.map<AstImport.AstObject,Present.IDomUnit>(fun data ->
|
||
|
match data with
|
||
|
| :? AstImport.PointRef as refs -> refer_assemble(refs)
|
||
|
| :? AstImport.PointDef as defs -> point_assemble(defs)
|
||
|
| :? AstImport.TextItem as text -> TextContent(text)
|
||
|
| _ -> raise (System.NotImplementedException())
|
||
|
)
|
||
|
SliceDefine(defs, childs)
|
||
|
|
||
|
|
||
|
type StoryDefine(defs: AstImport.StoryDef, childs: List<Present.IDomUnit>) =
|
||
|
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.append(childs: List<Present.IDomUnit>): Present.IContainer =
|
||
|
raise (System.NotImplementedException())
|
||
|
end
|
||
|
let story_assemble (defs: AstImport.StoryDef): StoryDefine =
|
||
|
let childs = defs.children()
|
||
|
|> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
|
||
|
match data with
|
||
|
| :? AstImport.SliceDef as defs -> slice_assemble(defs)
|
||
|
| :? AstImport.TextItem as text -> TextContent(text)
|
||
|
| _ -> raise (System.NotImplementedException())
|
||
|
)
|
||
|
StoryDefine(defs, childs)
|
||
|
|
||
|
|
||
|
type ArticleDefine(defs: AstImport.ArticleDef, childs: List<Present.IDomUnit>) =
|
||
|
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.append(childs: List<Present.IDomUnit>): Present.IContainer =
|
||
|
raise (System.NotImplementedException())
|
||
|
end
|
||
|
let article_assemble (defs: AstImport.ArticleDef) : ArticleDefine =
|
||
|
let childs = defs.children()
|
||
|
|> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
|
||
|
match data with
|
||
|
| :? AstImport.TextItem as text -> TextContent(text)
|
||
|
| :? AstImport.PointRef as refs -> refer_assemble(refs)
|
||
|
| _ -> raise (System.NotImplementedException())
|
||
|
)
|
||
|
ArticleDefine(defs, childs)
|
||
|
|
||
|
|
||
|
type VolumeDefine(defs: AstImport.VolumeDef, childs: List<Present.IDomUnit>) =
|
||
|
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.append(childs: List<Present.IDomUnit>): Present.IContainer =
|
||
|
raise (System.NotImplementedException())
|
||
|
end
|
||
|
let volume_assemble (defs: AstImport.VolumeDef): VolumeDefine =
|
||
|
let childs = defs.children()
|
||
|
|> List.map<AstImport.AstObject, Present.IDomUnit>(fun data ->
|
||
|
match data with
|
||
|
| :? AstImport.TextItem as text -> TextContent(text)
|
||
|
| :? AstImport.ArticleDef as defs -> article_assemble(defs)
|
||
|
| _ -> raise (System.NotImplementedException())
|
||
|
)
|
||
|
VolumeDefine(defs, childs)
|
||
|
|
||
|
|
||
|
type UnitGenerate(root: AstImport.AstObject) =
|
||
|
class
|
||
|
// ast 节点序列
|
||
|
let forwards_map = AstImport.branch_map_conv(root, root.members())
|
||
|
// 累积结果
|
||
|
let mutable result_nodes: (int*Present.IDomUnit) list = []
|
||
|
|
||
|
interface AstImport.AstVisitor with
|
||
|
member this.visit(obj: AstImport.AstObject): bool =
|
||
|
let refs_depth = AstImport.depth_seek(forwards_map, obj)
|
||
|
let childs = result_nodes |> List.filter (fun (depth, _) -> depth > refs_depth)
|
||
|
|> List.map(fun (_, object) -> object)
|
||
|
|
||
|
let datas = match obj with
|
||
|
| :? AstImport.TextItem as text ->
|
||
|
(refs_depth, TextContent(text) :> Present.IDomUnit)::result_nodes
|
||
|
| :? AstImport.PointRef as refs ->
|
||
|
(refs_depth, PointRefer(refs, childs))::result_nodes
|
||
|
| :? AstImport.PointDef as defs ->
|
||
|
(refs_depth, PointDefine(defs, childs))::result_nodes
|
||
|
| :? AstImport.SliceDef as defs ->
|
||
|
(refs_depth, SliceDefine(defs, childs))::result_nodes
|
||
|
| :? AstImport.StoryDef as defs ->
|
||
|
(refs_depth, StoryDefine(defs, childs))::result_nodes
|
||
|
| :? AstImport.ArticleDef as defs ->
|
||
|
(refs_depth, ArticleDefine(defs, childs))::result_nodes
|
||
|
| :? AstImport.VolumeDef as defs ->
|
||
|
(refs_depth, VolumeDefine(defs, childs))::result_nodes
|
||
|
| :? AstImport.Program -> result_nodes
|
||
|
| _ -> raise (System.NotImplementedException())
|
||
|
|
||
|
result_nodes <- datas
|
||
|
if refs_depth > 0 then
|
||
|
result_nodes <- result_nodes |> List.filter(fun (depth, _) -> depth <= refs_depth)
|
||
|
true
|
||
|
|
||
|
member this.contents() =
|
||
|
result_nodes |> List.map(fun (_, obj) -> obj)
|
||
|
end
|