220 lines
11 KiB
Plaintext
220 lines
11 KiB
Plaintext
(*************************************************************************
|
|
* Copyright (C)
|
|
* 2019-2023 The University of Exeter
|
|
* 2018-2023 The University of Paris-Saclay
|
|
* 2018 The University of Sheffield
|
|
*
|
|
* License:
|
|
* This program can be redistributed and/or modified under the terms
|
|
* of the 2-clause BSD-style license.
|
|
*
|
|
* SPDX-License-Identifier: BSD-2-Clause
|
|
*************************************************************************)
|
|
|
|
chapter\<open>The Isabelle/DOF TestKit\<close>
|
|
|
|
theory
|
|
TestKit
|
|
imports
|
|
"Isabelle_DOF_Unit_Tests_document"
|
|
"Isabelle_DOF-Ontologies.Conceptual"
|
|
keywords "text-" "text-latex" :: document_body
|
|
and "text-assert-error" :: document_body
|
|
and "update_instance-assert-error" :: document_body
|
|
and "declare_reference-assert-error" :: document_body
|
|
and "value-assert-error" :: document_body
|
|
and "definition-assert-error" :: document_body
|
|
and "doc_class-assert-error" :: document_body
|
|
|
|
begin
|
|
|
|
section\<open>Testing Commands (exec-catch-verify - versions of DOF commands)\<close>
|
|
|
|
ML\<open>
|
|
|
|
fun gen_enriched_document_command2 name {body} cid_transform attr_transform markdown
|
|
((meta_args,
|
|
xstring_opt:(xstring * Position.T) option),
|
|
toks_list:Input.source list)
|
|
: theory -> theory =
|
|
let val toplvl = Toplevel.theory_toplevel
|
|
val ((binding,cid_pos), doc_attrs) = meta_args
|
|
val oid = Binding.name_of binding
|
|
val oid' = if meta_args = ODL_Meta_Args_Parser.empty_meta_args
|
|
then "output"
|
|
else oid
|
|
(* as side-effect, generates markup *)
|
|
fun check_n_tex_text thy toks = let val ctxt = Toplevel.presentation_context (toplvl thy);
|
|
val pos = Input.pos_of toks;
|
|
val _ = Context_Position.reports ctxt
|
|
[(pos, Markup.language_document (Input.is_delimited toks)),
|
|
(pos, Markup.plain_text)];
|
|
fun markup xml = let val m = if body then Markup.latex_body
|
|
else Markup.latex_heading
|
|
in [XML.Elem (m (Latex.output_name name),
|
|
xml)] end;
|
|
|
|
val text = Document_Output.output_document
|
|
(Proof_Context.init_global thy)
|
|
markdown toks
|
|
(* type file = {path: Path.T, pos: Position.T, content: string} *)
|
|
|
|
val strg = XML.string_of (hd (Latex.output text))
|
|
val file = {path = Path.make [oid' ^ "_snippet.tex"],
|
|
pos = @{here},
|
|
content = Bytes.string strg}
|
|
val dir = Path.append (Resources.master_directory thy) (Path.make ["latex_test"])
|
|
val _ = Generated_Files.write_file dir file
|
|
val _ = writeln (strg)
|
|
in () end \<comment> \<open>important observation: thy is not modified.
|
|
This implies that several text block can be
|
|
processed in parallel in a future, as long
|
|
as they are associated to one meta arg.\<close>
|
|
val handle_margs_opt = (if meta_args = ODL_Meta_Args_Parser.empty_meta_args
|
|
then I
|
|
else
|
|
Value_Command.Docitem_Parser.create_and_check_docitem
|
|
{is_monitor = false} {is_inline = false} {define = true}
|
|
binding (cid_transform cid_pos) (attr_transform doc_attrs))
|
|
(* ... generating the level-attribute syntax *)
|
|
in handle_margs_opt #> (fn thy => (app (check_n_tex_text thy) toks_list; thy))
|
|
end;
|
|
|
|
val _ =
|
|
Outer_Syntax.command ("text-", @{here}) "formal comment macro"
|
|
(ODL_Meta_Args_Parser.attributes -- Parse.opt_target -- Scan.repeat1 Parse.document_source
|
|
>> (Toplevel.theory o (gen_enriched_document_command2 "TTT" {body=true} I I {markdown = true} )));
|
|
|
|
(* copied from Pure_syn for experiments *)
|
|
|
|
fun output_document2 state markdown txt =
|
|
let
|
|
val ctxt = Toplevel.presentation_context state;
|
|
val pos = Input.pos_of txt;
|
|
val _ =
|
|
Context_Position.reports ctxt
|
|
[(pos, Markup.language_document (Input.is_delimited txt)),
|
|
(pos, Markup.plain_text)];
|
|
val txt' = Document_Output.output_document ctxt markdown txt
|
|
val strg = XML.string_of (hd (Latex.output txt'))
|
|
|
|
val _ = writeln (strg)
|
|
in Document_Output.output_document ctxt markdown txt end;
|
|
|
|
fun document_command2 markdown (loc, txt) =
|
|
let fun doc2 state = (case loc of
|
|
NONE => ignore (output_document2 state markdown txt)
|
|
| SOME (_, pos) =>(ISA_core.err
|
|
"Illegal target specification -- not a theory context"
|
|
pos))
|
|
fun out2 state = output_document2 state markdown txt
|
|
in Toplevel.keep doc2 o Toplevel.present_local_theory loc out2
|
|
end
|
|
|
|
fun gen_enriched_document_command3 assert name body trans at md (margs, src_list) thy
|
|
= (gen_enriched_document_command2 name body trans at md (margs, src_list) thy)
|
|
handle ERROR msg => (if assert src_list msg then (writeln ("Correct error: "^msg^": reported.");thy)
|
|
else error"Wrong error reported")
|
|
|
|
fun error_match src msg = (String.isPrefix (Input.string_of src) msg)
|
|
|
|
fun error_match2 [_, src] msg = error_match src msg
|
|
| error_match2 _ _ = error "Wrong text-assertion-error. Argument format <arg><match> required."
|
|
|
|
|
|
val _ =
|
|
Outer_Syntax.command ("text-assert-error", @{here}) "formal comment macro"
|
|
(ODL_Meta_Args_Parser.opt_attributes -- Parse.opt_target -- Scan.repeat1 Parse.document_source
|
|
>> (Toplevel.theory o (gen_enriched_document_command3 error_match2 "TTT" {body=true}
|
|
I I {markdown = true} )));
|
|
|
|
fun update_instance_command (args,src) thy =
|
|
(Monitor_Command_Parser.update_instance_command args thy
|
|
handle ERROR msg => (if error_match src msg
|
|
then (writeln ("Correct error: "^msg^": reported.");thy)
|
|
else error"Wrong error reported"))
|
|
val _ =
|
|
Outer_Syntax.command \<^command_keyword>\<open>update_instance-assert-error\<close>
|
|
"update meta-attributes of an instance of a document class"
|
|
(ODL_Meta_Args_Parser.attributes_upd -- Parse.document_source
|
|
>> (Toplevel.theory o update_instance_command));
|
|
|
|
val _ =
|
|
let fun create_and_check_docitem (((binding,cid_pos),doc_attrs),src) thy =
|
|
(Value_Command.Docitem_Parser.create_and_check_docitem
|
|
{is_monitor = false} {is_inline=true}
|
|
{define = false} binding (cid_pos) (doc_attrs) thy)
|
|
handle ERROR msg => (if error_match src msg
|
|
then (writeln ("Correct error: "^msg^": reported.");thy)
|
|
else error"Wrong error reported")
|
|
in Outer_Syntax.command \<^command_keyword>\<open>declare_reference-assert-error\<close>
|
|
"declare document reference"
|
|
(ODL_Meta_Args_Parser.attributes -- Parse.document_source
|
|
>> (Toplevel.theory o create_and_check_docitem))
|
|
end;
|
|
|
|
|
|
val _ =
|
|
let fun pass_trans_to_value_cmd (args, (((name, modes), t),src)) trans =
|
|
let val pos = Toplevel.pos_of trans
|
|
in trans |> Toplevel.theory
|
|
(fn thy => Value_Command.value_cmd {assert=false} args name modes t pos thy
|
|
handle ERROR msg => (if error_match src msg
|
|
then (writeln ("Correct error: "^msg^": reported."); thy)
|
|
else error"Wrong error reported"))
|
|
end
|
|
in Outer_Syntax.command \<^command_keyword>\<open>value-assert-error\<close> "evaluate and print term"
|
|
(ODL_Meta_Args_Parser.opt_attributes --
|
|
(Value_Command.opt_evaluator
|
|
-- Value_Command.opt_modes
|
|
-- Parse.term
|
|
-- Parse.document_source)
|
|
>> (pass_trans_to_value_cmd))
|
|
end;
|
|
|
|
val _ =
|
|
let fun definition_cmd' meta_args_opt decl params prems spec src bool ctxt =
|
|
Local_Theory.background_theory (Value_Command.meta_args_exec meta_args_opt) ctxt
|
|
|> (fn ctxt => Definition_Star_Command.definition_cmd decl params prems spec bool ctxt
|
|
handle ERROR msg => if error_match src msg
|
|
then (writeln ("Correct error: "^msg^": reported.")
|
|
; pair "Bound 0" @{thm refl}
|
|
|> pair (Bound 0)
|
|
|> rpair ctxt)
|
|
else error"Wrong error reported")
|
|
in
|
|
Outer_Syntax.local_theory' \<^command_keyword>\<open>definition-assert-error\<close> "constant definition"
|
|
(ODL_Meta_Args_Parser.opt_attributes --
|
|
(Scan.option Parse_Spec.constdecl -- (Parse_Spec.opt_thm_name ":" -- Parse.prop) --
|
|
Parse_Spec.if_assumes -- Parse.for_fixes -- Parse.document_source)
|
|
>> (fn (meta_args_opt, ((((decl, spec), prems), params), src)) =>
|
|
#2 oo definition_cmd' meta_args_opt decl params prems spec src))
|
|
end;
|
|
|
|
|
|
val _ =
|
|
let fun add_doc_class_cmd' ((((overloaded, hdr), (parent, attrs)),((rejects,accept_rex),invars)), src) =
|
|
(fn thy => OntoParser.add_doc_class_cmd {overloaded = overloaded} hdr parent attrs rejects accept_rex invars thy
|
|
handle ERROR msg => (if error_match src msg
|
|
then (writeln ("Correct error: "^msg^": reported."); thy)
|
|
else error"Wrong error reported"))
|
|
in
|
|
Outer_Syntax.command \<^command_keyword>\<open>doc_class-assert-error\<close>
|
|
"define document class"
|
|
((OntoParser.parse_doc_class -- Parse.document_source)
|
|
>> (Toplevel.theory o add_doc_class_cmd'))
|
|
end
|
|
|
|
val _ =
|
|
Outer_Syntax.command ("text-latex", \<^here>) "formal comment (primary style)"
|
|
(Parse.opt_target -- Parse.document_source >> document_command2 {markdown = true});
|
|
|
|
\<close>
|
|
|
|
(* a little auto-test *)
|
|
text-latex\<open>dfg\<close>
|
|
|
|
text-assert-error[aaaa::A]\<open> @{A \<open>sdf\<close>}\<close>\<open>reference ontologically inconsistent\<close>
|
|
|
|
end
|