pax_global_header00006660000000000000000000000064135702302760014517gustar00rootroot0000000000000052 comment=32223e1c69aae188643203c0f99b581f7576025d octavius-1.2.2/000077500000000000000000000000001357023027600133565ustar00rootroot00000000000000octavius-1.2.2/.gitignore000066400000000000000000000000731357023027600153460ustar00rootroot00000000000000_build tmp *~ \.\#* \#*# *.native *.byte *.install .merlin octavius-1.2.2/.merlin000066400000000000000000000001611357023027600146430ustar00rootroot00000000000000# include assemblage package for editor assistance in assemble.ml PKG assemblage B _build/lib-octavius S src octavius-1.2.2/CHANGES.md000066400000000000000000000004761357023027600147570ustar00rootroot00000000000000v1.2.1 ------ - Avoid using `Location.report_error`, which is removed in OCaml 4.08. v1.2.0 ------ - Follow odoc evolution. v1.1.0 ------ - switch build to jbuilder. - changed versionning to be in sync with the other odoc packages. v0.2.0 ------- Added "@canonical" tag. v0.1.0 ------- Initial opam release. octavius-1.2.2/LICENSE.md000066400000000000000000000013451357023027600147650ustar00rootroot00000000000000Copyright (c) 2015 Leo White Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. octavius-1.2.2/Makefile000066400000000000000000000002621357023027600150160ustar00rootroot00000000000000# This makefile is used for dev convenience. It is removed # by the distribution process. .PHONY: build doc clean build: dune build doc: dune build @doc clean: dune clean octavius-1.2.2/README.md000066400000000000000000000005031357023027600146330ustar00rootroot00000000000000Octavius — ocamldoc comment syntax parser ----------------------------------------- v1.2.2 Octavius is a library to parse the `ocamldoc` comment syntax. ## Installation Octavius can be installed with `opam`: opam install octavius If you don't use `opam` consult the [`opam`](opam) file for build instructions. octavius-1.2.2/doc/000077500000000000000000000000001357023027600141235ustar00rootroot00000000000000octavius-1.2.2/doc/api.odocl000066400000000000000000000000111357023027600157060ustar00rootroot00000000000000Octavius octavius-1.2.2/doc/style.css000066400000000000000000000064421357023027600160030ustar00rootroot00000000000000/* A style for ocamldoc. Daniel C. Buenzli */ /* Reset a few things. */ html,body,div,span,applet,object,iframe,h1,h2,h3,h4,h5,h6,p,blockquote,pre, a,abbr,acronym,address,big,cite,code,del,dfn,em,font,img,ins,kbd,q,s,samp, small,strike,strong,sub,sup,tt,var,b,u,i,center,dl,dt,dd,ol,ul,li,fieldset, form,label,legend,table,caption,tbody,tfoot,thead,tr,th,td { margin: 0; padding: 0; border: 0 none; outline: 0; font-size: 100%; font-weight: inherit; font-style:inherit; font-family:inherit; line-height: inherit; vertical-align: baseline; text-align:inherit; color:inherit; background: transparent; } table { border-collapse: collapse; border-spacing: 0; } /* Basic page layout */ body { font: normal 10pt/1.375em helvetica, arial, sans-serif; text-align:left; margin: 1.375em 10%; min-width: 40ex; max-width: 72ex; color: black; background: transparent /* url(line-height-22.gif) */; } b { font-weight: bold } em { font-style: italic } tt, code, pre { font-family: WorkAroundWebKitAndMozilla, monospace; font-size: 1em; } pre code { font-size : inherit; } .codepre { margin-bottom:1.375em /* after code example we introduce space. */ } .superscript,.subscript { font-size : 0.813em; line-height:0; margin-left:0.4ex;} .superscript { vertical-align: super; } .subscript { vertical-align: sub; } /* ocamldoc markup workaround hacks */ hr, hr + br, div + br, center + br, span + br, ul + br, ol + br, pre + br { display: none } /* annoying */ div.info + br { display:block} .codepre br + br { display: none } h1 + pre { margin-bottom:1.375em} /* Toplevel module description */ /* Sections and document divisions */ /* .navbar { margin-bottom: -1.375em } */ h1 { font-weight: bold; font-size: 1.5em; /* margin-top:1.833em; */ margin-top:0.917em; padding-top:0.875em; border-top-style:solid; border-width:1px; border-color:#AAA; } h2 { font-weight: bold; font-size: 1.313em; margin-top: 1.048em } h3 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } h3 { font-weight: bold; font-size: 1em; margin-top: 1.375em} h4 { font-style: italic; } /* Used by OCaml's own library documentation. */ h6 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } .h7 { font-weight: bold; font-size: 1em; margin-top: 1.375em } p { margin-top: 1.375em } pre { margin-top: 1.375em } .info { margin: 0.458em 0em -0.458em 2em;}/* Description of types values etc. */ td .info { margin:0; padding:0; margin-left: 2em;} /* Description in indexes */ ul, ol { margin-top:0.688em; padding-bottom:0.687em; list-style-position:outside} ul + p, ol + p { margin-top: 0em } ul { list-style-type: square } /* h2 + ul, h3 + ul, p + ul { } */ ul > li { margin-left: 1.375em; } ol > li { margin-left: 1.7em; } /* Links */ a, a:link, a:visited, a:active, a:hover { color : #00B; text-decoration: none } a:hover { text-decoration : underline } *:target {background-color: #FFFF99;} /* anchor highlight */ /* Code */ .keyword { font-weight: bold; } .comment { color : red } .constructor { color : green } .string { color : brown } .warning { color : red ; font-weight : bold } /* Functors */ .paramstable { border-style : hidden ; padding-bottom:1.375em} .paramstable code { margin-left: 1ex; margin-right: 1ex } .sig_block {margin-left: 1em} /* Images */ img { margin-top: 1.375em } octavius-1.2.2/dune-project000066400000000000000000000005101357023027600156740ustar00rootroot00000000000000(lang dune 1.11) (name octavius) (generate_opam_files true) (maintainers leo@lpw25.net) (authors "Leo White ") (source (github ocaml-doc/octavius)) (documentation http://ocaml-doc.github.io/octavius/) (license ISC) (package (name octavius) (depends (ocaml (>= 4.03.0))) (tags (doc ocamldoc org:ocaml-doc))) octavius-1.2.2/octavius.opam000066400000000000000000000011551357023027600160730ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead version: "1.2.2" opam-version: "2.0" maintainer: ["leo@lpw25.net"] authors: ["Leo White "] license: "ISC" homepage: "https://github.com/ocaml-doc/octavius" doc: "http://ocaml-doc.github.io/octavius/" bug-reports: "https://github.com/ocaml-doc/octavius/issues" depends: [ "dune" {>= "1.11"} "ocaml" {>= "4.03.0"} ] build: [ ["dune" "subst"] {pinned} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/ocaml-doc/octavius.git" octavius-1.2.2/src/000077500000000000000000000000001357023027600141455ustar00rootroot00000000000000octavius-1.2.2/src/common.ml000066400000000000000000000016161357023027600157730ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) exception ParserError of Errors.location * Errors.parser_error exception LexerError of Errors.location * Errors.lexer_error octavius-1.2.2/src/common.mli000066400000000000000000000016161357023027600161440ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) exception ParserError of Errors.location * Errors.parser_error exception LexerError of Errors.location * Errors.lexer_error octavius-1.2.2/src/dune000066400000000000000000000001371357023027600150240ustar00rootroot00000000000000(ocamllex octLexer) (ocamlyacc octParser) (library (name octavius) (public_name octavius)) octavius-1.2.2/src/errors.ml000066400000000000000000000060551357023027600160210ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) type position = { line: int; column: int; } type location = { start: position; finish: position; } type parser_error = | Unclosed of { opening_loc: location; opening: string; items: string; closing: string; } | Expecting of string type lexer_error = | Unmatched_target | Unmatched_code | Unmatched_pre_code | Unmatched_html_code | Unterminated_verbatim | Unterminated_target | Unterminated_code | Unterminated_pre_code | Unterminated_ref | Unterminated_html_code | Nested_verbatim | Nested_target | Nested_pre_code | Nested_html_code | Expected_see | Unterminated_see_url | Unterminated_see_file | Unterminated_see_doc | Expected_ident | Expected_string | Expected_version type error = | Lexer of lexer_error | Parser of parser_error type t = { error: error; location: location; } let lexer_message = function | Unmatched_target -> "unmatched '%%}'" | Unmatched_code -> "unmatched ']'" | Unmatched_pre_code -> "unmatched ']}'" | Unmatched_html_code -> "unmatched ''" | Unterminated_verbatim -> "unterminated '{v'" | Unterminated_target -> "unterminated '{%%'" | Unterminated_code -> "unterminated '['" | Unterminated_pre_code -> "unterminated '{['" | Unterminated_ref -> "unterminated '{!'" | Unterminated_html_code -> "unterminated ''" | Nested_verbatim -> "nested '{v'" | Nested_target -> "nested '{%%'" | Nested_pre_code -> "nested '{['" | Nested_html_code -> "nested ''" | Expected_see -> "expected < url >, 'filename' or \"document\"" | Unterminated_see_url -> "unterminated url" | Unterminated_see_file -> "unterminated filename" | Unterminated_see_doc -> "unterminated document name" | Expected_ident -> "expected identifier" | Expected_string -> "expected string" | Expected_version -> "expected version string" let parser_message = function | Unclosed { opening_loc = _; opening; items; closing } -> "'" ^ opening ^ "' not closed, expected " ^ items ^ " or '" ^ closing ^ "'" | Expecting nonterm -> nonterm ^ " expected" let message = function | Lexer x -> lexer_message x | Parser x -> parser_message x octavius-1.2.2/src/errors.mli000066400000000000000000000032431357023027600161660ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) type position = { line: int; column: int; } type location = { start: position; finish: position; } type parser_error = | Unclosed of { opening_loc: location; opening: string; items: string; closing: string; } | Expecting of string type lexer_error = | Unmatched_target | Unmatched_code | Unmatched_pre_code | Unmatched_html_code | Unterminated_verbatim | Unterminated_target | Unterminated_code | Unterminated_pre_code | Unterminated_ref | Unterminated_html_code | Nested_verbatim | Nested_target | Nested_pre_code | Nested_html_code | Expected_see | Unterminated_see_url | Unterminated_see_file | Unterminated_see_doc | Expected_ident | Expected_string | Expected_version type error = | Lexer of lexer_error | Parser of parser_error type t = { error: error; location: location; } val message: error -> string octavius-1.2.2/src/index.mld000066400000000000000000000002241357023027600157500ustar00rootroot00000000000000{1 A parser for a simple documentation language} The API is browsable {{!Octavius}here} and the accepted syntax is described {{!page-syntax}here}. octavius-1.2.2/src/octLexer.mli000066400000000000000000000015561357023027600164440ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) val main : Lexing.lexbuf -> OctParser.token val read_ref : Lexing.lexbuf -> OctParser.token octavius-1.2.2/src/octLexer.mll000066400000000000000000000407321357023027600164460ustar00rootroot00000000000000{ (** The lexer for string to build text structures. *) open Common open Types open OctParser open Errors open Lexing (* Convert lexing position into error position *) let position p = { line = p.pos_lnum; column = p.pos_cnum - p.pos_bol; } (* Fetch the current lexing location *) let curr_loc lexbuf = { start = position lexbuf.lex_start_p; finish = position lexbuf.lex_curr_p; } let dummy_loc = let dummy_pos = { line = -1; column = -1; } in { start = dummy_pos; finish = dummy_pos; } let incr_line lexbuf = let pos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum; } (* To buffer verbatim strings and code sections *) let string_buffer = Buffer.create 32 let buffer_empty = ref true let reset_string_buffer () = Buffer.reset string_buffer; buffer_empty := true let buffer_char c = Buffer.add_char string_buffer c; buffer_empty := false let buffer_lexeme lexbuf = let s = lexeme lexbuf in Buffer.add_string string_buffer s; buffer_empty := false let get_raw_buffered_string () = Buffer.contents string_buffer let remove_opening_blanks s = let length = String.length s in let rec loop i = if i >= length then "" else match s.[i] with | ' ' | '\009' | '\012' -> loop (i + 1) | '\010' -> String.sub s (i + 1) (length - (i + 1)) | '\013' -> let j = i + 1 in if j < length && s.[j] = '\010' then String.sub s (j + 1) (length - (j + 1)) else String.sub s j (length - j) | _ -> String.sub s i (length - i) in loop 0 let remove_closing_blanks s = let length = String.length s in let rec loop i = if i < 0 then "" else match s.[i] with | ' ' | '\009' | '\012' -> loop (i - 1) | '\010' -> let j = i - 1 in if j >= 0 && s.[j] = '\013' then String.sub s 0 j else String.sub s 0 i | _ -> String.sub s 0 (i + 1) in loop (length - 1) let get_buffered_string () = get_raw_buffered_string () |> remove_opening_blanks |> remove_closing_blanks let buffer_not_empty () = not !buffer_empty (* To store the position of the beginning of a verbatim string or code section *) let start_loc = ref (dummy_pos, dummy_pos) let set_start_loc lexbuf = start_loc := (lexbuf.lex_start_p, lexbuf.lex_curr_p) let get_start_loc () = let start_p, curr_p = !start_loc in { start = position start_p; finish = position curr_p; } let use_start_loc lexbuf = let start_p, _ = !start_loc in lexbuf.lex_start_p <- start_p (* To store the positions of nested code sections *) let inner_start_locs = ref [];; let push_inner_start_loc lexbuf = inner_start_locs := (curr_loc lexbuf) :: !inner_start_locs let pop_inner_start_loc () = match !inner_start_locs with | [] -> None | l :: rest -> inner_start_locs := rest; Some l (* To store the format of a target *) let target_format = ref None;; (* To store the kind of a reference *) let ref_kind = ref RK_element;; (* To store the start of a see description *) let see_loc = ref dummy_loc;; let set_see_loc lexbuf = see_loc := curr_loc lexbuf let get_see_loc () = !see_loc (* To store the modules of a module list *) let module_list_modules = ref [];; let reset_module_list () = module_list_modules := [];; let add_module md = module_list_modules := md :: !module_list_modules let get_module_list () = List.rev !module_list_modules (* Hash table of styles (initialized below) *) let style_table = Hashtbl.create 19 (* Hash table of reference kinds (initialized below) *) let ref_kind_table = Hashtbl.create 19 (* Hash table of tags (initialized below) *) let tag_table = Hashtbl.create 19 } let newline = ('\010' | "\013\010" ) let blank = [' ' '\009' '\012'] let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] let alpha = ['a'-'z' '\223'-'\246' '\248'-'\255' 'A'-'Z' '\192'-'\214' '\216'-'\222'] let identchar = ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] let decimal_literal = ['0'-'9'] ['0'-'9' '_']* let versionchar = ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9' '!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '^' '|' '~'] (* The characters which are not the start of any tokens other than Char *) let safe = [^ ' ' '\009' '\012' '\010' '\013' '\\' '{' '}' '[' ']' '<' 'v' '%' '@' '-' '+'] let escape = '\\' (['{' '}' '[' ']' '@'] as chr) let ident = alpha identchar* ('.' alpha identchar*)* let version = versionchar+ let tag = '@' let begin = '{' let end = '}' let item = '-' let superscript = '^' let subscript = '_' let verb = 'v' let target = '%' let target_format = (identchar+ as fmt) ':' let begin_code = "[" let end_code = "]" let begin_pre_code = "{[" let end_pre_code = "]}" let link = ':' let ref = '!' let ref_kind = (ident as kind) ':' let title = decimal_literal as num let title_label = ":" (ident as lbl) (* Shortcut format for lists *) let minus = '-' let plus = '+' (* html marks, to use as alternative markup *) let html_bold = '<' (['b' 'B'] as tag) blank* '>' let html_end_bold = "' let html_italic = '<' (['i' 'I'] as tag) blank* '>' let html_end_italic = "' let html_title = '<' (['h' 'H'](['0'-'9']+ as num) as tag) blank* '>' let html_end_title = "' let html_list = '<' (['u' 'U']['l' 'L'] as tag) blank* '>' let html_end_list = "' let html_enum = '<' (['o' 'O']['l' 'L'] as tag) blank* '>' let html_end_enum = "' let html_item = '<' (['l' 'L']['i' 'I'] as tag) blank* '>' let html_end_item = "' let html_code = '<' ['c' 'C']['o' 'O']['d' 'D']['e' 'E'] blank* '>' let html_end_code = "' let html_center = '<' (['c' 'C']['e' 'E']['n' 'N']['t' 'T']['e' 'E']['r' 'R'] as tag) blank* '>' let html_end_center = "' let html_left = '<' (['l' 'L']['e' 'E']['f' 'F']['t' 'T'] as tag) blank* '>' let html_end_left = "' let html_right = '<' (['r' 'R']['i' 'I']['g' 'G']['h' 'H']['t' 'T'] as tag) blank* '>' let html_end_right = "' rule main = parse | escape { Char (String.make 1 chr) } | tag (ident as tag) { try let f = Hashtbl.find tag_table tag in set_start_loc lexbuf; f lexbuf with Not_found -> Custom tag } | begin { BEGIN } | end { END } | begin verb { reset_string_buffer (); set_start_loc lexbuf; verb lexbuf } | begin target target_format { reset_string_buffer (); set_start_loc lexbuf; target_format := Some fmt; target lexbuf } | begin target { reset_string_buffer (); set_start_loc lexbuf; target_format := None; target lexbuf } | target end { raise (LexerError(curr_loc lexbuf, Unmatched_target)) } | begin_code { reset_string_buffer (); set_start_loc lexbuf; code lexbuf } | end_code { raise (LexerError(curr_loc lexbuf, Unmatched_code)) } | begin_pre_code { reset_string_buffer (); set_start_loc lexbuf; pre_code lexbuf } | end_pre_code { raise (LexerError(curr_loc lexbuf, Unmatched_pre_code)) } | begin ref { reset_string_buffer (); set_start_loc lexbuf; ref_kind := RK_element; reference lexbuf } | begin ref (ident as lbl) end { if lbl = "indexlist" then Special_Ref SRK_index_list else Ref(RK_element, lbl) } | begin ref ref_kind { reset_string_buffer (); set_start_loc lexbuf; if kind = "modules" then begin reset_module_list (); module_list lexbuf end else begin let kind = try Hashtbl.find ref_kind_table kind with Not_found -> RK_custom kind in ref_kind := kind; reference lexbuf end } | begin link { reset_string_buffer (); set_start_loc lexbuf; ref_kind := RK_link; reference lexbuf } | begin title title_label? { Title (int_of_string num, lbl) } | begin (ident as style) { try Hashtbl.find style_table style with Not_found -> Style (SK_custom style) } | begin item { Item true } | begin superscript { Style SK_superscript } | begin subscript { Style SK_subscript } | html_code { reset_string_buffer (); set_start_loc lexbuf; html_code lexbuf } | html_end_code { raise (LexerError(curr_loc lexbuf, Unmatched_html_code)) } | html_title { HTML_Title(tag, int_of_string num) } | html_end_title { HTML_END_Title (int_of_string num) } | html_bold { HTML_Bold (String.make 1 tag)} | html_end_bold { HTML_END_BOLD } | html_italic { HTML_Italic (String.make 1 tag)} | html_end_italic { HTML_END_ITALIC } | html_center { HTML_Center tag} | html_end_center { HTML_END_CENTER } | html_left { HTML_Left tag} | html_end_left { HTML_END_LEFT } | html_right { HTML_Right tag} | html_end_right { HTML_END_RIGHT } | html_list { HTML_List tag} | html_end_list { HTML_END_LIST } | html_enum { HTML_Enum tag} | html_end_enum { HTML_END_ENUM } | html_item { HTML_Item tag} | html_end_item { HTML_END_ITEM } | minus { MINUS } | plus { PLUS } | newline { incr_line lexbuf; NEWLINE } | blank+ { BLANK } | safe+ | _ { Char (lexeme lexbuf) } | eof { EOF } and identifier = parse | blank+ { identifier lexbuf } | newline { incr_line lexbuf; identifier lexbuf } | ident as id { use_start_loc lexbuf; id } | eof | _ { raise (LexerError(curr_loc lexbuf, Expected_ident)) } and see = parse | blank+ { see lexbuf } | newline { incr_line lexbuf; see lexbuf } | '<' { reset_string_buffer (); set_see_loc lexbuf; see_url lexbuf } | '\'' { reset_string_buffer (); set_see_loc lexbuf; see_file lexbuf } | '"' { reset_string_buffer (); set_see_loc lexbuf; see_doc lexbuf } | eof | _ { raise (LexerError(curr_loc lexbuf, Expected_see)) } and see_url = parse | '>' { use_start_loc lexbuf; See_url (get_raw_buffered_string ()) } | eof { raise (LexerError(get_see_loc (), Unterminated_see_url)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; see_url lexbuf } | [^ '>' '\010' '\013' ]+ | _ { buffer_lexeme lexbuf; see_url lexbuf } and see_file = parse | '\'' { use_start_loc lexbuf; See_file (get_raw_buffered_string ()) } | eof { raise (LexerError(get_see_loc (), Unterminated_see_file)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; see_file lexbuf } | [^ '\'' '\010' '\013' ]+ | _ { buffer_lexeme lexbuf; see_file lexbuf } and see_doc = parse | '\"' { use_start_loc lexbuf; See_doc (get_raw_buffered_string ()) } | eof { raise (LexerError(get_see_loc (), Unterminated_see_doc)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; see_doc lexbuf } | [^ '\"' '\010' '\013' ]+ | _ { buffer_lexeme lexbuf; see_doc lexbuf } and version = parse | blank+ { version lexbuf } | newline { incr_line lexbuf; version lexbuf } | version as v { use_start_loc lexbuf; v } | eof | _ { raise (LexerError(curr_loc lexbuf, Expected_version)) } and verb = parse | escape { buffer_char chr; verb lexbuf } | begin verb { raise (LexerError(curr_loc lexbuf, Nested_verbatim)) } | verb end { use_start_loc lexbuf; Verb (get_buffered_string ()) } | eof { raise (LexerError(get_start_loc (), Unterminated_verbatim)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; verb lexbuf } | safe+ | blank+ | _ { buffer_lexeme lexbuf; verb lexbuf } and target = parse | escape { buffer_char chr; target lexbuf } | begin target { raise (LexerError(curr_loc lexbuf, Nested_target)) } | target end { use_start_loc lexbuf; Target(!target_format, get_buffered_string ()) } | eof { raise (LexerError(get_start_loc (), Unterminated_target)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; target lexbuf } | safe+ | blank+ | _ { buffer_lexeme lexbuf; target lexbuf } and code = parse | escape { buffer_char chr; code lexbuf } | begin_code { push_inner_start_loc lexbuf; buffer_lexeme lexbuf; code lexbuf } | end_code { match pop_inner_start_loc () with | None -> use_start_loc lexbuf; Code(get_raw_buffered_string ()) | Some _ -> buffer_lexeme lexbuf; code lexbuf } | eof { match pop_inner_start_loc () with | None -> raise (LexerError(get_start_loc (), Unterminated_code)) | Some l -> raise (LexerError(l, Unterminated_code)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; code lexbuf } | safe+ | blank+ | _ { buffer_lexeme lexbuf; code lexbuf } and pre_code = parse | escape { buffer_char chr; pre_code lexbuf } | begin_pre_code { raise (LexerError(curr_loc lexbuf, Nested_pre_code)) } | end_pre_code { use_start_loc lexbuf; Pre_Code (get_buffered_string ()) } | eof { raise (LexerError(get_start_loc (), Unterminated_pre_code)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; pre_code lexbuf } | safe+ | blank+ | _ { buffer_lexeme lexbuf; pre_code lexbuf } and html_code = parse | escape { buffer_char chr; html_code lexbuf } | html_code { raise (LexerError(curr_loc lexbuf, Nested_html_code)) } | html_end_code { use_start_loc lexbuf; Code(get_raw_buffered_string ()) } | eof { raise (LexerError(get_start_loc (), Unterminated_html_code)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; html_code lexbuf } | safe+ | blank+ | _ { buffer_lexeme lexbuf; html_code lexbuf } and reference = parse | escape { buffer_char chr; reference lexbuf } | end { use_start_loc lexbuf; Ref(!ref_kind, get_buffered_string ()) } | eof { raise (LexerError(get_start_loc (), Unterminated_ref)) } | newline { incr_line lexbuf; buffer_lexeme lexbuf; reference lexbuf } | safe+ | blank+ | _ { buffer_lexeme lexbuf; reference lexbuf } and module_list = parse | escape { buffer_char chr; module_list lexbuf } | end { if buffer_not_empty () then add_module (get_buffered_string ()); use_start_loc lexbuf; Special_Ref(SRK_module_list (get_module_list ())) } | eof { raise (LexerError(get_start_loc (), Unterminated_ref)) } | blank+ { if buffer_not_empty () then begin add_module (get_buffered_string ()); reset_string_buffer () end; module_list lexbuf } | newline { incr_line lexbuf; if buffer_not_empty () then begin add_module (get_buffered_string ()); reset_string_buffer () end; module_list lexbuf } | safe+ | _ { buffer_lexeme lexbuf; module_list lexbuf } and read_ref = parse | "-" { MINUS } | "." { DOT } | [^ '-' '.']+ { Ref_part (Lexing.lexeme lexbuf) } | eof { EOF } { (* Initialize style hash table *) let _ = List.iter (fun (kwd, tok) -> Hashtbl.add style_table kwd tok) [ ("b", Style SK_bold); ("e", Style SK_emphasize); ("C", Style SK_center); ("L", Style SK_left); ("R", Style SK_right); ("i", Style SK_italic); ("ul", LIST); ("ol", ENUM); ("li", Item false); ] (* Initialize reference kind hash table *) let _ = List.iter (fun (kind, tok) -> Hashtbl.add ref_kind_table kind tok) [ ("val", RK_value); ("type", RK_type); ("exception", RK_exception); ("module", RK_module); ("modtype", RK_module_type); ("class", RK_class); ("classtype", RK_class_type); ("attribute", RK_attribute); ("method", RK_method); ("section", RK_section); ("recfield", RK_recfield); ("const", RK_const); ] (* Initialize tag hash table *) let _ = List.iter (fun (tag, tok) -> Hashtbl.add tag_table tag tok) [ ("author", fun _ -> AUTHOR); ("deprecated", fun _ -> DEPRECATED); ("param", fun lexbuf -> Param (identifier lexbuf)); ("raise", fun lexbuf -> Raise (identifier lexbuf)); ("return", fun _ -> RETURN); ("inline", fun _ -> INLINE); ("see", fun lexbuf -> See (see lexbuf)); ("since", fun lexbuf -> Since (version lexbuf)); ("before", fun lexbuf -> Before (version lexbuf)); ("version", fun lexbuf -> Version (version lexbuf)); ("canonical", fun lexbuf -> Canonical (identifier lexbuf)); ] } octavius-1.2.2/src/octParser.mly000066400000000000000000000326621357023027600166430ustar00rootroot00000000000000%{ open Common open Types open Errors (* Convert lexing position into error position *) let position p = { line = p.Lexing.pos_lnum; column = p.Lexing.pos_cnum - p.Lexing.pos_bol; } (* Get the location of the symbol at a given position *) let rhs_loc n = { start = position (Parsing.rhs_start_pos n); finish = position (Parsing.rhs_end_pos n); } (* Useful strings *) let sempty = "" let sspace = " " let snewline = "\n" let sblank_line = "\n\n" let sminus = "-" let splus = "+" (* Accumulators for text elements *) type text_item = Blank | Newline | Blank_line | String of string | Element of text_element let iminus = String sminus let iplus = String splus let skip_blank_or_newline = function | Blank :: rest -> rest | Newline :: rest -> rest | til -> til let rec skip_whitespace = function | Blank :: rest -> skip_whitespace rest | Newline :: rest -> skip_whitespace rest | Blank_line :: rest -> skip_whitespace rest | til -> til let rec convert acc stracc = function | [] -> if stracc = [] then acc else (Raw (String.concat sempty stracc)) :: acc | ti :: rest -> let acc, stracc = match ti with | Blank -> acc, (sspace :: stracc) | Newline -> acc, (snewline :: stracc) | String s -> acc, (s :: stracc) | Blank_line -> let acc = if stracc = [] then acc else (Raw (String.concat sempty stracc)) :: acc in (Newline :: acc), [] | Element e -> let acc = if stracc = [] then acc else (Raw (String.concat sempty stracc)) :: acc in (e :: acc), [] in convert acc stracc rest let text til = let til = skip_whitespace til in let til = skip_whitespace (List.rev til) in convert [] [] til let inner til = let til = skip_blank_or_newline til in let til = skip_blank_or_newline (List.rev til) in convert [] [] til (* Error messages *) let unclosed opening_name opening_num items closing_name closing_num = let error = let opening_loc = rhs_loc opening_num in let opening = opening_name in let closing = closing_name in Unclosed { opening_loc; opening; items; closing } in let loc = rhs_loc closing_num in raise (ParserError(loc, error)) let expecting num nonterm = let error = Expecting nonterm in let loc = rhs_loc num in raise (ParserError(loc, error)) (* Utilities for error messages *) let title_to_string (i, _) = let i = string_of_int i in "{" ^ i let style_to_string = function | SK_bold -> "{b" | SK_italic -> "{i" | SK_emphasize -> "{e" | SK_center -> "{C" | SK_left -> "{L" | SK_right -> "{R" | SK_superscript -> "{^" | SK_subscript -> "{_" | SK_custom s -> "{" ^ s let item_to_string i = if i then "{-" else "{li" let html_open_to_string t = "<" ^ t ^ ">" let html_close_to_string t = "" %} %token Param %token AUTHOR %token Version %token See %token Since %token Before %token DEPRECATED %token Raise %token RETURN %token INLINE %token Custom %token Canonical %token BEGIN %token END %token Title %token Style %token LIST %token ENUM %token Item %token Ref %token Special_Ref %token Code %token Pre_Code %token Verb %token Target %token HTML_Bold %token HTML_END_BOLD %token HTML_Center %token HTML_END_CENTER %token HTML_Left %token HTML_END_LEFT %token HTML_Right %token HTML_END_RIGHT %token HTML_Italic %token HTML_END_ITALIC %token HTML_Title %token HTML_END_Title %token HTML_List %token HTML_END_LIST %token HTML_Enum %token HTML_END_ENUM %token HTML_Item %token HTML_END_ITEM %token MINUS %token PLUS %token NEWLINE %token EOF %token BLANK %token Char %token DOT %token Ref_part %start main %type main %start reference_parts %type <(string option * string) list> reference_parts %nonassoc Shift_error %right error %nonassoc Reduce_error %% /* Main symbol */ main: | text { (text $1, []) } | text tags { (text $1, List.rev $2) } ; /* Entry point for reference parsing */ reference_parts: | reference_part { [$1] } | reference_parts DOT reference_part { $3 :: $1 } ; reference_part: | Ref_part { (None, $1) } | Ref_part MINUS Ref_part { (Some $1, $3) } ; /* Tags */ tags: | simple_tag whitespace { [$1] } | simple_tag error { expecting 2 "tag" } | text_tag { [$1] } | tags simple_tag whitespace { $2 :: $1 } | tags simple_tag error { expecting 3 "tag" } | tags text_tag { $2 :: $1 } ; simple_tag: | Version { Version $1 } | Since { Since $1 } | Canonical { Canonical $1 } ; text_tag: | AUTHOR string { Author (String.concat sempty $2) } | See text { See($1, (text $2)) } | Before text { Before($1, (text $2)) } | DEPRECATED text { Deprecated (text $2) } | Param text { Param($1, (text $2)) } | Raise text { Raised_exception($1, (text $2)) } | RETURN text { Return_value (text $2) } | INLINE whitespace { Inline } | Custom text { Custom($1, (text $2)) } ; /* Various forms of whitespace */ blanks: | BLANK { () } | blanks BLANK { () } ; newline: | NEWLINE { () } | blanks NEWLINE { () } | newline BLANK { () } ; blank_line: | newline NEWLINE { () } | blank_line BLANK { () } | blank_line NEWLINE { () } ; whitespace: | /* empty */ { [] } %prec Shift_error | blanks { [Blank] } | newline { [Newline] } | blank_line { [Blank_line] } ; /* Strings */ string: | whitespace { [] } | error { expecting 1 "string" } | string_body whitespace { List.rev $1 } ; string_body: | string_item { [snd $1] } | string_body string_item { (snd $2) :: (fst $2) :: $1 } ; string_item: | string_char { (sempty, $1) } | blanks string_char { (sspace, $2) } | newline string_char { (snewline, $2) } | blank_line string_char { (sblank_line, $2) } ; string_char: | Char { $1 } | MINUS { sminus } | PLUS { splus } /* Basic text */ text: | whitespace { $1 } | error { expecting 1 "text" } | text_body whitespace { List.rev_append $1 $2 } | text_body_with_line shortcut_list_final { List.rev_append $1 [Element (List $2)] } | text_body_with_line shortcut_enum_final { List.rev_append $1 [Element (Enum $2)] } ; text_body: | text_item { [$1] } | blanks text_item { [$2; Blank] } | text_body text_item { $2 :: $1 } | text_body blanks text_item { $3 :: Blank :: $1 } | text_body_with_line text_item_after_line { List.rev_append $2 $1 } ; text_body_with_line: | newline { [Newline] } | blank_line { [Blank_line] } | text_body newline { Newline :: $1 } | text_body blank_line { Blank_line :: $1 } | text_body_with_line shortcut_list { (Element (List $2)) :: $1 } | text_body_with_line shortcut_enum { (Element (Enum $2)) :: $1 } ; text_item: | MINUS { iminus } | PLUS { iplus } | text_element { Element $1 } | html_text_element { Element $1 } | Char { String $1 } ; text_item_after_line: | MINUS text_item { [iminus; $2] } | PLUS text_item { [iplus; $2] } | text_element { [Element $1] } | html_text_element { [Element $1] } | Char { [String $1] } ; /* Text within shortcut lists and enums */ shortcut_text_body: | blanks text_item { [$2; Blank] } | newline text_item_after_line { List.rev_append $2 [Newline] } | shortcut_text_body text_item { $2 :: $1 } | shortcut_text_body blanks text_item { $3 :: Blank :: $1 } | shortcut_text_body newline text_item_after_line { List.rev_append $3 (Newline :: $1) } ; /* Shortcut lists and enums */ shortcut_list: | MINUS blank_line { [[]] } | MINUS shortcut_text_body blank_line { [inner (List.rev $2)] } | MINUS newline shortcut_list { [] :: $3 } | MINUS shortcut_text_body newline shortcut_list { (inner (List.rev $2)) :: $4 } | MINUS error { expecting 2 "list item" } ; shortcut_enum: | PLUS blank_line { [[]] } | PLUS shortcut_text_body blank_line { [inner (List.rev $2)] } | PLUS newline shortcut_enum { [] :: $3 } | PLUS shortcut_text_body newline shortcut_enum { (inner (List.rev $2)) :: $4 } | PLUS error { expecting 2 "enumerated list item" } ; /* Shortcut lists and enums that don't require a final blank line */ shortcut_list_final: | MINUS whitespace { [[]] } | MINUS shortcut_text_body whitespace { [inner (List.rev $2)] } | MINUS newline shortcut_list_final { [] :: $3 } | MINUS shortcut_text_body newline shortcut_list_final { (inner (List.rev $2)) :: $4 } ; shortcut_enum_final: | PLUS whitespace { [[]] } | PLUS shortcut_text_body whitespace { [inner (List.rev $2)] } | PLUS newline shortcut_enum_final { [] :: $3 } | PLUS shortcut_text_body newline shortcut_enum_final { (inner (List.rev $2)) :: $4 } ; /* Text elements */ text_element: | Title text END { let n, l = $1 in Title (n, l, (inner $2)) } | Title text error { unclosed (title_to_string $1) 1 "text" "}" 3 } | Style text END { Style($1, (inner $2)) } | Style text error { unclosed (style_to_string $1) 1 "text" "}" 3 } | LIST whitespace list whitespace END { List (List.rev $3) } | LIST whitespace list error { unclosed "{ul" 1 "list item" "}" 4 } | LIST whitespace error { expecting 3 "list item" } | ENUM whitespace list whitespace END { Enum (List.rev $3) } | ENUM whitespace list error { unclosed "{ol" 1 "list item" "}" 4 } | ENUM whitespace error { expecting 3 "enumerated list item" } | Ref { let k, n = $1 in Ref (k, n, None) } | BEGIN Ref text END { let k, n = $2 in Ref (k, n, Some (inner $3)) } | BEGIN Ref text error { unclosed "{" 1 "text" "}" 3 } | Special_Ref { Special_ref $1 } | Code { Code $1 } | Pre_Code { PreCode $1 } | Verb { Verbatim $1 } | Target { let t, s = $1 in Target (t, s) } ; /* Lists */ list: | item { [ $1 ] } | list whitespace item { $3 :: $1 } ; item: Item text END { inner $2 } | Item text error { unclosed (item_to_string $1) 1 "text" "}" 3 } ; /* HTML-sytle text elements */ html_text_element: HTML_Title text HTML_END_Title { let _, n = $1 in if n <> $3 then raise Parse_error; Title(n, None, (inner $2)) } | HTML_Title text error { let tag, _ = $1 in unclosed (html_open_to_string tag) 1 "text" (html_close_to_string tag) 3 } | HTML_Bold text HTML_END_BOLD { Style(SK_bold, (inner $2)) } | HTML_Bold text error { unclosed (html_open_to_string $1) 1 "text" (html_close_to_string $1) 3 } | HTML_Italic text HTML_END_ITALIC { Style(SK_italic, (inner $2)) } | HTML_Italic text error { unclosed (html_open_to_string $1) 1 "text" (html_close_to_string $1) 3 } | HTML_Center text HTML_END_CENTER { Style(SK_center, (inner $2)) } | HTML_Center text error { unclosed (html_open_to_string $1) 1 "text" (html_close_to_string $1) 3 } | HTML_Left text HTML_END_LEFT { Style(SK_left, (inner $2)) } | HTML_Left text error { unclosed (html_open_to_string $1) 1 "text" (html_close_to_string $1) 3 } | HTML_Right text HTML_END_RIGHT { Style(SK_right, (inner $2)) } | HTML_Right text error { unclosed (html_open_to_string $1) 1 "text" (html_close_to_string $1) 3 } | HTML_List whitespace html_list whitespace HTML_END_LIST { List (List.rev $3) } | HTML_List whitespace html_list error { unclosed (html_open_to_string $1) 1 "HTML list item" (html_close_to_string $1) 4 } | HTML_List whitespace error { expecting 2 "HTML list item" } | HTML_Enum whitespace html_list whitespace HTML_END_ENUM { Enum (List.rev $3) } | HTML_Enum whitespace html_list error { unclosed (html_open_to_string $1) 1 "HTML list item" (html_close_to_string $1) 4 } | HTML_Enum whitespace error { expecting 3 "HTML list item" } ; /* HTML-style lists */ html_list: | html_item { [ $1 ] } | html_list whitespace html_item { $3 :: $1 } ; html_item: HTML_Item text HTML_END_ITEM { inner $2 } | HTML_Item text error { unclosed (html_open_to_string $1) 1 "text" (html_close_to_string $1) 3 } ; %% octavius-1.2.2/src/octavius.ml000066400000000000000000000027761357023027600163500ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) module Types = Types module Errors = Errors open Common type nonrec ('a, 'b) result = ('a, 'b) result = | Ok of 'a | Error of 'b let parse lexbuf = let open Errors in try Ok (OctParser.main OctLexer.main lexbuf) with | ParserError(location, err) -> Error {Errors.error = Parser err; location} | LexerError(location, err) -> Error {Errors.error = Lexer err; location} let parse_ref lexbuf = let open Errors in try Ok (OctParser.reference_parts OctLexer.read_ref lexbuf) with | ParserError(location, err) -> Error {Errors.error = Parser err; location} | LexerError(location, err) -> Error {Errors.error = Lexer err; location} let print fmt t = Print.pp fmt t octavius-1.2.2/src/octavius.mli000066400000000000000000000021111357023027600165000ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) module Types = Types module Errors = Errors type nonrec ('a, 'b) result = ('a, 'b) result = | Ok of 'a | Error of 'b val parse : Lexing.lexbuf -> (Types.t, Errors.t) result val parse_ref : Lexing.lexbuf -> ((string option * string) list, Errors.t) result val print : Format.formatter -> Types.t -> unit octavius-1.2.2/src/print.ml000066400000000000000000000115401357023027600156340ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) open Types open Format let fmt_style_kind f x = match x with | SK_bold -> fprintf f "SK_bold" | SK_italic -> fprintf f "SK_italic" | SK_emphasize -> fprintf f "SK_emphasize" | SK_center -> fprintf f "SK_center" | SK_left -> fprintf f "SK_left" | SK_right -> fprintf f "SK_right" | SK_superscript -> fprintf f "SK_superscript" | SK_subscript -> fprintf f "SK_subscript" | SK_custom s -> fprintf f "SK_custom %s" s let fmt_ref_kind f x = match x with | RK_element -> fprintf f "RK_element" | RK_module -> fprintf f "RK_module" | RK_module_type -> fprintf f "RK_module_type" | RK_class -> fprintf f "RK_class" | RK_class_type -> fprintf f "RK_class_type" | RK_value -> fprintf f "RK_value" | RK_type -> fprintf f "RK_type" | RK_exception -> fprintf f "RK_exception" | RK_attribute -> fprintf f "RK_attribute" | RK_method -> fprintf f "RK_method" | RK_section -> fprintf f "RK_section" | RK_recfield -> fprintf f "RK_recfield" | RK_const -> fprintf f "RK_const" | RK_link -> fprintf f "RK_link" | RK_custom s -> fprintf f "RK_custom %s" s let fmt_see_ref f x = match x with | See_url s -> fprintf f "See_url %s" s | See_file s -> fprintf f "See_file %s" s | See_doc s -> fprintf f "See_doc %s" s let line i f s = fprintf f "%s" (String.make ((2*i) mod 72) ' '); fprintf f s let list i f ppf l = match l with | [] -> line i ppf "[]\n"; | _ :: _ -> line i ppf "[\n"; List.iter (f (i+1) ppf) l; line i ppf "]\n" let option i f ppf x = match x with | None -> line i ppf "None\n"; | Some x -> line i ppf "Some\n"; f (i+1) ppf x let string i ppf s = line i ppf "\"%s\"\n" s let special_ref_kind i ppf x = line i ppf "special_ref_kind\n"; let i = i+1 in match x with | SRK_module_list sl -> line i ppf "SRK_module_list\n"; list i string ppf sl | SRK_index_list -> line i ppf "SRK_index_list\n" let rec text_element i ppf x = line i ppf "text_element\n"; let i = i+1 in match x with | Raw s -> line i ppf "Raw\n"; string i ppf s | Code s -> line i ppf "Code\n"; string i ppf s | PreCode s -> line i ppf "PreCode\n"; string i ppf s | Verbatim s -> line i ppf "Verbatim\n"; string i ppf s | Style(sk, txt) -> line i ppf "Style %a\n" fmt_style_kind sk; text i ppf txt | List txtl -> line i ppf "List\n"; list i text ppf txtl | Enum txtl -> line i ppf "Enum\n"; list i text ppf txtl | Newline -> line i ppf "Newline\n" | Title(n, so, txt) -> line i ppf "Title %d\n" n; option i string ppf so; text i ppf txt | Ref(rk, s, txto) -> line i ppf "Ref %a\n" fmt_ref_kind rk; string i ppf s; option i text ppf txto | Special_ref srk -> line i ppf "Special\n"; special_ref_kind i ppf srk | Target(so, s) -> line i ppf "Target\n"; option i string ppf so; string i ppf s and text i ppf x = line i ppf "text\n"; list (i+1) text_element ppf x let tag i ppf x = line i ppf "tag\n"; let i = i+1 in match x with Author s -> line i ppf "Author\n"; string i ppf s | Version s -> line i ppf "Version\n"; string i ppf s | See(sr, txt) -> line i ppf "See %a\n" fmt_see_ref sr; text i ppf txt | Since s -> line i ppf "Since\n"; string i ppf s | Before(s, txt) -> line i ppf "Before\n"; string i ppf s; text i ppf txt | Deprecated txt -> line i ppf "Deprecated\n"; text i ppf txt | Param(s, txt) -> line i ppf "Param\n"; string i ppf s; text i ppf txt | Raised_exception(s, txt) -> line i ppf "Raised_exception\n"; string i ppf s; text i ppf txt | Return_value txt -> line i ppf "Return_value\n"; text i ppf txt | Inline -> line i ppf "Inline\n" | Custom(s, txt) -> line i ppf "Custom %s\n" s; text i ppf txt | Canonical s -> line i ppf "Canonical %s" s let documentation i ppf (txt, tags) = line i ppf "Cinfo\n"; text (i+1) ppf txt; list (i+1) tag ppf tags let pp ppf x = documentation 0 ppf x octavius-1.2.2/src/print.mli000066400000000000000000000015041357023027600160040ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) open Format val pp : formatter -> Types.t -> unit octavius-1.2.2/src/syntax.mld000066400000000000000000000025531357023027600161760ustar00rootroot00000000000000{1:accepted_syntax Accepted syntax} Octavious should be fully compatible with {{:http://caml.inria.fr/pub/docs/manual-ocaml/ocamldoc.html#sec339}the syntax accepted by ocamldocs}. However, some additions were made which are described below. {2:include_tags New \@tags} To control the rendering of includes (which are "expanded" by odoc) the following tags have been added - [@inline]: will make the [include ...] line disappear from the interface and the content of the module (type) being included will be inserted in its place. - [@open]: the [include ...] line will be shown expanded initially - [@close]: the [include ...] line will be shown folded initially {2:references_syntax New syntax for references} ocamldoc's syntax for references doesn't (as far as we can see) allow to disambiguate the reference on the last line in the following: {[ module M : sig module type S : sig type t end module S : sig type t end end (** Some reference to {!M.S.t} *) ]} Indeed the syntax ocamldoc provides only allows to disambiguate the last part of the reference, but not intermediate ones. So here one cannot say: "I want S to be a module type". We have extended the syntax for references to be able to disambiguate intermediate parts of the path. In the previous example the fully disambiguated reference could look like this: [{!module-M.module-type-S.type-t}]. octavius-1.2.2/src/types.ml000066400000000000000000000061671357023027600156550ustar00rootroot00000000000000(* * Copyright (c) 2015 Leo White * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) (** Types for the information collected in comments. *) (** The differents kinds of style. *) type style_kind = | SK_bold | SK_italic | SK_emphasize | SK_center | SK_left | SK_right | SK_superscript | SK_subscript | SK_custom of string (** The differents kinds of element references. *) type ref_kind = RK_element | RK_module | RK_module_type | RK_class | RK_class_type | RK_value | RK_type | RK_exception | RK_attribute | RK_method | RK_section | RK_recfield | RK_const | RK_link | RK_custom of string (* The different kinds of special reference *) type special_ref_kind = SRK_module_list of string list | SRK_index_list and text_element = | Raw of string (** Raw text. *) | Code of string (** The string is source code. *) | PreCode of string (** The string is pre-formatted source code. *) | Verbatim of string (** String 'as is'. *) | Style of style_kind * text (** Text tagged with a style. *) | List of text list (** A list. *) | Enum of text list (** An enumerated list. *) | Newline (** To force a line break. *) | Title of int * string option * text (** Style number, optional label, and text. *) | Ref of ref_kind * string * text option (** A reference to an element. Complete name and kind. An optional text can be given to display this text instead of the element name.*) | Special_ref of special_ref_kind (** Special kinds of reference *) | Target of string option * string (** (target, code) : to specify code for a specific target format *) (** [text] is a list of text_elements. The order matters. *) and text = text_element list (** The different forms of references in \@see tags. *) type see_ref = See_url of string | See_file of string | See_doc of string (** Tags *) type tag = Author of string (** \@author tag *) | Version of string (** \@version tag *) | See of see_ref * text (** \@see tag *) | Since of string (** \@since tag *) | Before of string * text (** \@before tag *) | Deprecated of text (** \@deprecated tag *) | Param of string * text (** \@param tag *) | Raised_exception of string * text (** \@raise tag *) | Return_value of text (** \@return tag *) | Inline (** \@inline tag *) | Custom of string * text (** custom tag *) | Canonical of string (** \@canonical tag *) (** A special comment *) type t = text * tag list octavius-1.2.2/test/000077500000000000000000000000001357023027600143355ustar00rootroot00000000000000octavius-1.2.2/test/dune000066400000000000000000000001351357023027600152120ustar00rootroot00000000000000(executable (name main) (public_name octavius) (libraries octavius compiler-libs.common)) octavius-1.2.2/test/main.ml000066400000000000000000000014111357023027600156100ustar00rootroot00000000000000 let process file lexbuf = match Octavius.parse lexbuf with | Octavius.Ok t -> Format.printf "%a@." Octavius.print t | Octavius.Error { error; location } -> let msg = Octavius.Errors.message error in Format.fprintf Format.err_formatter "@[<2>octavius:%s:%d.%d-%d.%d:@ %s@]@." file location.start.line location.start.column location.finish.line location.finish.column msg let () = if Array.length Sys.argv <> 2 then begin Format.eprintf "Usage: %s FILE@." Sys.argv.(0); exit 1 end; let file = Sys.argv.(1) in if not (Sys.file_exists file) then begin Format.eprintf "File \"%s\" does not exist@." file; exit 1 end; let ic = open_in file in let lexbuf = Lexing.from_channel ic in process file lexbuf; close_in ic