Merge pull request #373 from nberth/improve-copybook-detection

Use contents prefix to improve the detection of copybooks

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## [0.1.4] Next release
 
 ### Added
+- Detection of copybooks based on contents prefix and configured search path [373](https://github.com/OCamlPro/superbol-studio-oss/pull/373)
 - Support for connecting to the LSP server remotely (TCP only) [#102](https://github.com/OCamlPro/superbol-studio-oss/pull/102)
 - Support for Symbol Renaming command [#351](https://github.com/OCamlPro/superbol-studio-oss/pull/351)
 - Show documentation comments on hover information [#350](https://github.com/OCamlPro/superbol-studio-oss/pull/350)

opam/osx/superbol_project-osx.opam

@@ -53,6 +53,7 @@ depends: [
   "ocplib_stuff-osx" {>= "0.4.0" & < "1.0.0"}
   "ezr_toml-osx" {= version}
   "ez_file-osx" {>= "0.3.0" & < "1.0.0"}
+  "cobol_preproc-osx" {= version}
   "cobol_config-osx" {= version}
   "cobol_common-osx" {= version}
   "odoc" {with-doc}

opam/superbol_project.opam

@@ -51,6 +51,7 @@ depends: [
   "ocplib_stuff" {>= "0.4.0" & < "1.0.0"}
   "ezr_toml" {= version}
   "ez_file" {>= "0.3.0" & < "1.0.0"}
+  "cobol_preproc" {= version}
   "cobol_config" {= version}
   "cobol_common" {= version}
   "odoc" {with-doc}

opam/windows/superbol_project-windows.opam

@@ -53,6 +53,7 @@ depends: [
   "ocplib_stuff-windows" {>= "0.4.0" & < "1.0.0"}
   "ezr_toml-windows" {= version}
   "ez_file-windows" {>= "0.3.0" & < "1.0.0"}
+  "cobol_preproc-windows" {= version}
   "cobol_config-windows" {= version}
   "cobol_common-windows" {= version}
   "odoc" {with-doc}

src/lsp/cobol_common/copybook.ml

@@ -28,15 +28,16 @@ type lookup_error =
     lookup_config: lookup_config;
   }
 
-(** Filename extensions that we should treat as copybooks and not main
-    programs. *)
-let copybook_extensions =  (* this must be a subset of {!libfile_extensions}. *)
-  ["cpy"; "cbx"]
+(** Filename extensions that are searched when looking up copybooks. *)
+let copybook_extensions =
+  ["cpy"; "cbl"; "cob"]
 
-let libfile_extensions =
-  ["cpy"; "cbl"; "cob"; "cbx"]
+(** Filename extensions that we should not treat as main programs, but as
+    copybooks instead. *)
+let copybookonly_extensions =
+  ["cpy"; "copy"; "copybook"]
 
-let lookup_config ?(libexts = libfile_extensions) libpath =
+let lookup_config ?(libexts = copybook_extensions) libpath =
   {
     lookup_path = libpath;
     lookup_exts = List.map String.lowercase_ascii libexts;

src/lsp/cobol_common/copybook.mli

@@ -37,6 +37,7 @@ val pp_lookup_error: lookup_error Pretty.printer
 (* --- *)
 
 val copybook_extensions: string list
+val copybookonly_extensions: string list
 
 (** [find_lib ~lookup_config ?fromfile ?libname txtname] attempts to locate a
     file containing the copybook [txtname], which is a file named [txtname],

src/lsp/cobol_indent_old/indenter.ml

@@ -40,5 +40,4 @@ let indent_range ~dialect ~source_format ~indent_config ~range ~filename ~conten
       ; acc = []
       ; range }
   in
-  (* NB: note here we ignore diagnostics *)
-  state.result.acc
+  state.acc

src/lsp/cobol_lsp/lsp_document.ml

@@ -164,12 +164,14 @@ let rec inspect_at ~position ({ copybook; rewinder; textdoc; _ } as doc) =
         None
 
 (** Creates a record for a document that is not yet parsed or analyzed. *)
-let blank ~project ?copybook textdoc =
-  let copybook = match copybook with
-    | Some p -> p
-    | None -> Lsp_project.detect_copybook project
-                ~uri:(Lsp.Text_document.documentUri textdoc)
+let blank ~project textdoc =
+  let uri = Lsp.Text_document.documentUri textdoc in
+  let copybook =
+    Lsp_project.detect_copybook project ~uri
+      ~contents:(Lsp.Text_document.text textdoc)
   in
+  if copybook then
+    Lsp_io.log_debug "%s appears to be a copybook" (Lsp.Uri.to_string uri);
   {
     project;
     textdoc;
@@ -183,9 +185,9 @@ let blank ~project ?copybook textdoc =
 
 let position_encoding = `UTF8
 
-let load ~project ?copybook doc =
+let load ~project doc =
   let textdoc = Lsp.Text_document.make ~position_encoding doc in
-  let doc = blank ~project ?copybook textdoc in
+  let doc = blank ~project textdoc in
   try parse_and_analyze doc
   with e -> raise @@ Internal_error (doc, e, Printexc.get_raw_backtrace ())
 

src/lsp/cobol_lsp/lsp_project.ml

@@ -71,8 +71,9 @@ let copybook_lookup_config_for ~uri project =
   Superbol_project.copybook_lookup_config_for ~filename:(Lsp.Uri.to_path uri)
     project
 
-let detect_copybook ~uri project =
-  Superbol_project.detect_copybook ~filename:(Lsp.Uri.to_path uri) project
+let detect_copybook ~uri ?contents project =
+  Superbol_project.detect_copybook ~filename:(Lsp.Uri.to_path uri)
+    ?contents project
 
 let relative_path_for ~uri project =
   Superbol_project.relative_path_for ~filename:(Lsp.Uri.to_path uri) project

src/lsp/cobol_lsp/lsp_project.mli

@@ -57,9 +57,9 @@ val rootdir_for: uri:Lsp.Uri.t -> layout:layout -> rootdir
 val copybook_lookup_config_for
   : uri:Lsp.Uri.t -> t -> Cobol_common.Copybook.lookup_config
 
-(** [detect_copybook ~uri project] indicates whether a document at the given URI
-    for [project] should be treated as a copybook. *)
-val detect_copybook: uri:Lsp.Uri.t -> t -> bool
+(** [detect_copybook ~uri ?contents project] indicates whether a document at the
+    given URI for [project] should be treated as a copybook. *)
+val detect_copybook: uri:Lsp.Uri.t -> ?contents:string -> t -> bool
 
 (** {1 Cached representation} *)
 

src/lsp/cobol_lsp/lsp_server.ml

@@ -663,10 +663,10 @@ let on_change_workspace_folders
 
 
 let add ~doc:(DidOpenTextDocumentParams.{ textDocument = { uri; _ }; _ } as doc)
-    ?copybook registry =
+    registry =
   let add_in_project project registry =
     try
-      let doc = Lsp_document.load ~project ?copybook doc in
+      let doc = Lsp_document.load ~project doc in
       let registry = dispatch_diagnostics doc registry in
       add_or_replace_doc doc registry
     with Lsp_document.Internal_error (doc, e, backtrace) ->
@@ -677,7 +677,7 @@ let add ~doc:(DidOpenTextDocumentParams.{ textDocument = { uri; _ }; _ } as doc)
 
 
 let did_open (DidOpenTextDocumentParams.{ textDocument = { uri; text; _ };
-                                          _ } as doc) ?copybook registry =
+                                          _ } as doc) registry =
   (* Try first with a lookup for the project in a cache, and then by
      creating/loading the project. *)
   let rec aux ~try_cache registry =
@@ -690,7 +690,7 @@ let did_open (DidOpenTextDocumentParams.{ textDocument = { uri; text; _ };
         retrieve_project_for ~uri registry |>
         aux ~try_cache:false                   (* try again without the cache *)
     | None | Some _ ->
-        add ~doc ?copybook registry
+        add ~doc registry
   in
   aux ~try_cache:true registry
 

src/lsp/cobol_lsp/lsp_server.mli

@@ -79,12 +79,10 @@ val init
 val on_change_workspace_folders
   : Lsp.Types.DidChangeWorkspaceFoldersParams.t -> t -> t
 
-(** When given, [copybook] indicates whether the document is a copybook (in
-    which case it is not parsed directly as a normal program).  When absent,
-    copybook detection is performed via project configuration (see
-    {!Project.detect_copybook}). *)
+(** Copybook detection is performed via project configuration (see
+    {!Lsp_project.detect_copybook}). *)
 val did_open
-  : Lsp.Types.DidOpenTextDocumentParams.t -> ?copybook: bool -> t -> t
+  : Lsp.Types.DidOpenTextDocumentParams.t -> t -> t
 
 val did_change
   : Lsp.Types.DidChangeTextDocumentParams.t -> t -> t

src/lsp/cobol_preproc/preproc_engine.ml

@@ -568,10 +568,49 @@ let fold_source_lines ~dialect ~source_format ?on_initial_source_format
     | Some f -> f (Src_reader.source_format reader) acc
     | None -> acc
   in
-  OUT.result @@
   Src_reader.fold_lines ~dialect ~f reader
     ?skip_compiler_directives_text ?on_compiler_directive acc
 
+let fold_source_words ~dialect ~source_format ~f input acc =
+  fold_source_lines ~dialect ~source_format input acc
+    ~skip_compiler_directives_text:true
+    ~f:begin fun _ line acc ->
+      ListLabels.fold_left line ~init:acc ~f:(fun acc word -> f word acc)
+    end
+
+let scan_prefix_for_copybook ~dialect ~source_format input =
+  let open struct
+    exception Res of [`Program | `Copybook]
+    type copybook_prefix_state =
+      | Expect_first_digits
+      | Expect_word
+    let digit_chars s =
+      let rec aux i =
+        i < 0 || match s.[i] with '0'..'9' -> aux (pred i) | _ -> false
+      in
+      aux (String.length s - 1)
+    let is_digits = function
+      | Text.TextWord s -> digit_chars s
+      | _ -> false
+    let is_word = function
+      | Text.TextWord _ as w -> not (is_digits w)
+      | _ -> false
+  end in
+  match
+    fold_source_words ~dialect ~source_format input Expect_first_digits
+      ~f:begin fun word -> function
+        | Expect_first_digits when is_digits ~&word ->
+            Expect_word
+        | Expect_word when is_word ~&word ->
+            raise @@ Res `Copybook
+        | _ ->
+            raise @@ Res `Program
+      end
+  with
+  | exception Res res -> res
+  | Expect_first_digits -> `Program                                  (* maybe? *)
+  | Expect_word -> `Copybook                                         (* maybe? *)
+
 let text_of_input ?options input =
   let text, pp = full_text ~item:"file" @@ preprocessor ?options input in
   OUT.result text ~diags:(diags pp)

src/lsp/cobol_preproc/preproc_engine.mli

@@ -90,7 +90,13 @@ val fold_source_lines
   -> f:(int -> Text.text -> 'a -> 'a)
   -> Src_input.t
   -> 'a
-  -> 'a Preproc_outputs.with_diags
+  -> 'a
+
+val scan_prefix_for_copybook
+  : dialect: Cobol_config.dialect
+  -> source_format: Cobol_config.source_format_spec
+  -> Src_input.t
+  -> [`Program | `Copybook]
 
 val preprocess_input
   : ?options: Preproc_options.preproc_options

src/lsp/superbol_free_lib/vscode_extension.ml

@@ -70,7 +70,7 @@ let package =
       "vscode-languageclient", "8.0.2";
       "polka", "^1.0.0-next.22";
       "sirv", "^2.0.2";
-      
+
       (* for the debug extension: *)
       "n-readlines", "^1.0.0";
     ]

src/lsp/superbol_project/package.toml

@@ -54,6 +54,7 @@ skip = ["index.mld"]
 #   base-unix = { libname = "unix", version = ">=base" } 
 [dependencies]
 cobol_common = "version"
+cobol_preproc = "version"
 cobol_config = "version"
 ocplib_stuff = "0.4.0"
 ez_file = "0.3.0"

src/lsp/superbol_project/project.ml

@@ -103,9 +103,6 @@ let for_ ~rootdir ~layout =
 let copybook_lookup_config_for ~filename { config; _ } =
   Project_config.copybook_lookup_config_for ~filename config
 
-let detect_copybook ~filename { config; _ } =
-  Project_config.detect_copybook ~filename config
-
 let relative_path_for ~filename { rootdir; _ } =
   try Project_utils.relative_path ~filename rootdir
   with Invalid_argument _ -> filename             (* if not in project rootdir *)
@@ -115,6 +112,39 @@ let absolute_path_for ~filename { rootdir; _ } =
   then filename       (* in case the file is not within its project directory *)
   else rootdir // filename
 
+let file_contents_looks_like_a_copybook ~filename ?contents { config; _ } =
+  let decide input =
+    Cobol_preproc.scan_prefix_for_copybook input
+      ~dialect:(Cobol_config.dialect config.cobol_config)
+      ~source_format:config.source_format = `Copybook
+  in
+  match contents with
+  | None ->
+      Cobol_preproc.Input.from ~filename ~f:decide
+  | Some c ->
+      decide @@ Cobol_preproc.Input.string ~filename c
+
+let is_a_copybook_extension ext =
+  List.mem (String.lowercase_ascii (EzString.after ext 1))    (* trim the `.` *)
+    Cobol_common.Copybook.copybookonly_extensions
+
+let file_is_in_libpath ~filename ({ config; _ } as project) =
+  let filename = relative_path_for ~filename project in
+  List.exists begin function
+    | Project_config.RelativeToProjectRoot prefix ->
+        EzString.starts_with ~prefix filename
+    | RelativeToFileDir suffix ->
+        EzString.ends_with ~suffix (Filename.dirname filename)
+  end config.libpath
+
+let detect_copybook ~filename ?contents project =
+  let ext = Filename.extension filename in
+  (if ext = "" (* assume files with no extension that appear in copybook paths
+                  are copybooks *)
+   then file_is_in_libpath ~filename project
+   else is_a_copybook_extension ext) ||
+  file_contents_looks_like_a_copybook ~filename ?contents project
+
 let save_config ?verbose { config_filename; config; _ } =
   Project_config.save ?verbose ~config_filename config
 

src/lsp/superbol_project/project.mli

@@ -95,9 +95,9 @@ val copybook_lookup_config_for
   -> t
   -> Cobol_common.Copybook.lookup_config
 
-(** [detect_copybook ~filename project] indicates whether a file name should be
-    treated as a copybook within [project]. *)
-val detect_copybook: filename:string -> t -> bool
+(** [detect_copybook ~filename project] indicates whether a document with the
+    given [filename] should be treated as a copybook in [project]. *)
+val detect_copybook: filename:string -> ?contents:string -> t -> bool
 
 (** {1 Cached representation} *)