Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file label.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210(*
* Copyright (c) 2018 Thomas Gazagnaire <thomas@gazagnaire.org>
*
* 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.
*)moduleRelation=structtypet=Eq|Neq|Le|Lt|Ge|Gtletppppf=function|Eq ->Fmt.stringppf"="|Neq->Fmt.stringppf"<>"|Gt->Fmt.stringppf">"|Ge->Fmt.stringppf">="|Lt->Fmt.stringppf"<"|Le->Fmt.stringppf"<="letcompare =function|Eq ->(=)|Neq->(<>)|Lt->(<)|Le->(<=)|Gt->(>)|Ge->(>=)letof_string=function|"<>"->Neq|">="->Ge|">"->Gt|"<="->Le|"<"->Lt|"="->Eq|_->(* can not happen, filtered by the regexp *)assertfalseletre=letopenReincompile@@seq[bos;group(rep(alt[alnum;char'-';char'_']));group(alt[str"<=";str">=";str "<>";str "<";str">";str"="]);group(repany);eos;]letraw_parses=matchRe.exec_optreswith|None->(s,None)|Someg->(tryletlabel=Re.Group.getg1inletop=of_string(Re.Group.getg2)inletvalue=Re.Group.getg3in(label,Some(op,value))with Not_found ->(s,None))endtypenon_det=Nd_output|Nd_commandletdefault_non_det=Nd_outputtypeblock_kind=OCaml|Cram|Toplevel|Include(* TODO: [t] needs to be refactored because it usually is used as a [t list]
but most of these tags are not supposed to be specified multiple times.
There can be at most one Language_tag, similarly specifying multiple
Block_kind and Version labels is confusing at best. [t] should probably
be refactored to represent all labels and make sure that some labels
can be specified 0 or 1 times, while others are indeed lists. *)typet=|Dirofstring|Source_treeofstring|Fileofstring|Partofstring|Envofstring|Skip|Non_det ofnon_det option|VersionofRelation.t*Ocaml_version.t|Os_typeofRelation.t*string|Setofstring*string|Unsetofstring|Block_kindofblock_kind(* Specifies the language tag that is specified in the [mli] syntax, if
any. Can be left out if none is specified, in such case it will also
not be added back. *)|Language_tagofstringletpp_block_kindppf=function|OCaml->Fmt.stringppf"ocaml"|Cram->Fmt.stringppf"cram"|Toplevel->Fmt.stringppf"toplevel"|Include->Fmt.stringppf"include"letppppf=function|Dird->Fmt.pfppf"dir=%s"d|Source_trees->Fmt.pfppf"source-tree=%s"s|Filef->Fmt.pfppf"file=%s"f|Part p->Fmt.pfppf"part=%s"p|Env e->Fmt.pfppf"env=%s"e|Skip->Fmt.stringppf"skip"|Non_detNone->Fmt.stringppf"non-deterministic"|Non_det(SomeNd_output)->Fmt.stringppf"non-deterministic=output"|Non_det(SomeNd_command)->Fmt.stringppf"non-deterministic=command"|Version(op,v)->Fmt.pf ppf"version%a%a"Relation.ppopOcaml_version.ppv|Os_type(op,v)->Fmt.pfppf"os_type%a%s"Relation.ppopv|Set(v,x)->Fmt.pfppf"set-%s=%s"vx|Unsetx->Fmt.pfppf"unset-%s"x|Block_kind bk->pp_block_kindppf bk|Language_taglanguage_tag ->Fmt.stringppflanguage_tagletis_prefix~prefixs=letlen_prefix=String.lengthprefix inifString.length s>len_prefixthenString.equal (String.subs0len_prefix)prefixelsefalse(* [is_prefix ~prefix s] is always checked before. *)letsplit_prefix~prefixs=letlen_prefix=String.lengthprefix inString.subslen_prefix(String.lengths-len_prefix)letnon_eq_op~label=Util.Result.errorf "Label `%s` requires assignment using the `=` operator."labelletinvalid_value~label~allowed_valuesvalue=Util.Result.errorf"%S is not a valid value for label `%s`. Valid values are %s." valuelabel(Util.String.english_conjonctionallowed_values)letdoesnt_accept_value~label~valueres=matchvaluewith|Some_->Util.Result.errorf"Label `%s` does not allow a value."label|None->Okresletrequires_value~label~valuef=matchvaluewith|Some(op,v)->fopv|None->Util.Result.errorf"Label `%s` requires a value."labelletrequires_eq_value~label~valuef=requires_value~label~value(funopvalue->matchopwithRelation.Eq-> Ok(fvalue)|_->non_eq_op~label)letinterpretlabelvalue=matchlabelwith|"skip"->doesnt_accept_value~label~valueSkip|"ocaml" -> doesnt_accept_value~label~value(Block_kindOCaml)|"cram"->doesnt_accept_value~label~value(Block_kindCram)|"toplevel"->doesnt_accept_value~label~value(Block_kindToplevel)|"include"->doesnt_accept_value~label~value(Block_kindInclude)|vwhenis_prefix~prefix:"unset-"v->doesnt_accept_value~label~value(Unset (split_prefix ~prefix:"unset-"v))|"version"->requires_value~label~value(funopv->matchOcaml_version.of_stringvwith|Okv->Ok(Version(op,v))|Error (`Msge)->Util.Result.errorf"Invalid `version` label value: %s."e)|"os_type"->requires_value~label~value(funopv->Ok(Os_type(op,v)))|"non-deterministic"->(matchvaluewith|None->Ok(Non_detNone)|Some(Relation.Eq,"output")->Ok(Non_det(SomeNd_output))|Some(Relation.Eq,"command")->Ok(Non_det(SomeNd_command))|Some(Relation.Eq,v)->letallowed_values=["<none>";{|"command"|};{|"output"|}]ininvalid_value~label~allowed_valuesv|Some_->non_eq_op~label)|"dir"->requires_eq_value ~label~value(funx->Dirx)|"source-tree"->requires_eq_value~label~value(funx->Source_tree x)|"file"->requires_eq_value~label~value(funx->File x)|"part"->requires_eq_value~label~value(funx->Part x)|"env"->requires_eq_value~label~value(funx->Envx)|lwhenis_prefix~prefix:"set-"l->requires_eq_value~label~value(funx->Set(split_prefix~prefix:"set-"l,x))|l->Error(`Msg(Format.sprintf"`%s` is not a valid label."l))letof_strings=letfaccs=letlabel,value=Relation.raw_parsesinmatch(acc,interpretlabelvalue)with|Oklabels,Oklabel->Ok(label ::labels)|Errormsgs,Ok_->Errormsgs|Ok_,Errormsg->Error[msg]|Errormsgs,Errormsg->Error(msg::msgs)inmatch swith|""->Ok[]|s->(letsplit=String.split_on_char','sinmatchList.fold_leftf(Ok[])splitwith|Oklabels ->Ok(List.revlabels)|Error msgs ->Error(List.revmsgs))