Add lint about shadowing default constructor names (fix #26)

Signed-off-by: Nikita Nemakin <nemakin.nikita@yandex.ru>

CHANGES

@@ -14,6 +14,9 @@
 - Expose library to parse DIFF format. It is available as 'zanuda.diff_parser' ocamlfind package.
 - #28: Add lint about nested if expressions.
   (contributed by @Artem-Rzhankoff)
+  #26: Add lint about constructor names that hide default constructor names (contributed by @nnemakin)
+
+
 ### Changed
 
 - #15: Split 'string_concat' lint to check separately patterns 'a^b^c' (level=Allow) and 'List.fold_left (^)' (level=Warn).

src/main.ml

@@ -11,7 +11,8 @@ let per_file_linters = [ (module UntypedLints.License : LINT.TYPED) ]
 
 let untyped_linters =
   let open UntypedLints in
-  [ (module Casing : LINT.UNTYPED)
+  [ (module AmbiguousConstructors : LINT.UNTYPED)
+  ; (module Casing : LINT.UNTYPED)
   ; (module ParsetreeHasDocs : LINT.UNTYPED)
   ; (module UntypedLints.Propose_function : LINT.UNTYPED)
   ; (module ToplevelEval : LINT.UNTYPED)

src/untyped/AmbiguousConstructors.ml

@@ -0,0 +1,90 @@
+(** Copyright 2021-2023, Kakadu. *)
+
+(** SPDX-License-Identifier: LGPL-3.0-or-later *)
+
+open Base
+open Zanuda_core
+open Zanuda_core.Utils
+
+type input = Ast_iterator.iterator
+
+let lint_id = "ambiguous_constructors"
+let group = LINT.Nursery
+let level = LINT.Warn
+let lint_source = LINT.Other
+
+let documentation =
+  {|
+### What it does
+
+Checks if there are constructor names that hide default constructor names,
+such as `Some`, `None`, `Error`, `Ok`. 
+
+### Why it is important
+
+Shadowing names of default constructor leads to name clashes within toplevel.
+Using custom constructors is recommended.
+
+|}
+  |> Stdlib.String.trim
+;;
+
+let describe_as_json () =
+  describe_as_clippy_json lint_id ~group ~level ~impl:LINT.Untyped ~docs:documentation
+;;
+
+let msg ppf name =
+  Caml.Format.fprintf
+    ppf
+    "Constructor names of type `%s` should not look like defaults"
+    name
+;;
+
+let report ~loc ~filename tname =
+  let module M = struct
+    let txt ppf () = Report.txt ~loc ~filename ppf msg tname
+
+    let rdjsonl ppf () =
+      Report.rdjsonl
+        ~loc
+        ~filename:(Config.recover_filepath loc.loc_start.pos_fname)
+        ~code:lint_id
+        ppf
+        msg
+        tname
+    ;;
+  end
+  in
+  (module M : LINT.REPORTER)
+;;
+
+let default_names = [ "Some"; "None"; "Error"; "Ok" ]
+
+let names (cdecls : Parsetree.constructor_declaration list) =
+  List.map cdecls ~f:(fun decl -> decl.pcd_name.txt)
+;;
+
+let are_bad_names names =
+  List.exists names ~f:(fun name -> List.mem default_names name ~equal:String.equal)
+;;
+
+let run _ fallback =
+  let open Ast_iterator in
+  { fallback with
+    type_declaration =
+      (fun self tdecl ->
+        let open Parsetree in
+        let tname = tdecl.ptype_name.txt in
+        let loc = tdecl.ptype_loc in
+        let names =
+          match tdecl.ptype_kind with
+          | Ptype_variant cdecls -> names cdecls
+          | _ -> []
+        in
+        if are_bad_names names
+        then (
+          let filename = loc.Location.loc_start.Lexing.pos_fname in
+          CollectedLints.add ~loc (report ~loc ~filename tname));
+        fallback.type_declaration self tdecl)
+  }
+;;

src/untyped/dune

@@ -2,14 +2,15 @@
  (name UntypedLints)
  (libraries Tast_pattern zanuda_core angstrom)
  (modules
+  AmbiguousConstructors
   Casing
   GuardInsteadOfIf
-  Dollar
-  License
   ParsetreeHasDocs
   Propose_function
   ToplevelEval
+  Dollar
   VarShouldNotBeUsed
+  License
   ;
   )
  (preprocess

tests/untyped/amb_cstrs.t/amb_cstrs.ml

@@ -0,0 +1,19 @@
+module Linted = struct
+  type 'a result = 
+    | Error of string 
+    | Ok of 'a  
+
+  type str_option = 
+    | Some of string
+    | None
+
+  type 'a option = 
+    | Nothing
+    | Some of 'a
+end
+
+module Not_linted = struct
+  type 'a option = 
+    | Something of 'a 
+    | Nothing
+end

tests/untyped/amb_cstrs.t/dune

@@ -0,0 +1,12 @@
+(library
+ (name test_amb_cstrs)
+ (wrapped false)
+ (modules amb_cstrs)
+ (flags
+  (:standard
+   ;-dsource
+   ;
+   )))
+
+(cram
+ (deps %{bin:zanuda.exe}))

tests/untyped/amb_cstrs.t/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.8)
+
+(cram enable)

tests/untyped/amb_cstrs.t/run.t

@@ -0,0 +1,17 @@
+  $ dune build
+  $ zanuda -no-check-filesystem -no-top_file_license -dir .  -ordjsonl /dev/null
+  File "amb_cstrs.ml", lines 2-4, characters 2-14:
+  2 | ..type 'a result = 
+  3 |     | Error of string 
+  4 |     | Ok of 'a..
+  Alert zanuda-linter: Constructor names of type `result` should not look like defaults
+  File "amb_cstrs.ml", lines 6-8, characters 2-10:
+  6 | ..type str_option = 
+  7 |     | Some of string
+  8 |     | None
+  Alert zanuda-linter: Constructor names of type `str_option` should not look like defaults
+  File "amb_cstrs.ml", lines 10-12, characters 2-16:
+  10 | ..type 'a option = 
+  11 |     | Nothing
+  12 |     | Some of 'a
+  Alert zanuda-linter: Constructor names of type `option` should not look like defaults