Allow whitelisting files to be formatted

.ocamlformat-ignore

@@ -1,3 +1 @@
-src/ocaml/**
-src/utils/**
 upstream/**

src/ocaml/.ocamlformat

@@ -0,0 +1 @@
+disable=true

src/ocaml/typing/.ocamlformat-enable

@@ -0,0 +1,2 @@
+msupport.ml
+msupport.mli

src/ocaml/typing/msupport.ml

@@ -1,62 +1,58 @@
 (* {{{ COPYING *(
 
-  This file is part of Merlin, an helper for ocaml editors
+     This file is part of Merlin, an helper for ocaml editors
 
-  Copyright (C) 2013 - 2015  Frédéric Bour  <frederic.bour(_)lakaban.net>
-                             Thomas Refis  <refis.thomas(_)gmail.com>
-                             Simon Castellan  <simon.castellan(_)iuwt.fr>
+     Copyright (C) 2013 - 2015  Frédéric Bour  <frederic.bour(_)lakaban.net>
+                                Thomas Refis  <refis.thomas(_)gmail.com>
+                                Simon Castellan  <simon.castellan(_)iuwt.fr>
 
-  Permission is hereby granted, free of charge, to any person obtaining a
-  copy of this software and associated documentation files (the "Software"),
-  to deal in the Software without restriction, including without limitation the
-  rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-  sell copies of the Software, and to permit persons to whom the Software is
-  furnished to do so, subject to the following conditions:
+     Permission is hereby granted, free of charge, to any person obtaining a
+     copy of this software and associated documentation files (the "Software"),
+     to deal in the Software without restriction, including without limitation the
+     rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+     sell copies of the Software, and to permit persons to whom the Software is
+     furnished to do so, subject to the following conditions:
 
-  The above copyright notice and this permission notice shall be included in
-  all copies or substantial portions of the Software.
+     The above copyright notice and this permission notice shall be included in
+     all copies or substantial portions of the Software.
 
-  The Software is provided "as is", without warranty of any kind, express or
-  implied, including but not limited to the warranties of merchantability,
-  fitness for a particular purpose and noninfringement. In no event shall
-  the authors or copyright holders be liable for any claim, damages or other
-  liability, whether in an action of contract, tort or otherwise, arising
-  from, out of or in connection with the software or the use or other dealings
-  in the Software.
+     The Software is provided "as is", without warranty of any kind, express or
+     implied, including but not limited to the warranties of merchantability,
+     fitness for a particular purpose and noninfringement. In no event shall
+     the authors or copyright holders be liable for any claim, damages or other
+     liability, whether in an action of contract, tort or otherwise, arising
+     from, out of or in connection with the software or the use or other dealings
+     in the Software.
 
-)* }}} *)
+   )* }}} *)
 
 open Std
 
-module RawTypeHash = Hashtbl.Make(Types.TransientTypeOps)
+module RawTypeHash = Hashtbl.Make (Types.TransientTypeOps)
 
 let errors : (exn list ref * unit RawTypeHash.t) option ref = ref None
 
 let monitor_errors' = ref (ref false)
 let monitor_errors () =
-  if !(!monitor_errors') then
-    monitor_errors' := (ref false);
+  if !(!monitor_errors') then monitor_errors' := ref false;
   !monitor_errors'
 
-let raise_error ?(ignore_unify=false) exn =
+let raise_error ?(ignore_unify = false) exn =
   !monitor_errors' := true;
   match !errors with
-  | Some (l,_) ->
-    begin match exn with
-      | Ctype.Unify _ when ignore_unify -> ()
-      | Ctype.Unify _ | Failure _ ->
-        Logger.log ~section:"Typing_aux.raise_error"
-          ~title:(Printexc.exn_slot_name exn) "%a"
-          Logger.fmt (fun fmt ->
-              Printexc.record_backtrace true;
-              Format.pp_print_string  fmt (Printexc.get_backtrace ())
-            )
-      | exn -> l := exn :: !l
-    end
+  | Some (l, _) -> begin
+    match exn with
+    | Ctype.Unify _ when ignore_unify -> ()
+    | Ctype.Unify _ | Failure _ ->
+      Logger.log ~section:"Typing_aux.raise_error"
+        ~title:(Printexc.exn_slot_name exn) "%a" Logger.fmt (fun fmt ->
+          Printexc.record_backtrace true;
+          Format.pp_print_string fmt (Printexc.get_backtrace ()))
+    | exn -> l := exn :: !l
+  end
   | None -> raise exn
 
-let () =
-  Msupport_parsing.msupport_raise_error := raise_error
+let () = Msupport_parsing.msupport_raise_error := raise_error
 
 exception Resume
 
@@ -68,61 +64,60 @@ let catch_errors warnings caught f =
   let warnings' = Warnings.backup () in
   let errors' = !errors in
   Warnings.restore warnings;
-  errors := (Some (caught,RawTypeHash.create 3));
-  Misc.try_finally f
-    ~always:(fun () ->
-       errors := errors';
-       Warnings.restore warnings')
+  errors := Some (caught, RawTypeHash.create 3);
+  Misc.try_finally f ~always:(fun () ->
+      errors := errors';
+      Warnings.restore warnings')
 
-let uncatch_errors f =
-  let_ref errors None f
+let uncatch_errors f = let_ref errors None f
 
 let erroneous_type_register te =
   let te = Types.Transient_expr.coerce te in
   match !errors with
-  | Some (_,h) -> RawTypeHash.replace h te ()
+  | Some (_, h) -> RawTypeHash.replace h te ()
   | None -> ()
 
 let erroneous_type_check te =
   let te = Types.Transient_expr.coerce te in
   match !errors with
-  | Some (_,h) -> RawTypeHash.mem h te
+  | Some (_, h) -> RawTypeHash.mem h te
   | _ -> false
 
 let rec erroneous_expr_check e =
-  (erroneous_type_check e.Typedtree.exp_type) ||
+  erroneous_type_check e.Typedtree.exp_type
+  ||
   match e.Typedtree.exp_desc with
-  | Typedtree.Texp_ident (p,_,_)
-    when Ident.name (Path.head p) = "_" -> true
-  | Typedtree.Texp_apply (e',_) -> erroneous_expr_check e'
+  | Typedtree.Texp_ident (p, _, _) when Ident.name (Path.head p) = "_" -> true
+  | Typedtree.Texp_apply (e', _) -> erroneous_expr_check e'
   | _ -> false
 
 exception Warning of Location.t * string
 
 let prerr_warning loc w =
   match !errors with
   | None -> () (*Location.print_warning loc Format.err_formatter w*)
-  | Some (l, _) ->
+  | Some (l, _) -> (
     let ppf, to_string = Format.to_string () in
     Location.print_warning loc ppf w;
     match to_string () with
-      | "" -> ()
-      | s ->  l := Warning (loc,s) :: !l
+    | "" -> ()
+    | s -> l := Warning (loc, s) :: !l)
 
 let prerr_alert loc w =
   match !errors with
   | None -> () (*Location.print_warning loc Format.err_formatter w*)
-  | Some (l, _) ->
+  | Some (l, _) -> (
     let ppf, to_string = Format.to_string () in
     Location.print_alert loc ppf w;
     match to_string () with
-      | "" -> ()
-      | s ->  l := Warning (loc,s) :: !l
+    | "" -> ()
+    | s -> l := Warning (loc, s) :: !l)
 
-let () = Location.register_error_of_exn (function
-    | Warning (loc, str) -> Some (Location.error ~loc ~source:Location.Warning str)
-    | _ -> None
-  )
+let () =
+  Location.register_error_of_exn (function
+    | Warning (loc, str) ->
+      Some (Location.error ~loc ~source:Location.Warning str)
+    | _ -> None)
 
 let () = Location.prerr_warning_ref := prerr_warning
 
@@ -136,23 +131,24 @@ let flush_saved_types () =
     let open Ast_helper in
     let pexp = Exp.constant (Saved_parts.store parts) in
     let pstr = Str.eval pexp in
-    [Attr.mk (Saved_parts.attribute) (Parsetree.PStr [pstr])]
+    [ Attr.mk Saved_parts.attribute (Parsetree.PStr [ pstr ]) ]
 
 let rec get_saved_types_from_attributes = function
   | [] -> []
   | attr :: attrs ->
-    let (attr, str) = Ast_helper.Attr.as_tuple attr in
+    let attr, str = Ast_helper.Attr.as_tuple attr in
     if attr = Saved_parts.attribute then
       let open Parsetree in
-      begin match str with
-      | PStr({pstr_desc =
-                Pstr_eval ({pexp_desc = Pexp_constant key; _ } ,_)
-            ; _ } :: _) ->
-          Saved_parts.find key
+      begin
+        match str with
+        | PStr
+            ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant key; _ }, _);
+               _
+             }
+            :: _) -> Saved_parts.find key
         | _ -> []
       end
-    else
-      get_saved_types_from_attributes attrs
+    else get_saved_types_from_attributes attrs
 
 let with_warning_attribute ?warning_attribute f =
   match warning_attribute with
@@ -164,13 +160,14 @@ let with_saved_types ?warning_attribute ?save_part f =
   Cmt_format.set_saved_types [];
   try
     let result = with_warning_attribute ?warning_attribute f in
-    begin match save_part with
+    begin
+      match save_part with
       | None -> ()
       | Some f -> Cmt_format.set_saved_types (f result :: saved_types)
     end;
     result
   with exn ->
-    let saved_types'= Cmt_format.get_saved_types () in
+    let saved_types' = Cmt_format.get_saved_types () in
     Cmt_format.set_saved_types (saved_types' @ saved_types);
     reraise exn
 

src/ocaml/typing/msupport.mli

@@ -1,76 +1,79 @@
 (* {{{ COPYING *(
 
-  This file is part of Merlin, an helper for ocaml editors
+     This file is part of Merlin, an helper for ocaml editors
 
-  Copyright (C) 2013 - 2015  Frédéric Bour  <frederic.bour(_)lakaban.net>
-                             Thomas Refis  <refis.thomas(_)gmail.com>
-                             Simon Castellan  <simon.castellan(_)iuwt.fr>
+     Copyright (C) 2013 - 2015  Frédéric Bour  <frederic.bour(_)lakaban.net>
+                                Thomas Refis  <refis.thomas(_)gmail.com>
+                                Simon Castellan  <simon.castellan(_)iuwt.fr>
 
-  Permission is hereby granted, free of charge, to any person obtaining a
-  copy of this software and associated documentation files (the "Software"),
-  to deal in the Software without restriction, including without limitation the
-  rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-  sell copies of the Software, and to permit persons to whom the Software is
-  furnished to do so, subject to the following conditions:
+     Permission is hereby granted, free of charge, to any person obtaining a
+     copy of this software and associated documentation files (the "Software"),
+     to deal in the Software without restriction, including without limitation the
+     rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+     sell copies of the Software, and to permit persons to whom the Software is
+     furnished to do so, subject to the following conditions:
 
-  The above copyright notice and this permission notice shall be included in
-  all copies or substantial portions of the Software.
+     The above copyright notice and this permission notice shall be included in
+     all copies or substantial portions of the Software.
 
-  The Software is provided "as is", without warranty of any kind, express or
-  implied, including but not limited to the warranties of merchantability,
-  fitness for a particular purpose and noninfringement. In no event shall
-  the authors or copyright holders be liable for any claim, damages or other
-  liability, whether in an action of contract, tort or otherwise, arising
-  from, out of or in connection with the software or the use or other dealings
-  in the Software.
+     The Software is provided "as is", without warranty of any kind, express or
+     implied, including but not limited to the warranties of merchantability,
+     fitness for a particular purpose and noninfringement. In no event shall
+     the authors or copyright holders be liable for any claim, damages or other
+     liability, whether in an action of contract, tort or otherwise, arising
+     from, out of or in connection with the software or the use or other dealings
+     in the Software.
 
-)* }}} *)
+   )* }}} *)
 
 (** Raise an error that can be caught: normal flow is resumed if a
     [catch_errors] handler was installed. *)
-val raise_error: ?ignore_unify:bool -> exn -> unit
+val raise_error : ?ignore_unify:bool -> exn -> unit
 
 (** Resume after error: like [raise_error], but if a handler was provided a
     Resume exception is raised.  This allows to specify a special case when an
     error is caught. *)
 exception Resume
-val resume_raise: exn -> 'a
+
+val resume_raise : exn -> 'a
 
 (** Installing (and removing) error handlers. *)
 
 (** Any [raise_error] invoked inside catch_errors will be added to the list. *)
-val catch_errors: Warnings.state -> exn list ref -> (unit -> 'a) -> 'a
+val catch_errors : Warnings.state -> exn list ref -> (unit -> 'a) -> 'a
 
 (** Temporary disable catching errors *)
-val uncatch_errors: (unit -> 'a) -> 'a
+val uncatch_errors : (unit -> 'a) -> 'a
 
 (** Returns a reference initially set to false that will be set to true when a
     type error is raised. *)
-val monitor_errors: unit -> bool ref
+val monitor_errors : unit -> bool ref
 
 (** Warnings can also be stored in the caught exception list, wrapped inside
     this exception *)
 exception Warning of Location.t * string
 
 (* Keep track of type variables generated by error recovery. *)
 
-val erroneous_type_register: Types.type_expr -> unit
-val erroneous_type_check: Types.type_expr -> bool
-val erroneous_expr_check: Typedtree.expression -> bool
+val erroneous_type_register : Types.type_expr -> unit
+val erroneous_type_check : Types.type_expr -> bool
+val erroneous_expr_check : Typedtree.expression -> bool
 
 (** Turn saved types from Cmt_format into attributes *)
 val flush_saved_types : unit -> Parsetree.attributes
 
-val incorrect_attribute: Parsetree.attribute
+val incorrect_attribute : Parsetree.attribute
 
 (** Extend the given attributes with an incorrect attribute and the saved types
     after turning them into attributes *)
 val recovery_attributes : Parsetree.attributes -> Parsetree.attributes
 
 (** Retrieve saved types that were turned into attributes *)
-val get_saved_types_from_attributes : Parsetree.attributes -> Cmt_format.binary_part list
+val get_saved_types_from_attributes :
+  Parsetree.attributes -> Cmt_format.binary_part list
 
 val with_saved_types :
   ?warning_attribute:Parsetree.attributes ->
   ?save_part:('a -> Cmt_format.binary_part) ->
-  (unit -> 'a) -> 'a
+  (unit -> 'a) ->
+  'a

src/utils/.ocamlformat

@@ -0,0 +1 @@
+disable=true

src/utils/.ocamlformat-enable

@@ -0,0 +1,2 @@
+msupport.ml
+msupport.mli