Skip to content

Commit

Permalink
WIP: Fix type-annotate action for functions
Browse files Browse the repository at this point in the history
  • Loading branch information
3Rafal committed Mar 10, 2023
1 parent 18f5b9a commit e50147f
Showing 1 changed file with 9 additions and 5 deletions.
14 changes: 9 additions & 5 deletions ocaml-lsp-server/src/code_actions/action_type_annotate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4,25 +4,29 @@ open Fiber.O
let action_kind = "type-annotate"

let check_typeable_context pipeline pos_start =
let open Typedtree in
let pos_start = Mpipeline.get_lexing_pos pipeline pos_start in
let typer = Mpipeline.typer_result pipeline in
let browse = Mbrowse.of_typedtree (Mtyper.get_typedtree typer) in
let is_exp_constrained = function
| Typedtree.Texp_constraint _, _, _ -> true
| Typedtree.Texp_coerce (Some _, _), _, _ -> true
| Texp_constraint _, _, _ -> true
| Texp_coerce (Some _, _), _, _ -> true
| _ -> false
in
let is_pat_constrained = function
| Typedtree.Tpat_constraint _, _, _ -> true
| Tpat_constraint _, _, _ -> true
| _ -> false
in
let is_valid p extras =
if List.exists ~f:p extras then `Invalid else `Valid
in
match Mbrowse.enclosing pos_start [ browse ] with
| (_, Pattern { pat_desc = Tpat_var _; _})
:: (_, Value_binding { vb_expr = { exp_desc = Texp_function _; _} ; _ })
:: _ -> `Invalid (* TODO: traverse function arguments *)
| (_, Expression e) :: _ -> is_valid is_exp_constrained e.exp_extra
| (_, Pattern { pat_desc = Typedtree.Tpat_any; _ })
:: (_, Pattern { pat_desc = Typedtree.Tpat_alias _; pat_extra; _ })
| (_, Pattern { pat_desc = Tpat_any; _ })
:: (_, Pattern { pat_desc = Tpat_alias _; pat_extra; _ })
:: _ -> is_valid is_pat_constrained pat_extra
| (_, Pattern p) :: _ -> is_valid is_pat_constrained p.pat_extra
| _ :: _ | [] -> `Invalid
Expand Down

0 comments on commit e50147f

Please sign in to comment.