WsParser_VS/AstConv/AstImport.fs

369 lines
17 KiB
Forth
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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"
override this.filePath (): string =
bind.GetAttribute "file-path"
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.dirPath() =
bind.GetAttribute "dir_src"
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
/// 1node
/// 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