Allow modules to be only preprocessed and not linted

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
Jeremie Dimino 2018-05-25 12:03:18 +01:00 committed by Jérémie Dimino
parent ac1c407cab
commit cc7bd5ebb1
2 changed files with 22 additions and 9 deletions

View File

@ -293,7 +293,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope = Staged.stage (
fun ~(source : Module.t) ~ast -> fun ~(source : Module.t) ~ast ->
Per_module.get lint source.name ~source ~ast) Per_module.get lint source.name ~source ~ast)
type t = (Module.t -> Module.t) Per_module.t type t = (Module.t -> lint:bool -> Module.t) Per_module.t
let make sctx ~dir ~dep_kind ~lint ~preprocess let make sctx ~dir ~dep_kind ~lint ~preprocess
~preprocessor_deps ~lib_name ~scope = ~preprocessor_deps ~lib_name ~scope =
@ -305,12 +305,12 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
in in
Per_module.map preprocess ~f:(function Per_module.map preprocess ~f:(function
| Preprocess.No_preprocessing -> | Preprocess.No_preprocessing ->
(fun m -> (fun m ~lint ->
let ast = setup_reason_rules sctx ~dir m in let ast = setup_reason_rules sctx ~dir m in
lint_module ~ast ~source:m; if lint then lint_module ~ast ~source:m;
ast) ast)
| Action (loc, action) -> | Action (loc, action) ->
(fun m -> (fun m ~lint ->
let ast = let ast =
pped_module m ~dir ~f:(fun _kind src dst -> pped_module m ~dir ~f:(fun _kind src dst ->
SC.add_rule sctx SC.add_rule sctx
@ -331,7 +331,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
~targets:(Static [dst]) ~targets:(Static [dst])
~scope)) ~scope))
|> setup_reason_rules sctx ~dir in |> setup_reason_rules sctx ~dir in
lint_module ~ast ~source:m; if lint then lint_module ~ast ~source:m;
ast) ast)
| Pps { pps; flags } -> | Pps { pps; flags } ->
let ppx_exe = get_ppx_driver sctx ~scope pps in let ppx_exe = get_ppx_driver sctx ~scope pps in
@ -343,9 +343,9 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
; As (if uses_ppx_driver then ["-diff-cmd"; "-"] else []) ; As (if uses_ppx_driver then ["-diff-cmd"; "-"] else [])
] ]
in in
(fun m -> (fun m ~lint ->
let ast = setup_reason_rules sctx ~dir m in let ast = setup_reason_rules sctx ~dir m in
lint_module ~ast ~source:m; if lint then lint_module ~ast ~source:m;
pped_module ast ~dir ~f:(fun kind src dst -> pped_module ast ~dir ~f:(fun kind src dst ->
SC.add_rule sctx SC.add_rule sctx
(promote_correction ~uses_ppx_driver (promote_correction ~uses_ppx_driver
@ -359,6 +359,9 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
; Ml_kind.ppx_driver_flag kind; Dep src ; Ml_kind.ppx_driver_flag kind; Dep src
]))))) ])))))
let pp_modules t modules = let pp_modules t ?(lint=true) modules =
Module.Name.Map.map modules ~f:(fun (m : Module.t) -> Module.Name.Map.map modules ~f:(fun (m : Module.t) ->
Per_module.get t m.name m) Per_module.get t m.name m ~lint)
let pp_module_as t ?(lint=true) name m =
Per_module.get t name m ~lint

View File

@ -20,9 +20,19 @@ val make
returns the translated modules *) returns the translated modules *)
val pp_modules val pp_modules
: t : t
-> ?lint:bool
-> Module.t Module.Name.Map.t -> Module.t Module.Name.Map.t
-> Module.t Module.Name.Map.t -> Module.t Module.Name.Map.t
(** Preprocess a single module, using the configuration for the given
module name. *)
val pp_module_as
: t
-> ?lint:bool
-> Module.Name.t
-> Module.t
-> Module.t
(** Get a path to a cached ppx driver *) (** Get a path to a cached ppx driver *)
val get_ppx_driver val get_ppx_driver
: Super_context.t : Super_context.t