364 lines
16 KiB
Forth
364 lines
16 KiB
Forth
namespace AstAccess
|
||
|
||
open System.Xml
|
||
open System.Linq
|
||
|
||
module AstImport =
|
||
/// 带有地址的对象
|
||
type AstObject(bind: XmlElement) =
|
||
class
|
||
member this.astXML() = bind
|
||
member this.rows() =
|
||
let xmle = bind.SelectSingleNode("tokens/token") :?> XmlElement
|
||
int(xmle.GetAttribute "row")
|
||
|
||
abstract member address:unit -> string
|
||
default this.address():string = "mem_" + string(this.GetHashCode ())
|
||
|
||
abstract member filePath:unit -> string
|
||
default this.filePath():string = ""
|
||
|
||
abstract member members:unit -> AstObject list
|
||
default this.members(): AstObject list = []
|
||
end
|
||
|
||
/// 父子节点map转换
|
||
let rec branch_map_conv (pnode: AstObject, childs: AstObject list) =
|
||
match childs with
|
||
| [] -> []
|
||
| _ ->
|
||
let head = childs.Head
|
||
(head.address(), (head, pnode))::branch_map_conv(pnode, childs.Tail)@branch_map_conv(head, head.members())
|
||
|
||
/// 节点深度计算
|
||
let rec depth_seek(branchs: (string*(AstObject*AstObject))list, node: AstObject): int =
|
||
let prev_nodes = branchs |> List.filter(fun (key, _) -> key.Equals(node.address()))
|
||
match prev_nodes.Length with
|
||
| 0 -> 0
|
||
| _ ->
|
||
let (_, (_, parent_node)) = prev_nodes.Head
|
||
depth_seek(branchs, parent_node) + 1
|
||
|
||
/// TextWord
|
||
type TextItem(bind: XmlElement) =
|
||
class
|
||
inherit AstObject(bind)
|
||
member this.content():string =
|
||
bind.GetAttribute "text"
|
||
|
||
member this.row():int =
|
||
let tokens_node = bind.ChildNodes.Cast<XmlNode>().Where(
|
||
fun node -> node.Name.Equals "tokens").ElementAt(0)
|
||
let token_bind = tokens_node.ChildNodes.Cast<XmlElement>().ElementAt(0)
|
||
int(token_bind.GetAttribute "row")
|
||
|
||
static member GenerateText(text_opt: XmlNode): Option<TextItem> =
|
||
match text_opt with
|
||
| :? XmlElement as obj_t when obj_t.Name.Equals "text-section" ->
|
||
Some(TextItem(obj_t))
|
||
| _ -> None
|
||
end
|
||
|
||
/// 引用节点
|
||
type FragmentRef(bind: XmlElement, texts: TextItem list) =
|
||
class
|
||
inherit AstObject(bind)
|
||
new(bind: XmlElement) = FragmentRef(bind, [])
|
||
|
||
member this.sliceRef() =
|
||
bind.GetAttribute "slice"
|
||
member this.storyRef() =
|
||
bind.GetAttribute "story"
|
||
member this.appendChild(objs: TextItem list) =
|
||
FragmentRef(bind, texts@objs)
|
||
member this.children() =
|
||
texts
|
||
|
||
override this.members(): AstObject list =
|
||
texts |> List.map (fun it->it :> AstObject)
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): TextItem list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
match TextItem.GenerateText(child) with
|
||
| Some text -> text::FragmentRef.GenerateFromChildSibling(child.NextSibling)
|
||
| None -> FragmentRef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GeneratePointRef(ref_opt: XmlNode): Option<FragmentRef> =
|
||
match ref_opt with
|
||
| :? XmlElement as refo when refo.Name.Equals "refer" ->
|
||
let text_objects = FragmentRef.GenerateFromChildSibling(refo.FirstChild)
|
||
Some(FragmentRef(refo, text_objects))
|
||
| _ -> None
|
||
end
|
||
|
||
type SliceChildType = |Text of TextItem |Ref of FragmentRef
|
||
/// 情节节点
|
||
type FragmentSlice(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject(bind)
|
||
new(bind: XmlElement) = FragmentSlice(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.appendChild(o: SliceChildType) =
|
||
match o with
|
||
| Text t -> FragmentSlice(bind, objs@[t])
|
||
| Ref d -> FragmentSlice(bind, objs@[d])
|
||
member this.children() = objs
|
||
|
||
override this.members(): AstObject list = objs
|
||
override this.address (): string =
|
||
bind.GetAttribute "address"
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): SliceChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let h = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "refer" -> Some(Ref(FragmentRef.GeneratePointRef(child).Value))
|
||
| _ -> None
|
||
|
||
match h with
|
||
| Some value -> value::FragmentSlice.GenerateFromChildSibling(child.NextSibling)
|
||
| _ -> FragmentSlice.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateSliceDef(slice_opt: XmlNode): Option<FragmentSlice> =
|
||
match slice_opt with
|
||
| :? XmlElement as slice when slice.Name.Equals "slice" ->
|
||
let mbrs = FragmentSlice.GenerateFromChildSibling(slice.FirstChild)
|
||
let objs = mbrs |> List.map (
|
||
fun o-> match o with
|
||
|Ref defs -> defs :> AstObject
|
||
|Text text -> text :> AstObject
|
||
)
|
||
Some(FragmentSlice(slice, objs))
|
||
| _ -> None
|
||
end
|
||
|
||
type StoryChildType = |Text of TextItem |Slice of FragmentSlice
|
||
/// 故事节点
|
||
type StoryDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject(bind)
|
||
new(bind: XmlElement) = StoryDef(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.sort() =
|
||
int(bind.GetAttribute "sort")
|
||
member this.appendChild(o: StoryChildType) =
|
||
match o with
|
||
|Text t -> StoryDef(bind, objs@[t])
|
||
|Slice s -> StoryDef(bind, objs@[s])
|
||
member this.children() = objs
|
||
|
||
override this.members(): AstObject list = objs
|
||
override this.address (): string =
|
||
bind.GetAttribute "address"
|
||
override this.filePath (): string =
|
||
bind.GetAttribute "file-path"
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): StoryChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let h = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "slice" -> Some(Slice(FragmentSlice.GenerateSliceDef(child).Value))
|
||
| _->None
|
||
match h with
|
||
| Some value -> value::StoryDef.GenerateFromChildSibling(child.NextSibling)
|
||
| _ -> StoryDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateStoryDef(story_opt: XmlNode): Option<StoryDef> =
|
||
match story_opt with
|
||
| :? XmlElement as story when story.Name.Equals "story" ->
|
||
let children = StoryDef.GenerateFromChildSibling(story.FirstChild)
|
||
let objs = children |> List.map (
|
||
fun x ->
|
||
match x with
|
||
|Text valx -> valx :> AstObject
|
||
|Slice valx -> valx :> AstObject
|
||
)
|
||
Some(StoryDef(story, objs))
|
||
| _ -> None
|
||
end
|
||
|
||
type ArticleChildType = |Text of TextItem |Refer of FragmentRef
|
||
/// 章节节点
|
||
type ArticleDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject(bind)
|
||
new(bind: XmlElement) = ArticleDef(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.children() = objs
|
||
member this.appendChild(o: ArticleChildType list) =
|
||
let conv item = match item with
|
||
|Text t -> t :> AstObject
|
||
|Refer r -> r :> AstObject
|
||
|
||
let items = o |> List.map conv
|
||
ArticleDef(bind, objs@items)
|
||
|
||
override this.members(): AstObject list = objs
|
||
override this.address (): string =
|
||
bind.GetAttribute "address"
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): ArticleChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let data = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "refer" -> Some(Refer(FragmentRef.GeneratePointRef(child).Value))
|
||
| _ -> None
|
||
match data with
|
||
| Some value -> value::ArticleDef.GenerateFromChildSibling(child.NextSibling)
|
||
| None -> ArticleDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateArticleDef(article_opt: XmlNode): Option<ArticleDef> =
|
||
match article_opt with
|
||
| :? XmlElement as article when article.Name.Equals "article" ->
|
||
let mbrs = ArticleDef.GenerateFromChildSibling(article.FirstChild)
|
||
let conv it = match it with
|
||
|Text v -> v :> AstObject
|
||
|Refer v -> v:> AstObject
|
||
Some(ArticleDef(article, mbrs |> List.map conv))
|
||
| _ -> None
|
||
end
|
||
|
||
type VolumeChildType = |Text of TextItem |Article of ArticleDef
|
||
/// 卷宗节点
|
||
type VolumeDef(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject(bind)
|
||
new(bind: XmlElement) = VolumeDef(bind, [])
|
||
|
||
member this.name() =
|
||
bind.GetAttribute "name"
|
||
member this.children() = objs
|
||
member this.appendChild(o: VolumeChildType list) =
|
||
let items = o |> List.map (
|
||
fun it->
|
||
match it with
|
||
|Text t -> t :> AstObject
|
||
|Article a -> a :> AstObject
|
||
)
|
||
VolumeDef(bind, objs@items)
|
||
|
||
override this.members(): AstObject list = objs
|
||
override this.address (): string =
|
||
bind.GetAttribute "address"
|
||
override this.filePath (): string =
|
||
bind.GetAttribute "file-path"
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): VolumeChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let data = match child.Name with
|
||
| "text-section" -> Some(Text(TextItem.GenerateText(child).Value))
|
||
| "article" -> Some(Article(ArticleDef.GenerateArticleDef(child).Value))
|
||
| _ -> None
|
||
match data with
|
||
| Some value -> value::VolumeDef.GenerateFromChildSibling(child.NextSibling)
|
||
| None -> VolumeDef.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateVolumeDef(vol_opt: XmlNode): Option<VolumeDef> =
|
||
match vol_opt with
|
||
| :? XmlElement as volume when volume.Name.Equals "volume" ->
|
||
let mbrs = VolumeDef.GenerateFromChildSibling(volume.FirstChild)
|
||
let conv data = match data with
|
||
|Text d -> d :> AstObject
|
||
|Article d -> d:> AstObject
|
||
Some(VolumeDef(volume, mbrs |> List.map conv))
|
||
| _ -> None
|
||
|
||
|
||
end
|
||
|
||
type RankDef(bind: XmlElement) =
|
||
class
|
||
inherit AstObject(bind)
|
||
|
||
member this.sort():int32 =
|
||
int32(bind.GetAttribute "rank")
|
||
override this.filePath (): string =
|
||
bind.GetAttribute "doc-path"
|
||
end
|
||
|
||
type ProgramChildType = |Volume of VolumeDef |Story of StoryDef |Rank of RankDef
|
||
/// 程序节点
|
||
type Program(bind: XmlElement, objs: AstObject list) =
|
||
class
|
||
inherit AstObject(bind)
|
||
new(bind: XmlElement) = Program(bind, [])
|
||
|
||
member this.time() =
|
||
bind.GetAttribute "time"
|
||
member this.children() = objs
|
||
member this.appendChild(o: ProgramChildType list) =
|
||
let items = o |> List.map (fun it->
|
||
match it with
|
||
|Story s -> s :> AstObject
|
||
|Volume v -> v :> AstObject
|
||
|Rank r -> r:> AstObject
|
||
)
|
||
Program(bind, objs @items)
|
||
|
||
override this.members(): AstObject list = objs
|
||
|
||
static member GenerateFromChildSibling(child: XmlNode): ProgramChildType list =
|
||
match child with
|
||
| null -> []
|
||
| _ ->
|
||
let d = match child.Name with
|
||
| "volume" -> Some(Volume(VolumeDef.GenerateVolumeDef(child).Value))
|
||
| "story" -> Some(Story(StoryDef.GenerateStoryDef(child).Value))
|
||
| "rank" -> Some(Rank(RankDef(child :?> XmlElement)))
|
||
| _ -> None
|
||
match d with
|
||
|Some value -> value::Program.GenerateFromChildSibling(child.NextSibling)
|
||
|None -> Program.GenerateFromChildSibling(child.NextSibling)
|
||
|
||
static member GenerateFrom(doc: XmlDocument) =
|
||
let ast = doc.DocumentElement
|
||
|
||
let mbrs = Program.GenerateFromChildSibling(ast.FirstChild)
|
||
let conv data = match data with
|
||
|Volume d -> d:>AstObject
|
||
|Story d -> d :> AstObject
|
||
|Rank d -> d:> AstObject
|
||
Program(ast, mbrs |> List.map conv)
|
||
end
|
||
|
||
|
||
type AstVisitor =
|
||
interface
|
||
abstract member visit:AstObject -> bool
|
||
end
|
||
|
||
type AstVisitEntry(root: AstObject) =
|
||
class
|
||
/// 1：node
|
||
/// 2: node
|
||
/// 2: node
|
||
/// 3: node
|
||
/// 4: node
|
||
/// ......
|
||
member private this.visit_internal(nodes: AstObject list, visitor: AstVisitor): bool =
|
||
match nodes.Length with
|
||
| 0 -> true
|
||
| _ ->
|
||
this.visit_internal(nodes.Head.members(), visitor) && visitor.visit(nodes.Head) && this.visit_internal(nodes.Tail, visitor)
|
||
|
||
|
||
member this.visitWith(visitor: AstVisitor): bool =
|
||
this.visit_internal([root], visitor)
|
||
|
||
end |