From 962afbc81b429bfd9427f5886402f9ad57308482 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 8 Oct 2019 19:09:26 +0700 Subject: [PATCH] Fix newlines and indentation in toplevel extension points (#1054) --- CHANGES.md | 1 + src/Fmt_ast.ml | 57 +++++++++++---------- test/passing/extensions-indent.ml.ref | 24 +++++++-- test/passing/extensions-indent.mli.ref | 5 ++ test/passing/extensions-sugar_always.ml.ref | 14 +++++ test/passing/extensions.ml | 14 +++++ test/passing/extensions.ml.ref | 14 +++++ test/passing/extensions.mli | 5 ++ test/passing/js_source.ml.ref | 36 +++++-------- test/passing/shortcut_ext_attr.ml | 11 ++-- test/passing/source.ml.ref | 41 ++++++--------- 11 files changed, 136 insertions(+), 86 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index ef58241eca..e071e46cf1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,6 @@ ### (master) + + Fix newlines and indentation in toplevel extension points (#1054) (Guillaume Petiot) + Fix placement of doc comments around extensions (#1052) (Jules Aguillon) + Improve: inline extensions that do not break (#1050) (Guillaume Petiot) + Fix: add missing cut before attributes in type declarations (#1051) (Guillaume Petiot) diff --git a/src/Fmt_ast.ml b/src/Fmt_ast.ml index 2d7181b93f..5becc4b5da 100644 --- a/src/Fmt_ast.ml +++ b/src/Fmt_ast.ml @@ -240,7 +240,7 @@ let make_groups c items ast update_config = let fmt_groups c ctx grps fmt_grp = let break_struct = c.conf.break_struct || Poly.(ctx = Top) in list_fl grps (fun ~first ~last grp -> - fmt_if (break_struct && not first) "\n@\n" + fmt_if (break_struct && not first) "\n@;<1000 0>" $ fmt_if ((not break_struct) && not first) "@;<1000 0>" $ fmt_grp ~first ~last grp $ fits_breaks_if ((not break_struct) && not last) "" "\n") @@ -251,7 +251,7 @@ let fmt_recmodule c ctx items f ast = let break_struct = c.conf.break_struct || Poly.(ctx = Top) in let fmt_grp ~first:first_grp ~last:_ itms = list_fl itms (fun ~first ~last:_ (itm, c) -> - fmt_if_k (not first) (fmt_or break_struct "@\n" "@ ") + fmt_if_k (not first) (fmt_or break_struct "@;<1000 0>" "@ ") $ maybe_disabled c (Ast.location (ast itm)) [] @@ fun c -> f c ctx ~rec_flag:true ~first:(first && first_grp) itm) in @@ -562,14 +562,6 @@ let sequence_blank_line c xe1 xe2 = b - a - commented_lines > 1 | `Compact -> false -let fits c x ~f = - let fmted = Cmts.preserve f x in - 3 * String.length fmted < c.conf.margin - && - match String.rindex fmted '\n' with - | Some i -> i = 0 (* if the first character is '\n' we ignore it *) - | None -> true - let rec fmt_extension c ctx key (ext, pld) = match (pld, ctx) with | ( PStr [({pstr_desc= Pstr_value _ | Pstr_type _; _} as si)] @@ -577,9 +569,7 @@ let rec fmt_extension c ctx key (ext, pld) = fmt_structure_item c ~last:true ~ext (sub_str ~ctx si) | PSig [({psig_desc= Psig_type _; _} as si)], (Pld _ | Sig _ | Top) -> fmt_signature_item c ~ext (sub_sig ~ctx si) - | _ -> - let fits = fits c pld ~f:(fmt_payload c (Pld pld)) in - fmt_attribute_or_extension c key (hvbox_if fits 0) (ext, pld) + | _ -> fmt_attribute_or_extension c key Fn.id (ext, pld) and fmt_attribute_or_extension c key maybe_box (pre, pld) = let cmts_last = @@ -3389,13 +3379,15 @@ and fmt_signature c ctx itms = and fmt_signature_item c ?ext {ast= si; _} = protect (Sig si) @@ - let epi = fmt "\n@\n" and eol = fmt "\n@\n" and adj = fmt "@\n" in + let eol = fmt "\n@;<1000 0>" in + let epi = eol in + let adj = fmt "@\n" in let fmt_cmts_before = Cmts.fmt_before c ~epi ~eol ~adj si.psig_loc in let maybe_box = Location.is_single_line si.psig_loc c.conf.margin && Source.has_cmt_same_line_after c.source si.psig_loc in - let pro = fmt_or maybe_box "@ " "\n@\n" in + let pro = fmt_or maybe_box "@ " "\n@;<1000 0>" in let fmt_cmts_after = Cmts.fmt_after ~pro c si.psig_loc in (fun k -> fmt_cmts_before $ hvbox_if maybe_box 0 (k $ fmt_cmts_after)) @@ @@ -3410,9 +3402,14 @@ and fmt_signature_item c ?ext {ast= si; _} = (fmt_type_exception ~pre:(fmt "exception@ ") c (fmt " of@ ") ctx exc) | Psig_extension (ext, atrs) -> let doc_before, doc_after, atrs = fmt_docstring_around_item c atrs in - hvbox c.conf.stritem_extension_indent + let box = + match snd ext with + | PTyp _ | PPat _ | PStr [_] | PSig [_] -> true + | PStr _ | PSig _ -> false + in + hvbox_if box c.conf.stritem_extension_indent ( doc_before - $ fmt_extension c ctx "%%" ext + $ hvbox_if (not box) 0 (fmt_extension c ctx "%%" ext) $ fmt_attributes c ~pre:(fmt "@ ") ~key:"@@" atrs $ doc_after ) | Psig_include {pincl_mod; pincl_attributes; pincl_loc} -> @@ -3974,13 +3971,15 @@ and fmt_structure_item c ~last:last_item ?ext {ctx; ast= si} = match ctx with Pld (PStr [_]) -> true | _ -> false in let ctx = Str si in - let epi = fmt "\n@\n" and eol = fmt "\n@\n" and adj = fmt "@\n" in + let eol = fmt "\n@;<1000 0>" in + let epi = eol in + let adj = fmt "@;<1000 0>" in let fmt_cmts_before = Cmts.fmt_before c ~epi ~eol ~adj si.pstr_loc in let maybe_box = Location.is_single_line si.pstr_loc c.conf.margin && Source.has_cmt_same_line_after c.source si.pstr_loc in - let pro = fmt_or maybe_box "@ " "\n@\n" in + let pro = fmt_or maybe_box "@ " "\n@;<1000 0>" in let fmt_cmts_after = Cmts.fmt_after ~pro c si.pstr_loc in (fun k -> fmt_cmts_before $ hvbox_if maybe_box 0 (k $ fmt_cmts_after)) @@ @@ -3991,7 +3990,7 @@ and fmt_structure_item c ~last:last_item ?ext {ctx; ast= si} = $ fmt_attributes c ~key:"@@@" atrs | Pstr_eval (exp, atrs) -> let doc, atrs = doc_atrs atrs in - fmt_if (not skip_double_semi) ";;@\n" + fmt_if (not skip_double_semi) ";;@;<1000 0>" $ fmt_docstring c doc $ cbox 0 (fmt_expression c (sub_exp ~ctx exp)) $ fmt_attributes c ~pre:(str " ") ~key:"@@" atrs @@ -4058,21 +4057,27 @@ and fmt_structure_item c ~last:last_item ?ext {ctx; ast= si} = let rec_flag = first && first_grp && Poly.(rec_flag = Recursive) in - fmt_if (not first) "@\n" + fmt_if (not first) "@;<1000 0>" $ fmt_value_binding c op ~rec_flag ?ext:(if first && first_grp then ext else None) ctx ?epi ~attributes ~loc pvb_pat pvb_expr) in hvbox 0 (list_fl grps (fun ~first ~last grp -> - fmt_grp ~first ~last grp $ fmt_if (not last) "\n@\n")) + fmt_grp ~first ~last grp $ fmt_if (not last) "\n@;<1000 0>")) | Pstr_modtype mtd -> fmt_module_type_declaration c ctx mtd | Pstr_extension (ext, atrs) -> let doc_before, doc_after, atrs = fmt_docstring_around_item c atrs in - doc_before - $ fmt_extension c ctx "%%" ext - $ fmt_attributes c ~pre:(str " ") ~key:"@@" atrs - $ doc_after + let box = + match snd ext with + | PTyp _ | PPat _ | PStr [_] | PSig [_] -> true + | PStr _ | PSig _ -> false + in + hvbox_if box c.conf.stritem_extension_indent + ( doc_before + $ hvbox_if (not box) 0 (fmt_extension c ctx "%%" ext) + $ fmt_attributes c ~pre:(str " ") ~key:"@@" atrs + $ doc_after ) | Pstr_class_type cl -> fmt_class_types c ctx ~pre:"class type" ~sep:"=" cl | Pstr_class cls -> fmt_class_exprs c ctx cls diff --git a/test/passing/extensions-indent.ml.ref b/test/passing/extensions-indent.ml.ref index 088536695f..c63aa47f88 100644 --- a/test/passing/extensions-indent.ml.ref +++ b/test/passing/extensions-indent.ml.ref @@ -48,7 +48,7 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)]) [%%ext 11111111111111111111] [%%ext -11111111111111111111111 22222222222222222222222 33333333333333333333333] + 11111111111111111111111 22222222222222222222222 33333333333333333333333] [%%ext ;; @@ -67,6 +67,11 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)]) ;; 33333333333333333333] +[%%ext +let foooooooooooooooo = foooo + +let fooooooooooooooo = foo] + let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]] let _ = @@ -162,10 +167,10 @@ let foo = foooooooooooooooooooooooooooo] [%%foooooooooo: -fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo -foooooooooooooooooooooooooooooooooo -foooooooooooooooooooooooooooo -foooooooooooooooooooooooooooo] + fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo + foooooooooooooooooooooooooooo] [@@@foooooooooo fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo @@ -183,3 +188,12 @@ let this_function_has_a_long_name plus very many arguments = "and a kind of long body" [%%expect {||}] + +;; +[%expect {| +___________________________________________________________ +|}] + +[%%expect {| +___________________________________________________________ +|}] diff --git a/test/passing/extensions-indent.mli.ref b/test/passing/extensions-indent.mli.ref index c4785934da..2f9e307ed6 100644 --- a/test/passing/extensions-indent.mli.ref +++ b/test/passing/extensions-indent.mli.ref @@ -20,3 +20,8 @@ type t = fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo foooooooooooooooooooooooooooo] + +[%%ext +val foooooooooooooooooooooo : fooooooooooo + +val fooooooooooooooooooooooooooo : fooooo] diff --git a/test/passing/extensions-sugar_always.ml.ref b/test/passing/extensions-sugar_always.ml.ref index 9213d956ff..59573929ac 100644 --- a/test/passing/extensions-sugar_always.ml.ref +++ b/test/passing/extensions-sugar_always.ml.ref @@ -65,6 +65,11 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)]) ;; 33333333333333333333] +[%%ext +let foooooooooooooooo = foooo + +let fooooooooooooooo = foo] + let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]] let _ = @@ -177,3 +182,12 @@ let this_function_has_a_long_name plus very many arguments = "and a kind of long body" [%%expect {||}] + +;; +[%expect {| +___________________________________________________________ +|}] + +[%%expect {| +___________________________________________________________ +|}] diff --git a/test/passing/extensions.ml b/test/passing/extensions.ml index 35fe6db3c7..0d06ccee8b 100644 --- a/test/passing/extensions.ml +++ b/test/passing/extensions.ml @@ -59,6 +59,10 @@ let _ = ([%ext? (x:x)] : [%ext? (x:x)]);; ;; 33333333333333333333] +[%%ext +let foooooooooooooooo = foooo + +let fooooooooooooooo = foo] let _ = [%stri let [%p xxx] = @@ -193,3 +197,13 @@ let this_function_has_a_long_name plus very many arguments = "and a kind of long [%%expect {||}] + +;; +[%expect {| +___________________________________________________________ +|}] + +[%%expect + {| +___________________________________________________________ +|}] diff --git a/test/passing/extensions.ml.ref b/test/passing/extensions.ml.ref index b6298155e0..f911167bec 100644 --- a/test/passing/extensions.ml.ref +++ b/test/passing/extensions.ml.ref @@ -67,6 +67,11 @@ let _ = ([%ext? (x : x)] : [%ext? (x : x)]) ;; 33333333333333333333] +[%%ext +let foooooooooooooooo = foooo + +let fooooooooooooooo = foo] + let _ = [%stri let [%p xxx] = fun (t : [%t tt]) (ut : [%t tt]) -> [%e xxx]] let _ = @@ -183,3 +188,12 @@ let this_function_has_a_long_name plus very many arguments = "and a kind of long body" [%%expect {||}] + +;; +[%expect {| +___________________________________________________________ +|}] + +[%%expect {| +___________________________________________________________ +|}] diff --git a/test/passing/extensions.mli b/test/passing/extensions.mli index be112b54b9..ebb3a46d55 100644 --- a/test/passing/extensions.mli +++ b/test/passing/extensions.mli @@ -20,3 +20,8 @@ foooooooooooooooooooooooooooo] fooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooo foooooooooooooooooooooooooooo] + +[%%ext +val foooooooooooooooooooooo : fooooooooooo + +val fooooooooooooooooooooooooooo : fooooo] diff --git a/test/passing/js_source.ml.ref b/test/passing/js_source.ml.ref index 31c47d19d5..14ac0ab12e 100644 --- a/test/passing/js_source.ml.ref +++ b/test/passing/js_source.ml.ref @@ -43,21 +43,16 @@ let ([%foo 2 + 1] : [%foo bar.baz]) = [%foo "foo"] let ([%foo let () = ()] : [%foo type t = t]) = [%foo class c = object end] -[%%foo: -'a list] +[%%foo: 'a list] let ([%foo: [ `Foo ]] : [%foo: t -> t]) = [%foo: < foo : t > ] -[%%foo? -_] - -[%%foo? -Some y when y > 0] +[%%foo? _] +[%%foo? Some y when y > 0] let ([%foo? Bar x | Baz x] : [%foo? #bar]) = [%foo? { x }] -[%%foo: -module M : [%baz]] +[%%foo: module M : [%baz]] let ([%foo: include S with type t = t] : [%foo: val x : t val y : t]) = [%foo: type t = t] @@ -220,8 +215,9 @@ module type S = sig [%%foo: exception X [@foo]] [%%foo: module M : S [@@foo]] - [%%foo: module rec M : S [@@foo] - and M : S [@@foo]] + [%%foo: + module rec M : S [@@foo] + and M : S [@@foo]] [%%foo: module M = M [@@foo]] [%%foo: module type S = S [@@foo]] @@ -3200,8 +3196,7 @@ module FM_valid = F (struct type t = int end) -[%%expect -{| +[%%expect {| module M_valid : S module FM_valid : S |}] @@ -3217,8 +3212,7 @@ end = struct let x = ref 0 end -[%%expect -{| +[%%expect {| module Foo : sig type t val x : t ref end |}] @@ -3232,8 +3226,7 @@ end = struct let x = ref 0 end -[%%expect -{| +[%%expect {| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3243,8 +3236,7 @@ let test f = Sys.time () -. start ;; -[%%expect -{| +[%%expect {| val test : (unit -> 'a) -> float = |}] @@ -3254,8 +3246,7 @@ let test_foo () = done ;; -[%%expect -{| +[%%expect {| val test_foo : unit -> unit = |}] @@ -3265,8 +3256,7 @@ let test_bar () = done ;; -[%%expect -{| +[%%expect {| val test_bar : unit -> unit = |}] diff --git a/test/passing/shortcut_ext_attr.ml b/test/passing/shortcut_ext_attr.ml index b63450c1e2..4c93b6fb33 100644 --- a/test/passing/shortcut_ext_attr.ml +++ b/test/passing/shortcut_ext_attr.ml @@ -96,8 +96,7 @@ and t = int [@@foo] [%%foo class type x = x [@@foo]] -[%%foo -external x : _ = "" [@@foo]] +[%%foo external x : _ = "" [@@foo]] [%%foo exception X [@@foo]] @@ -107,8 +106,7 @@ external x : _ = "" [@@foo]] module rec M : S = M [@@foo] and M : S = M [@@foo]] -[%%foo -module type S = S [@@foo]] +[%%foo module type S = S [@@foo]] [%%foo include M [@@foo]] @@ -130,8 +128,9 @@ module type S = sig [%%foo: module M : S [@@foo]] - [%%foo: module rec M : S [@@foo] - and M : S [@@foo]] + [%%foo: + module rec M : S [@@foo] + and M : S [@@foo]] [%%foo: module M = M [@@foo]] diff --git a/test/passing/source.ml.ref b/test/passing/source.ml.ref index 5eedca765b..550bb69315 100644 --- a/test/passing/source.ml.ref +++ b/test/passing/source.ml.ref @@ -46,21 +46,17 @@ let ([%foo 2 + 1] : [%foo bar.baz]) = [%foo "foo"] let ([%foo let () = ()] : [%foo type t = t]) = [%foo class c = object end] -[%%foo: -'a list] +[%%foo: 'a list] let ([%foo: [`Foo]] : [%foo: t -> t]) = [%foo: < foo: t > ] -[%%foo? -_] +[%%foo? _] -[%%foo? -Some y when y > 0] +[%%foo? Some y when y > 0] let ([%foo? Bar x | Baz x] : [%foo? #bar]) = [%foo? {x}] -[%%foo: -module M : [%baz]] +[%%foo: module M : [%baz]] let ([%foo: include S with type t = t] : [%foo: @@ -218,8 +214,7 @@ and t = int [@@foo] [%%foo class type x = x [@@foo]] -[%%foo -external x : _ = "" [@@foo]] +[%%foo external x : _ = "" [@@foo]] [%%foo exception X [@foo]] @@ -229,8 +224,7 @@ external x : _ = "" [@@foo]] module rec M : S = M [@@foo] and M : S = M [@@foo]] -[%%foo -module type S = S [@@foo]] +[%%foo module type S = S [@@foo]] [%%foo include M [@@foo]] @@ -252,8 +246,9 @@ module type S = sig [%%foo: module M : S [@@foo]] - [%%foo: module rec M : S [@@foo] - and M : S [@@foo]] + [%%foo: + module rec M : S [@@foo] + and M : S [@@foo]] [%%foo: module M = M [@@foo]] @@ -3029,8 +3024,7 @@ module FM_valid = F (struct type t = int end) -[%%expect -{| +[%%expect {| module M_valid : S module FM_valid : S |}] @@ -3046,8 +3040,7 @@ end = struct let x = ref 0 end -[%%expect -{| +[%%expect {| module Foo : sig type t val x : t ref end |}] @@ -3061,8 +3054,7 @@ end = struct let x = ref 0 end -[%%expect -{| +[%%expect {| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3071,8 +3063,7 @@ let test f = f () ; Sys.time () -. start -[%%expect -{| +[%%expect {| val test : (unit -> 'a) -> float = |}] @@ -3081,8 +3072,7 @@ let test_foo () = Foo.x := !Foo.x done -[%%expect -{| +[%%expect {| val test_foo : unit -> unit = |}] @@ -3091,8 +3081,7 @@ let test_bar () = Bar.x := !Bar.x done -[%%expect -{| +[%%expect {| val test_bar : unit -> unit = |}]