Source file common.ml

(*********************************************************************************)
(*  Dunolint - A tool to lint and help manage files in dune projects             *)
(*  Copyright (C) 2024-2025 Mathieu Barbin <mathieu.barbin@gmail.com>            *)
(*                                                                               *)
(*  This file is part of Dunolint.                                               *)
(*                                                                               *)
(*  Dunolint is free software; you can redistribute it and/or modify it          *)
(*  under the terms of the GNU Lesser General Public License as published by     *)
(*  the Free Software Foundation either version 3 of the License, or any later   *)
(*  version, with the LGPL-3.0 Linking Exception.                                *)
(*                                                                               *)
(*  Dunolint is distributed in the hope that it will be useful, but WITHOUT      *)
(*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or        *)
(*  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License  *)
(*  and the file `NOTICE.md` at the root of this repository for more details.    *)
(*                                                                               *)
(*  You should have received a copy of the GNU Lesser General Public License     *)
(*  and the LGPL-3.0 Linking Exception along with this library. If not, see      *)
(*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.         *)
(*********************************************************************************)

let sexpable_param (type a) (module M : Sexpable.S with type t = a) =
  let module Validate = struct
    type t = a

    let of_string str =
      try Ok (Parsexp.Single.parse_string_exn str |> M.t_of_sexp) with
      | exn -> Error (`Msg (Exn.to_string exn))
    ;;

    let to_string t = Sexp.to_string_mach (M.sexp_of_t t)
  end
  in
  Command.Param.validated_string (module Validate)
;;

let below ~doc =
  let open Command.Std in
  Arg.named_opt
    [ "below" ]
    (Param.validated_string (module Relative_path))
    ~docv:"PATH"
    ~doc
;;

let skip_subtree ~globs =
  let open Dunolint.Config.Std in
  cond
    [ ( path
          (or_
             (List.concat
                [ List.map globs ~f:glob
                ; List.concat_map
                    ~f:(fun pat -> [ glob ("**/" ^ pat); glob pat ])
                    [ ".git/"
                    ; "_build/"
                    ; "_opam/"
                    ; "_coverage/"
                    ; "node_modules/"
                    ; "doc/build/"
                    ; ".docusaurus/"
                    ; "*.t/"
                    ]
                ]))
      , skip_subtree )
    ]
;;