more tweaks to ast checker

src/ast-check/README.md

@@ -1,9 +1,7 @@
 # AST Checker
 
-Checks the abstract syntax tree of an OCaml source file for violations.
-
-<!-- TODO: link to online documentation -->
+[Online Docs](https://just-max.github.io/less-power/main/less-power/Ast_check/index.html).
 
 ## Future Work
 
-- The set of prohibited features is currently fixed. It would be nice to have them configurable (via arguments to the OCaml interface and command line flags to the executable).
+- The set of prohibited features is currently fixed when called from the command line. It would be nice to have them configurable via command line flags.

src/ast-check/ast_check.ml

@@ -216,11 +216,11 @@ let file_violations ?prohibited ?limit path =
   Ocaml_common.Pparse.parse_implementation ~tool_name:"lp-ast-check" path
   |> ast_violations ?prohibited ?limit
 
-let path_violations ?prohibited ?limit
+let path_violations ?(follow = FileUtil.Follow) ?prohibited ?limit
     ?(check1 = FileUtil.True) ?(check = FileUtil.Has_extension "ml") k path =
   let open FileUtil in
   let cond = if test Is_file path then check1 else And (check, Is_file) in
-  find cond path (fun () -> file_violations ?prohibited ?limit %> k) ()
+  find ~follow cond path (fun () -> file_violations ?prohibited ?limit %> k) ()
 
 
 let pp_violation ppf vio =

src/ast-check/ast_check.mli

@@ -68,14 +68,19 @@ val file_violations :
   ?prohibited:Feature.Set.t -> ?limit:int -> string -> violation list
 
 (** As per {!file_violations}, but scan an entire directory (recursively).
-    If the path designates a regular file, check it if [check1] matches
-    (default: always), if a directory is scanned, check each file if
+    If the path designates a regular file, check the file if [check1] matches
+    (default: always); if a directory is scanned, check each file if
     [check] matches (default: [.ml] ending). Pass each (possibly empty) list of
-    violations to the callback; see the note in {!pp_violation}. *)
+    violations to the callback; see the note in {!pp_violation}.
+
+    The [follow] argument (default: {{!FilePath.Follow}[Follow]}) only applies to directories;
+    symlinks to files are always read. *)
 val path_violations :
+  ?follow:FileUtil.action_link ->
   ?prohibited:Feature.Set.t -> ?limit:int ->
   ?check1:FileUtil.test_file -> ?check:FileUtil.test_file ->
   (violation list -> unit) -> string -> unit
+  (* TODO: the callback could take the path, too... *)
 
 (** Pretty-print a violation. Violations from a given file should be printed
     before the next file is parsed, otherwise no context from the source file

src/ast-check/ast_check_bin.ml

@@ -18,8 +18,4 @@ let main (_cmd : string) args =
   args |> List.iter (path_violations k);
   !status
 
-let () =
-  Sys.argv
-  |> Array.to_list
-  |> (function cmd :: args -> main cmd args | [] -> failwith "empty argv")
-  |> exit
+let _ = Common.Internal.Util.run_main main

src/ast-check/dune

@@ -18,4 +18,4 @@
  (public_name lp-ast-check)
  (package less-power)
  (modules ast_check_bin)
- (libraries ast_check fmt))
+ (libraries common ast_check fmt))

src/common/dune

@@ -1,4 +1,4 @@
 (library
  (name common)
  (public_name less-power.common)
- (libraries unix fmt))
+ (libraries unix fmt fileutils))

src/common/path_util.ml

@@ -54,3 +54,11 @@ let ( / ) = Filename.concat
 
 (** like {!Sys.readdir}, but the returned entries are full paths *)
 let readdir_p p = Sys.readdir p |> Array.to_seq |> Seq.map (fun p1 -> p / p1)
+
+(** Checks that either [p] is a regular file and [condition] holds for it,
+    or [p] is a symlink to a regular file, and [condition] holds for the symlink. *)
+let is_code ?(condition = FileUtil.True) p =
+  let open FileUtil in
+  if test Is_link p
+  then test condition p && test Is_file (Unix.readlink p)
+  else test (And (Is_file, condition)) p

src/common/util.ml

@@ -26,6 +26,12 @@ let string_contains ~needle haystack =
     returns [["c"; "ef"]] *)
 let ( ~$ ) = ( |> )
 
+let run_main main =
+  Sys.argv
+  |> Array.to_list
+  |> (function cmd :: args -> main cmd args | [] -> failwith "empty argv")
+  |> exit
+
 open struct module C = Error_context end
 
 type access_file_error = [