parser.ml (3294B)
1 (* TODO: These should be doing prefix matching...*) 2 3 type line_format = 4 | Normal 5 | HeaderL1 6 | HeaderL2 7 | HeaderL3 8 | Embedded 9 | Preformatted 10 | Hidden 11 | Quote 12 | Link 13 | ListItem 14 15 (** [line_format_map format] returns a pair where the first element is the 16 [format] as a string and the second element is the number of characters that 17 format removes from the prefix of a line. *) 18 let line_format_map format = 19 match format with 20 | Normal -> ("Normal", 0) 21 | HeaderL1 -> ("HeaderL1", 2) 22 | HeaderL2 -> ("HeaderL2", 3) 23 | HeaderL3 -> ("HeaderL3", 4) 24 | Embedded -> ("Embedded", 4) 25 | Preformatted -> ("Preformatted", 0) 26 | Hidden -> ("Hidden", 3) 27 | Quote -> ("Quote", 2) 28 | Link -> ("Link", 3) 29 | ListItem -> ("ListItem", 2) 30 31 (** [line_format_str format] takes as input a line format pair and returns the 32 string element. *) 33 let line_format_str format = fst (line_format_map format) 34 35 (** [line_format_char_cut format] takes as input a line format pair and returns 36 the element describing how many characters to cut from the prefix of the 37 line. *) 38 let line_format_char_cut format = snd (line_format_map format) 39 40 type page_line = { content : string; line_type : line_format } 41 42 (** [permute_line line line_type] returns a copy of the [line] after applying 43 the corresponding changes the [line_type] imparts on lines of that format. 44 *) 45 let permute_line line line_type = 46 let cut = line_format_char_cut line_type in 47 String.sub line cut (String.length line - cut) 48 49 let match_prefix_not_formatted line prefix preformatted = 50 if prefix = "" then preformatted 51 else (not preformatted) && Shared.match_on_prefix line prefix 52 53 let get_line_type line preformatted = 54 let funs = 55 [ 56 (Hidden, "?? "); 57 (Preformatted, ""); 58 (ListItem, "* "); 59 (Quote, "> "); 60 (Embedded, "=>e "); 61 (Link, "=> "); 62 (HeaderL1, "# "); 63 (HeaderL2, "## "); 64 (HeaderL3, "### "); 65 ] 66 in 67 let lt = 68 List.find_opt 69 (fun (_, pre) -> match_prefix_not_formatted line pre preformatted) 70 funs 71 in 72 match lt with Some v -> fst v | None -> Normal 73 74 let parse_simple_line line preformatted = 75 let cl_type = get_line_type line preformatted in 76 77 { line_type = cl_type; content = permute_line line cl_type } 78 79 (*TODO: Stop special casing this. *) 80 let is_format_line cl = 81 String.length cl = 3 && cl.[0] = '`' && cl.[1] = '`' && cl.[2] = '`' 82 83 let read_simple_learning_file fileName = 84 let ic = open_in fileName in 85 let rec readAll preformatted acc = 86 try 87 let cl = input_line ic in 88 let current_format = 89 if is_format_line cl then not preformatted else preformatted 90 in 91 if (not current_format) && not preformatted then 92 let current_line = parse_simple_line cl current_format in 93 if String.length acc != 0 then 94 parse_simple_line acc true :: current_line 95 :: readAll current_format "" 96 else current_line :: readAll current_format "" 97 else 98 readAll current_format 99 (if not (is_format_line cl) then 100 if String.length acc != 0 then acc ^ "\n" ^ cl else cl 101 else acc) 102 with End_of_file -> 103 close_in_noerr ic; 104 if String.length acc != 0 then parse_simple_line acc true :: [] else [] 105 in 106 readAll false ""