WsParser_VS/AstConv/FmtStruct.fs

227 lines
11 KiB
Forth
Raw 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 FmtStruct
open System.IO
open AstAccess
open HtmlStruct
module FmtEntry =
// rank反序列化
let rank_fmt(node: AstImport.AstObject): string =
let domx = node :?> AstImport.RankDef
$"#排序 {domx.sort()}\n"
// 提取相同的类型元素
let rec same_collect<'T when 'T:>Present.IDomUnit>
(nodes: Present.IDomUnit list): Present.IDomUnit list * Present.IDomUnit list =
if nodes.Length = 0 then
[], []
else
match nodes.Head with
| :? 'T ->
let tn, rest = same_collect<'T>(nodes.Tail)
nodes.Head::tn, rest
| _ -> [], nodes
// 分类两种不同的类型元素
let rec same_fold<'T1,'T2 when 'T1:> Present.IDomUnit and 'T2:> Present.IDomUnit>
(nodes: Present.IDomUnit list): Present.IDomUnit list list =
let first_list, rest_0 = same_collect<'T1>(nodes)
let second_list, rest_1 = same_collect<'T2>(rest_0)
let list = match rest_1 with
|[] -> first_list::[second_list]
| _ -> first_list::[second_list]@same_fold<'T1, 'T2>(rest_1)
list |> List.filter(fun slist -> slist.Length > 0)
// 字符串格式化
let rec text_fmt(prefix:string)(line_prev: int32)(nodes: Content.TextContent list): string =
match nodes with
| [] -> ""
| _ ->
let obj_text = (nodes.Head :> Present.IDomUnit).object()
let this_text = (obj_text :?> AstImport.TextItem).content()
if obj_text.rows() = line_prev then
" " + this_text + text_fmt prefix line_prev nodes.Tail
else
$"\n{prefix}" + this_text + text_fmt prefix (obj_text.rows()) nodes.Tail
// 格式化Refer:Node
let slice_ref_fmt(prefix:string)(node: Content.FragmentRefer): string =
let objref = (node:> Present.IDomUnit).object():?> AstImport.FragmentRef
let childs = (node:> Present.IContainer).children()
let text_childs, rest = same_collect<Content.TextContent>(childs)
assert(rest.Length = 0)
let text_type_childs = text_childs|> List.map(fun n-> n:?> Content.TextContent)
let sections = text_fmt (prefix+" ") (objref.rows()) text_type_childs
$"\n{prefix}{{@情节 {objref.storyRef()}&{objref.sliceRef()}{sections}}}"
// 格式化Slice:Node
let slice_def_fmt(prefix:string)(node: Content.FragmentSlice): string =
let obj_def = (node:> Present.IDomUnit).object():?> AstImport.FragmentSlice
let childs = (node:> Present.IContainer).children()
let same_groups_set = same_fold<Content.TextContent, Content.FragmentRefer>(childs)
let contents = same_groups_set |> List.map(fun same_set ->
if same_set.Length = 0 then
""
else
match same_set.Head with
| :? Content.FragmentRefer ->
let strx = same_set|> List.map(fun n ->
slice_ref_fmt (prefix+" ") (n:?> Content.FragmentRefer)
)
strx |> List.reduce(fun a b -> a + "\n" + b)
| :? Content.TextContent ->
let typed_set = same_set|>List.map(fun fn->fn:?>Content.TextContent)
text_fmt (prefix+" ") (obj_def.rows()) typed_set
| _ -> failwith "mismatch"
)
let subs = match contents with
| [] -> ""
| _ -> contents|> List.reduce(fun a b -> a + "\n" + b)
$"\n{prefix}{{情节 {obj_def.name()}{subs}\n{prefix}}}"
// 格式化Story:Node
let story_def_fmt(node: Content.StoryDefine): string =
let obj_story = (node:> Present.IDomUnit).object():?> AstImport.StoryDef
let childs = (node:> Present.IContainer).children()
let same_groups_set = same_fold<Content.TextContent, Content.FragmentSlice>(childs)
let contents = same_groups_set |> List.map(fun same_set ->
if same_set.Length = 0 then
""
else
match same_set.Head with
| :? Content.FragmentSlice ->
let strx = same_set|> List.map(fun n ->
slice_def_fmt " " (n:?> Content.FragmentSlice)
)
strx |> List.reduce(fun a b -> a + "\n" + b)
| :? Content.TextContent ->
let typed_set = same_set|>List.map(fun fn->fn:?>Content.TextContent)
text_fmt " " (obj_story.rows()) typed_set
| _ -> failwith "mismatch-storydef"
)
let subs = match contents with
| [] -> ""
| _ -> contents|> List.reduce(fun a b -> a + "\n" + b)
$"\n{{故事 {obj_story.name()}{subs}\n}}"
// 格式化ArticleNode
let article_def_fmt(prefix:string)(node: Content.ArticleDefine): string =
let obj_article = (node:> Present.IDomUnit).object():?> AstImport.ArticleDef
let childs = (node:> Present.IContainer).children()
let same_groups_set = same_fold<Content.TextContent, Content.FragmentRefer>(childs)
let contents = same_groups_set |> List.map(fun same_set ->
if same_set.Length = 0 then
""
else
match same_set.Head with
| :? Content.FragmentRefer ->
let strx = same_set|> List.map(fun n ->
slice_ref_fmt (prefix+" ") (n:?> Content.FragmentRefer)
)
strx |> List.reduce(fun a b -> a + "\n" + b)
| :? Content.TextContent ->
let typed_set = same_set|>List.map(fun fn->fn:?>Content.TextContent)
text_fmt (prefix+" ") (obj_article.rows()) typed_set
| _ -> failwith "mismatch"
)
let subs = match contents with
| [] -> ""
| _ -> contents|> List.reduce(fun a b -> a + "\n" + b)
$"\n{prefix}{{章节 {obj_article.name()}{subs}\n{prefix}}}"
// 格式化VolumeNode
let volume_def_fmt(node: Content.VolumeDefine): string =
let obj_volume = (node:> Present.IDomUnit).object():?> AstImport.VolumeDef
let childs = (node:> Present.IContainer).children()
let same_groups_set = same_fold<Content.TextContent, Content.ArticleDefine>(childs)
let contents = same_groups_set |> List.map(fun same_set ->
if same_set.Length = 0 then
""
else
match same_set.Head with
| :? Content.ArticleDefine ->
let strx = same_set|> List.map(fun n ->
article_def_fmt " " (n:?> Content.ArticleDefine)
)
strx |> List.reduce(fun a b -> a + "\n" + b)
| :? Content.TextContent ->
let typed_set = same_set |> List.map(fun fn->fn:?>Content.TextContent)
text_fmt " " (obj_volume.rows()) typed_set
| _ -> failwith "mismatch-volumedef"
)
let subs = match contents with
| [] -> ""
| _ -> contents|> List.reduce(fun a b -> a + "\n" + b)
$"\n{{分卷 {obj_volume.name()}{subs}\n}}"
let document_def_fmt(path:string)(nodes: Present.IDomUnit list): unit =
let head_str, rest_nodes=match nodes.Head with
| :? Content.RankDefine ->
rank_fmt(nodes.Head.object()), nodes.Tail
| _ -> "", nodes
let sorted_nodes = rest_nodes|> List.sortBy (fun a->a.object().rows())
let nodes_str = sorted_nodes|> List.map(fun nx ->
match nx with
| :? Content.VolumeDefine as vdef ->
volume_def_fmt vdef
| :? Content.StoryDefine as sdef->
story_def_fmt sdef
| _ -> failwith "error-doc-child"
)
let xcontent = head_str + (nodes_str|> List.reduce(fun a b -> a + "\n" + b))
use wr = new StreamWriter(path,false)
wr.Write(xcontent)
printfn $"- {path}文档格式化完成。"
let program_def_fmt(dir:string)(nodes: Present.IDomUnit list): unit =
let ranks = nodes|> List.filter(fun n -> n:?Content.RankDefine)
ranks|> List.iter(fun rankn ->
let rank_o = rankn.object() :?> AstImport.RankDef
let file_path = rank_o.filePath()
let nodes_within = nodes|> List.filter(fun n ->
match n with
| :? Content.StoryDefine ->
n.object().filePath() = file_path
| :? Content.VolumeDefine ->
n.object().filePath() = file_path
| _ -> false)
document_def_fmt (Path.Combine(dir, file_path)) (rankn::nodes_within)
)
let nodes_hangout = nodes|> List.filter(fun n ->
let rank_paths = ranks|> List.map(fun n -> n.object().filePath())
match n with
| :? Content.VolumeDefine ->
not(List.contains (n.object().filePath()) rank_paths)
| _ -> false
)
let path_hangout = nodes_hangout|> List.map(fun n -> n.object().filePath())
|> List.distinct
path_hangout |> List.iter(fun path ->
let nodes_within = nodes_hangout|> List.filter(fun n -> n.object().filePath() = path)
document_def_fmt (Path.Combine(dir, path)) nodes_within
)