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(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(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(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}}" // 格式化Article:Node 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(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}}}" // 格式化Volume:Node 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(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 )