@ -23,46 +23,69 @@ type type_nullability = Nullable | Nonnull [@@deriving sexp]
type nullability = { ret_nullability : type_nullability ; param_nullability : type_nullability list }
[ @@ deriving sexp ]
type parsing_error = BadStructure | MalformedNullability | LackingParam | MalformedParam
type parsing_error =
| BadStructure
| BadClassName
| BadMethodName
| BadReturnNullability
| BadParamList
| BadParam
let string_of_parsing_error = function
| BadStructure ->
" BadStructure "
| MalformedNullability ->
" MalformedNullability "
| LackingParam ->
" LackingParam "
| MalformedParam ->
" MalformedParam "
" Accepted format is <class>#<method>(<params>)[<return nullability>] "
| BadMethodName ->
" Method name should be a valid identifier "
| BadClassName ->
" Class name should be fully qualified, including package name "
| BadReturnNullability ->
" Unexpected string after the closing parenthesis, expected @Nullable "
| BadParamList ->
" Params should be separated by a comma, followed by a single space "
| BadParam ->
" Each param should have form of [@Nullable] <fully qualified type name> "
let pp_unique_repr fmt signature = Sexp . pp fmt ( sexp_of_unique_repr signature )
let pp_nullability fmt nullability = Sexp . pp fmt ( sexp_of_nullability nullability )
let parse_nullability str =
match String . strip str with
| " @Nullable " ->
Ok Nullable
| " " ->
Ok Nonnull
| _ ->
Error MalformedNullability
let nullable_annotation = " @Nullable "
let identifier_regexp = lazy ( Str . regexp " [_a-zA-Z][_a-zA-Z0-9]*$ " )
let class_regexp =
(* package should be a list of valid identifiers, separared by '.' *)
let package_name = " [_a-zA-Z][_a-zA-Z0-9 \\ .]* " in
(* class name should be a list of identifiers, separated by $ ( a symbol for a nested class ) *)
let class_name = " [_a-zA-Z][_a-zA-Z0-9 \\ $]* " in
lazy ( Str . regexp ( package_name ^ " \\ . " ^ class_name ^ " $ " ) )
let type_regexp =
(* identifiers, possiblibly separated by `.` ( package delimiter ) or `$` ( a symbol for a nested class ) *)
lazy ( Str . regexp " [_a-zA-Z][_a-zA-Z0-9 \\ $ \\ .]* " )
let parse_class str =
if Str . string_match ( Lazy . force class_regexp ) str 0 then Ok str else Error BadClassName
let parse_param_type str =
if Str . string_match ( Lazy . force type_regexp ) str 0 then Ok str else Error BadParam
let whitespace_no_line_break = lazy ( Str . regexp " [ \t ]+ " )
let parse_param str =
let trimmed_param = String . strip str in
match Str . split ( Lazy . force whitespace_no_line_break ) trimmed_param with
match String . split str ~ on : ' ' with
| [ nullability_str ; typ ] ->
parse_nullability nullability_str > > = fun nullability -> Ok ( typ , nullability )
Result . ok_if_true ( String . equal nullable_annotation nullability_str ) ~ error : BadParam
> > = fun _ -> parse_param_type typ > > = fun parsed_typ -> Ok ( parsed_typ , Nullable )
| [ typ ] ->
Ok ( typ, Nonnull )
parse_param_type typ > > = fun parsed_typ -> Ok ( parsed_ typ, Nonnull )
| [] ->
Error LackingParam
Error BadParamList
| _ ->
Error Malforme dParam
Error Ba dParam
(* Given a list of results and a binding function, returns Ok ( results ) if all results
@ -74,28 +97,49 @@ let bind_list list_of_results ~f =
f element > > = fun success_result -> Ok ( accumulated_success_results @ [ success_result ] ) )
let strip_first_space str =
String . chop_prefix str ~ prefix : " " | > Result . of_option ~ error : BadParamList
let split_params str =
let stripped = String . strip str in
(* Empty case is the special one: lack of params mean an empty list,
not a list of a single empty string * )
if String . is_empty stripped then [] else String . split stripped ~ on : ','
if String . is_empty str then Ok []
else
String . split str ~ on : ','
| > List . mapi ~ f : ( fun param_index param_as_str -> ( param_index , param_as_str ) )
| > bind_list ~ f : ( fun ( param_index , str ) ->
match param_index with
| 0 ->
Ok str
| _ ->
(* Params should be separated by ", ", so we expect a space after each comma *)
strip_first_space str )
let parse_params str = split_params str | > bind_list ~ f : parse_param
let parse_params str = split_params str >> = fun params -> bind_list params ~ f : parse_param
let parse_method_name str =
match String . strip str with " <init> " -> Constructor | _ as method_name -> Method method_name
match str with
| " <init> " ->
Ok Constructor
| _ as method_name ->
if Str . string_match ( Lazy . force identifier_regexp ) method_name 0 then Ok ( Method method_name )
else Error BadMethodName
let match_after_close_brace ( split_result : Str . split_result list ) =
(* After close brace there can be either nothing or return type nullability information *)
match split_result with
| [] ->
parse_nullability " "
Ok Nonnull
| [ Text nullability ] ->
parse_nullability nullability
Result . ok_if_true
( String . equal ( " " ^ nullable_annotation ) nullability )
~ error : BadReturnNullability
> > = fun _ -> Ok Nullable
| _ ->
Error BadStructure
Error Bad ReturnNullability
let match_after_open_brace ( split_result : Str . split_result list ) =
@ -118,10 +162,12 @@ let hashsign_and_parentheses = lazy (Str.regexp "[#()]")
let parse str =
(* Expected string is <Class>#<method> ( <params> ) <ret_nullability>,
let ' s look what is between # , ( , and ) * )
match Str . full_split ( Lazy . force hashsign_and_parentheses ) str with
match Str . full_split ( Lazy . force hashsign_and_parentheses ) ( String . rstrip str ) with
| Text class_name_str :: Delim " # " :: Text method_name_str :: Delim " ( " :: rest ->
let method_name = parse_method_name method_name_str in
let class_name = String . strip class_name_str in
parse_class class_name_str
> > = fun class_name ->
parse_method_name method_name_str
> > = fun method_name ->
match_after_open_brace rest
> > = fun ( parsed_params , ret_nullability ) ->
let param_types , param_nullability = List . unzip parsed_params in